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