home *** CD-ROM | disk | FTP | other *** search
/ PC World 2004 November / PCWorld_2004-11_cd.bin / software / topware / activeperl / ActivePerl-5.8.4.810-MSWin32-x86.exe / ActivePerl-5.8.4.810 / Perl / bin / IISScriptMap.pl < prev    next >
Text File  |  2004-06-01  |  2KB  |  53 lines
  1. ###############################################################################
  2. #
  3. # File:         IISScriptMap.pl
  4. # Description:  Creates script mappings in the IIS metabase.
  5. #
  6. # Copyright (c) 2000-2003 ActiveState Corp.  All rights reserved.
  7. # ActiveState is a division of Sophos Plc.
  8. #
  9. ###############################################################################
  10. BEGIN {
  11.     $tmp = $ENV{'TEMP'} || $ENV{'tmp'} || 
  12.     ($Config{'osname'} eq 'MSWin32' ? 'c:/temp' : '/tmp');
  13.     open(STDERR, ">> $tmp/ActivePerlInstall.log");
  14. }
  15.  
  16. use strict;
  17. use Win32::OLE;
  18.  
  19. my($server_id,$virt_dir,$file_ext,$exec_path,$flags,$methods) = @ARGV;
  20. my @dirs = split /;/, $virt_dir, -1;
  21. push @dirs, "" unless @dirs;
  22.  
  23. # Add script mappings
  24. foreach my $id (split /;/, $server_id) {
  25.     foreach my $dir (@dirs) {
  26.     my $node = "IIS://localhost/W3SVC";
  27.     # NOTE: A serverID of "0" is treated as the W3SVC root; any supplied
  28.     # virtual directory for this case is ignored.
  29.     $node .= "/$id/ROOT" if $id;
  30.     $node .= "/$dir"     if $id and length($dir);
  31.  
  32.     my $server = Win32::OLE->GetObject($node) or next;
  33.     my @list = grep { !/^\Q$file_ext,\E/ } @{$server->{ScriptMaps}};
  34.     $server->{ScriptMaps} = [@list, "$file_ext,$exec_path,$flags,$methods"];
  35.     $server->SetInfo(); # save!
  36.     }
  37. }
  38.  
  39. my $info = Win32::OLE->GetObject("IIS://localhost/W3SVC/Info") or exit;
  40. my $version = $info->{MajorIIsVersionNumber};
  41. exit unless defined $version; # IIS6 and later
  42.  
  43. # Add Web Server Extension entry
  44. my %types = (".pl"   => "Perl CGI",
  45.          ".plx"  => "Perl ISAPI",
  46.          ".plex" => "PerlEx ISAPI");
  47. my $type = $types{$file_ext} || "Perl $file_ext";
  48.  
  49. my $server = Win32::OLE->GetObject("IIS://localhost/W3SVC") or exit;
  50. my @list = @{$server->{WebSvcExtRestrictionList}};
  51. $server->{WebSvcExtRestrictionList} = [@list, "0,$exec_path,1,,$type Extension"];
  52. $server->SetInfo();
  53.