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 / Installer.bat < prev    next >
DOS Batch File  |  2004-06-01  |  15KB  |  525 lines
  1. @rem = '--*-Perl-*--
  2. @echo off
  3. if "%OS%" == "Windows_NT" goto WinNT
  4. Perl\bin\perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
  5. goto endofperl
  6. :WinNT
  7. Perl\bin\perl -x -S %0 %*
  8. if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
  9. if %errorlevel% == 9009 echo You do not have Perl in your PATH.
  10. if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
  11. goto endofperl
  12. @rem ';
  13. #!Perl/bin/perl -w
  14. #line 15
  15. #
  16. # ActivePerl ZIP installer
  17. #
  18. # Copyright (c) 2000-2004 ActiveState Corp.  All rights reserved.
  19. # ActiveState is a division of Sophos Plc.
  20. #
  21. # This program completes a simple installation of ActivePerl
  22. #
  23. # The intent of this program is to provide a "fail-safe" way of installing
  24. # a fully-functional version of ActivePerl.  If there is a failure, this
  25. # script should explain exactly what went wrong, and how to fix it.
  26. # If not, submit that as a bug.
  27. #
  28. # What is does:
  29. #     o Relocates Perl
  30. #     o Creates MSWin32 Shortcuts to the HTML documentation
  31. #     o Configures PPM
  32. #     o Configures lib/Config.pm for use with a development system
  33. #     o Creates ActivePerl registry entries
  34. #     o Updates the PATH environment variable
  35. #
  36. # Todo:
  37. #     o uninstall (pretty simple)
  38. #     o configure Perl for use with a Web Server
  39. #     o set up file associations on Win32
  40. #
  41.  
  42. my $product = "ActivePerl";
  43. die "Template not expanded yet" if $product =~ /TMPL_VAR/;
  44.  
  45. # The path we will be replacing
  46. #my \$replace = q[$path];
  47.  
  48. # The ActivePerl version we are installing
  49. my $APVersion = Win32::BuildNumber();
  50.  
  51. # It should be safe to comment the following out on non-MSWin32 platforms
  52. use Win32;
  53. use Win32API::Registry (':ALL');
  54. use Win32::Shortcut;
  55.  
  56. use Cwd;
  57. use strict;
  58. no strict "subs";    # not my fault
  59.  
  60. $|=1; #disable buffering
  61.  
  62. (-d 'Perl/bin' && -d 'Perl/lib' && -d 'Perl/site')
  63.     || die "Error: you must run this script from the directory in which you unzipped ActivePerl into.\n";
  64.  
  65. my $temp = $ENV{'TEMP'}
  66.     || die "You must set the 'TEMP' environment variable.\n";
  67.  
  68. my $cwd = cwd;
  69. $cwd =~ s#/#\\#g;
  70.  
  71. if (@ARGV && $ARGV[0] eq '--remove') {
  72.     remove_html_shortcuts();
  73.     print <<EOM;
  74.  
  75. ActivePerl uninstalled...you may now delete this directory and
  76. its subdirectories.
  77.  
  78. EOM
  79.     exit;
  80. }
  81.  
  82. print <<EOM;
  83.     Welcome to ActivePerl.
  84.  
  85.     This installer can install ActivePerl in any location of your choice.
  86.     You do not need Administrator privileges.  However, please make sure
  87.     that you have write access to this location.
  88.  
  89. EOM
  90.  
  91. my $prefix;
  92. do {
  93.     print 'Enter top level directory for install [c:\Perl]: ';
  94.     chomp($prefix=<>);
  95.     $prefix ||='c:\Perl';
  96.  
  97.     unless ($prefix =~/(^.:\\)|(\\\\)/) {
  98.     print "Error: You must include the drive letter or the full UNC PATH\n\n";
  99.     $prefix = undef;
  100.     }
  101. } until defined $prefix;
  102.  
  103. if (-d $prefix) {
  104.     print <<EOM;
  105.  
  106. $prefix appears to already exist.
  107.  
  108.     WARNING: Install may fail if any existing files cannot be
  109.     overwritten.
  110. EOM
  111. }
  112.  
  113. if ($prefix =~ /[\s;,!|<>~\@\%\&\$\*\?\+]/) {
  114.     print <<EOM;
  115.  
  116.     Looks like you are trying to install Perl into a path that contains
  117.     spaces or other special characters.  Though the latest Windows
  118.     operating systems claim to support filenames with such special
  119.     characters, many existing utilities will have trouble with such
  120.     path names.  Chances are that you will find this is simply too
  121.     much of a bad idea to be worth it.
  122.  
  123. EOM
  124.     }
  125.  
  126. print <<EOM;
  127.  
  128.     The typical ActivePerl software installation requires 75 megabytes.
  129.     Please make sure enough free space is available before continuing.
  130.  
  131.     ActivePerl $APVersion will be installed into '$prefix'
  132. EOM
  133. print 'Proceed? [y] ';
  134. <> =~ /^\s*[y|\n]$/i or exit 1;
  135.  
  136. # Hint to MSWin32 users that devsys environment should be set before installing
  137. #
  138. if ((!defined($ENV{'INCLUDE'}) || !defined($ENV{'LIB'})) && $^O eq 'MSWin32') {
  139.     print <<EOM;
  140.  
  141.     If you have a development environment (e.g. Visual Studio) that you
  142.     wish to use with Perl, you should ensure that your environment (e.g.
  143.     %LIB% and %INCLUDE%) is set before installing, for example, by running
  144.     vcvars32.bat first.
  145. EOM
  146.  
  147.     print 'Proceed? [y] ';
  148.     <> =~ /^\s*[y|\n]$/i or exit 1;
  149. }
  150.  
  151.     print "\nCreate shortcuts to the HTML documentation? [y] ";
  152.     (my $create_html_shortcuts = <>) =~ /^\s*[y|\n]$/i;
  153.  
  154.     print "\nAdd the Perl/bin directory to the PATH? [y] ";
  155.     (my $add_path = <>) =~ /^\s*[y|\n]$/i;
  156.  
  157. #alright, copy the files
  158. print <<EOM;
  159.  
  160.     Copying files...
  161. EOM
  162.  
  163. # disables prompting in newer versions of cmd.exe if there are
  164. # older files of the same name
  165. $ENV{COPYCMD} = "/y";
  166.  
  167. my $cmd = "xcopy /q /r /i /e Perl\\* \"$prefix\" ";
  168. system($cmd) && die "$!\n";
  169.  
  170. print "    Finished copying files...\n";
  171.  
  172. my $perl = "$prefix/bin/perl.exe";
  173. $ENV{PATH} = "$prefix\\bin;$ENV{PATH}";
  174.  
  175. # system($perl, "$prefix/bin/reloc_perl", '-a', '-i', '-v', '-t', $prefix, $replace) == 0
  176. #     or die "Couldn't run reloc_perl: $!";
  177.  
  178. # Relocate
  179. if (open(my $reloc, "support/reloc.txt")) {
  180.     use Config;
  181.     my $sponge = $Config{prefix};
  182.     die "Can't relocate to a path longer than " . length($sponge) . " chars"
  183.     if length($prefix) > length($sponge);
  184.     my $binary_pad = "\0" x (length($sponge) - length($prefix));
  185.  
  186.     print "Relocating...";
  187.     my $count = 0;
  188.     local $_;
  189.     while (<$reloc>) {
  190.     chomp;
  191.     my($type, $f) = split(' ', $_, 2);
  192.     $f = "$prefix/$f";
  193.     #print "Relocating $f...\n";
  194.     my $read_only;
  195.     unless (-w $f) {
  196.         $read_only++;
  197.         run("\@attrib", "-r", $f);
  198.     }
  199.  
  200.     open(my $fh, "+<", $f) || die "Can't open $f: $!";
  201.     binmode($fh);
  202.     my $content = do { local $/; <$fh> };
  203.  
  204.     if ($type eq "B") {
  205.         $content =~ s,\Q$sponge\E([^\0]*),$prefix$1$binary_pad,go;
  206.     }
  207.     else {
  208.         $content =~ s,\Q$sponge\E,$prefix,go;
  209.         truncate($fh, length($content)) || die "Can't truncate '$f': $!";
  210.     }
  211.  
  212.     seek($fh, 0, 0) || die "Can't reset file pos on '$f': $!";
  213.     print $fh $content;
  214.     close($fh) || die "Can't write back content to '$f': $!";
  215.  
  216.     run("\@attrib", "+r", $f) if $read_only;
  217.  
  218.     $count++;
  219.     }
  220.     print "done ($count files relocated)\n";
  221. }
  222.  
  223. if ($^O eq 'MSWin32') {
  224.     create_html_shortcuts() if $create_html_shortcuts;
  225.     create_registry_entries();
  226.     update_path() if $add_path;
  227.     configure_configpm();
  228. }
  229. configure_ppm();
  230. build_html();
  231.  
  232. print <<EOM;
  233.  
  234. This simplified installation program currently does *not*:
  235.  
  236.     o set up MSWin32 file associations
  237.     o configure Perl for use with a Web Server
  238.  
  239. Refer to your Operating System and/or Web Server documentation for
  240. details on how to to perform these modifications.
  241.  
  242. Thank you for installing ActivePerl!
  243.  
  244. EOM
  245.  
  246. if (Win32::IsWin95) {
  247.     sleep 5; #STDIN is dead
  248. }
  249. else {
  250.     print "Press return to exit.\n";
  251.     <>;
  252. }
  253.  
  254. exit;
  255.  
  256. sub configure_configpm
  257. {
  258.     my ($LIB, $INC);
  259.     print "\nConfiguring $prefix/lib/Config.pm for use in $prefix...\n\n";
  260.  
  261.     system($perl, "$prefix/bin/config.pl", $prefix) == 0
  262.         or die "Couldn't config $prefix/lib/config.pm: $!";
  263.  
  264.     # Create values for libpth and incpath in Config.pm
  265.     if (defined $ENV{'LIB'}) {
  266.         $LIB = '"' . join(q(" "), split(/;/, $ENV{'LIB'})) . '" ';
  267.     } else {
  268.         $LIB = '/lib /usr/lib /usr/local/lib ';
  269.     }
  270.     $LIB .= qq("$prefix\\lib\\CORE");
  271.  
  272.     if (defined $ENV{'INCLUDE'}) {
  273.         $INC = '"' . join(q(" "), split(/;/, $ENV{'INCLUDE'})) . '" ';
  274.     } else {
  275.         $INC = '/usr/include /usr/local/include ';
  276.     }
  277.     $INC .= qq("$prefix\\lib\\CORE");
  278.  
  279.     my @Config;
  280.     open (CONFIG, "<$prefix/lib/Config.pm")
  281.         or die "Can't open $prefix/lib/Config.pm for reading: $!";
  282.     @Config = <CONFIG>;
  283.     close(CONFIG);
  284.     foreach(@Config) {
  285.         s@^libpth=.*$@libpth='$LIB'@g;
  286.         s@^incpath=.*$@incpath='$INC'@g;
  287.     }
  288.     unlink("$prefix/lib/Config.pm.old") if -f "$prefix/lib/Config.pm.old";
  289.     rename("$prefix/lib/Config.pm", "$prefix/lib/Config.pm.old")
  290.         or die "Can't rename $prefix/lib/Config.pm to $prefix/lib/Config.pm.old: $!";
  291.  
  292.     open (CONFIG, ">$prefix/lib/Config.pm")
  293.         or die "Can't open $prefix/lib/Config.pm for writing: $!";
  294.     print CONFIG @Config;
  295.     close(CONFIG);
  296. }
  297.  
  298.  
  299. sub configure_ppm
  300. {
  301.     print "\nConfiguring PPM for use in $prefix...\n\n";
  302.  
  303.     if (-f "$prefix/bin/ppm2.bat") {
  304.     system($perl, "$prefix/bin/ppm2.bat", 'set', 'build', $temp) == 0
  305.         or die "Couldn't set ppm2 BUILDDIR: $!";
  306.     }
  307.     if (-f "$prefix/bin/ppm3.bat") {
  308.     system($perl, "$prefix/bin/ppm3.bat", 'set', 'tempdir', $temp) == 0
  309.         or die "Couldn't set ppm3 TEMPDIR: $!";
  310.     }
  311.     print <<EOM;
  312.  
  313. If you are behind a firewall, you may need to set the following
  314. environment variables so that PPM will operate properly:
  315.  
  316.     set HTTP_proxy=address:port         [e.g. 192.0.0.1:8080]
  317.     set HTTP_proxy_user=username
  318.     set HTTP_proxy_pass=password
  319.     set HTTP_proxy_agent=agent          [e.g. "Mozilla/5.0"]
  320.  
  321. EOM
  322. }
  323.  
  324. sub build_html {
  325.     print "\nBuilding HTML documentation, please wait...\n\n";
  326.  
  327.     # Can't do this in-process because the by now modified Config.pm and
  328.     # %Config can't be reloaded easily
  329.     system($perl, "-MActivePerl::DocTools", "-e", "UpdateHTML('wait')") == 0
  330.     or die "Failed to build HTML documentation\n";
  331. }
  332.  
  333. sub create_html_shortcuts
  334. {
  335.     my ($key, $location);
  336.     $key = 'Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\\';
  337.     $key .= Win32::IsWin95() ? 'Programs' : 'Common Programs';
  338.  
  339.     my $try = Get(HKEY_LOCAL_MACHINE, $key, \$location);
  340.  
  341.     unless ($try) {
  342.         $key = 'Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\Programs';
  343.         $location = undef;
  344.         $try = Get(HKEY_CURRENT_USER, $key, \$location);
  345.     }
  346.  
  347.     unless ($try) {
  348.         warn 'Read of shortcut dir failed: '. Win32::FormatMessage(Win32::GetLastError()) ."\n";
  349.         return undef;
  350.     }
  351.  
  352.     $location .= sprintf("/ActiveState ActivePerl %d.%d", ord($^V), ord(substr($^V,1)));
  353.     mkdir($location, 0777) unless -d $location;
  354.  
  355.     my $link = new Win32::Shortcut();
  356.     # Stupid NT can't handle / path separator in the shortcut
  357.     ($link->{'Path'} = "$prefix\\html\\index.html") =~ s@/@\\@g;
  358.     ($link->{'WorkingDirectory'} = "$prefix\\html") =~ s@/@\\@g;
  359.     $link->{'Description'} = "ActivePerl Documentation in HTML format.";
  360.     $link->{'ShowCmd'} = SW_SHOWNORMAL;
  361.     $link->Save("$location\\Documentation.lnk");
  362.  
  363.     $link = new Win32::Shortcut();
  364.     ($link->{'Path'} = "$prefix\\bin\\ppm3-bin.bat") =~ s@/@\\@g;
  365.     ($link->{'WorkingDirectory'} = "$prefix\\bin") =~ s@/@\\@g;
  366.     $link->{'Description'} = "Perl Package Manager.";
  367.     $link->{'ShowCmd'} = SW_SHOWNORMAL;
  368.     $link->Save("$location\\Perl Package Manager.lnk");
  369.  
  370.     $link = new Win32::Shortcut();
  371.     ($link->{'Path'} = "$prefix\\html\\OLE-Browser\\Browser.html") =~ s@/@\\@g;
  372.     ($link->{'WorkingDirectory'} = "$prefix\\html\\OLE-Browser") =~ s@/@\\@g;
  373.     $link->{'Description'} = "OLE Browser.";
  374.     $link->{'ShowCmd'} = SW_SHOWNORMAL;
  375.     $link->Save("$location\\OLE-Browser.lnk");
  376. }
  377.  
  378. sub create_registry_entries
  379. {
  380.     # Attempt to set some registry entries.
  381.     (my $prefix = $prefix) =~ s@/@\\@g;
  382.  
  383.     Set(HKEY_LOCAL_MACHINE, 'SOFTWARE\ActiveState\ActivePerl\CurrentVersion', $APVersion, REG_SZ)
  384.     || warn "Couldn't make registry entry: $!\n";
  385.  
  386.     Set(HKEY_LOCAL_MACHINE, "SOFTWARE\\ActiveState\\ActivePerl\\$APVersion\\", $prefix, REG_SZ)
  387.     || warn "Couldn't make registry entry: $!\n";
  388.  
  389.     Set(HKEY_LOCAL_MACHINE, 'Software\Perl\\', $prefix, REG_SZ)
  390.     || warn "Couldn't make registry entry: $!\n";
  391.  
  392.     Set(HKEY_LOCAL_MACHINE, 'Software\Perl\BinDir', $perl, REG_SZ)
  393.     || warn "Couldn't make registry entry: $!\n";
  394. }
  395.  
  396. sub update_path
  397. {
  398.     my $perlbin = "$prefix\\bin";
  399.     $perlbin =~ s@/@\\@g;
  400.  
  401.     if (Win32::IsWin95()) {
  402.  
  403.     if ($perlbin =~ /\s/) {
  404.         $perlbin = qq["$perlbin"];
  405.     }
  406.  
  407.     my $path_set = 0;
  408.  
  409.     if ($ENV{winbootdir}) {
  410.         my $autoexec = substr($ENV{winbootdir},0,2) .'\autoexec.bat';
  411.         if (-e $autoexec && ! -w $autoexec) {
  412.         chmod 0755, $autoexec;
  413.         }
  414.         if (open(my $F, ">>$autoexec")) {
  415.         print $F "\nSET PATH=$perlbin;%PATH%\n";
  416.         close $F;
  417.         ++$path_set;
  418.         }
  419.         else {
  420.         warn "Unable to open $autoexec for writing: $!\n";
  421.         }
  422.     }
  423.     else {
  424.         warn "No winbootdir environment variable found.\n";
  425.     }
  426.     unless ($path_set) {
  427.         print <<EOT;
  428.  
  429. The PATH has not been updated to include '$perlbin'.
  430. You can edit your AUTOEXEC.BAT to add this yourself later.
  431.  
  432. EOT
  433.     }
  434.     return;
  435.     }
  436.  
  437.     my $path;
  438.     Get(HKEY_LOCAL_MACHINE, 'System\CurrentControlSet\Control\Session Manager\Environment\Path', \$path)
  439.     || warn "Unable to read PATH from registry: $!\n";
  440.  
  441.     $path = "$perlbin;$path" unless $path =~ m#\Q$perlbin\E#; #quote the path to avoid Unicode errors
  442.  
  443.     Set(HKEY_LOCAL_MACHINE, 'System\CurrentControlSet\Control\Session Manager\Environment\Path', $path, REG_EXPAND_SZ)
  444.     || warn "Unable to update PATH in registry: $!\n";
  445. }
  446.  
  447. sub remove_html_shortcuts
  448. {
  449.     my ($key, $location);
  450.     $key = 'Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\\';
  451.     $key .= Win32::IsWin95() ? 'Programs' : 'Common Programs';
  452.  
  453.     Get(HKEY_LOCAL_MACHINE, $key, \$location)
  454.     || warn 'Read of shortcut dir failed: '. Win32::FormatMessage(Win32::GetLastError()) ."\n";
  455.  
  456.     $location .= '/ActiveState ActivePerl';
  457.     unlink("$location/Online Documentation.lnk");
  458.     unlink($location);
  459. }
  460.  
  461. sub Get
  462. {
  463.     my ($root, $key, $data) = @_;
  464.  
  465.     if (defined $$data) {warn "\$data set in Get!"}
  466.     my $hkey;
  467.     my $type;
  468.     $key =~ s#(.*)\\(.*)$#$1#;
  469.     my $value = $2;
  470.  
  471.     Win32API::Registry::RegOpenKeyEx($root, $key, 0, KEY_READ, $hkey)
  472.     || return undef;
  473.  
  474.     Win32API::Registry::RegQueryValueEx( $hkey, $value, [], $type, $$data, [])
  475.     || return undef;
  476.  
  477.     return 1;
  478. }
  479.  
  480. sub Set
  481. {
  482.     my ($root, $key, $data, $type) = @_;
  483.     my $hkey;
  484.     $key =~ s#(.*)\\(.*)$#$1#;
  485.     my $value = $2;
  486.  
  487.     Win32API::Registry::RegCreateKeyEx($root, $key, 0, '', REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, [], $hkey, [])
  488.     || return undef;
  489.  
  490.     if (defined $data) {
  491.     my $olddata;
  492.  
  493.     if (! $type and Win32API::Registry::RegQueryValueEx($hkey, $value, [], $type, $olddata)) {
  494.         $type = REG_SZ;
  495.         warn "assuming type REG_SZ\n";
  496.     }
  497.     Win32API::Registry::RegSetValueEx($hkey, $value, 0, $type, $data, 0)
  498.         || return undef;
  499.     }
  500.     else {
  501.     Win32API::Registry::RegDeleteValue($hkey, $value)
  502.         || return undef;
  503.     }
  504.     Win32API::Registry::RegCloseKey($hkey)
  505.     || return undef;
  506.  
  507.     return 1;
  508. }
  509.  
  510. sub can_write {
  511.     my $d = shift;
  512.     my $ok = 0;
  513.     my $file = $d;
  514.     if (-d $d) {
  515.     $file = "$d/foozle.$$";
  516.     }
  517.     $ok = open(TEST, ">", $file);
  518.     close TEST;
  519.     unlink($file) if $ok;
  520.     return $ok;
  521. }
  522.  
  523. __END__
  524. :endofperl
  525.