home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 May / Chip_2000-05_cd1.bin / zkuste / Perl / ActivePerl-5.6.0.613.msi / 䆊䌷䈹䈙䏵-䞅䞆䞀㡆䞃䄦䠥 / _4f3d474e6c5b726f8bdc2b40fce02b37 < prev    next >
Text File  |  2000-03-23  |  5KB  |  246 lines
  1. ###############################################################################
  2. #
  3. # Script:    config.pl
  4. # Purpose:    Fix up Config.pm after a binary installation
  5. # Author:    Michael Smith <mike.smith@activestate.com>
  6. #
  7. # Copyright ⌐ 1999, ActiveState Tool Corp.
  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. my $prefix = $ARGV[0] || exit(1);
  16. $prefix =~ s/[\\\/]$//;
  17. my $libpth = $ENV{LIB};
  18. my $user   = $ENV{USERNAME};
  19. my $file   = $prefix . '\lib\Config.pm';
  20. my $oldfile = $prefix . '\lib\Config.pm~';
  21.  
  22. print 'Configuring Perl ... ' . "\n";
  23. my %replacements = (
  24.     archlib            => "'$prefix\\lib'",
  25.     archlibexp        => "'$prefix\\lib'",
  26.     bin            => "'$prefix\\bin'",
  27.     binexp            => "'$prefix\\bin'",
  28.     cf_by            => "'$user'",
  29.     cf_email        => "'$user\@localhost'",
  30.     installarchlib        => "'$prefix\\lib'",
  31.     installbin        => "'$prefix\\bin'",
  32.     installhtmldir        => "'$prefix\\html'",
  33.     installhtmlhelpdir     => "'$prefix\\htmlhelp'",
  34.     installman1dir        => "''",
  35.     installman3dir        => "''",
  36.     installprefix        => "'$prefix'",
  37.     installprefixexp    => "'$prefix'",
  38.     installprivlib        => "'$prefix\\lib'",
  39.     installscript        => "'$prefix\\bin'",
  40.     installsitearch        => "'$prefix\\site\\lib'",
  41.     installsitebin        => "'$prefix\\bin'",
  42.     installsitelib        => "'$prefix\\site\\lib'",
  43.     libpth            => q('") . join(q(" "), split(/;/, $libpth), $prefix . "\\lib\\CORE") . q("'),
  44.     man1dir            => "''",
  45.     man1direxp        => "''",
  46.     man3dir            => "''",
  47.     man3direxp        => "''",
  48.     perlpath        => "'$prefix\\bin\\perl.exe'",
  49.     prefix            => "'$prefix'",
  50.     privlib            => "'$prefix\\lib'",
  51.     privlibexp        => "'$prefix\\lib'",
  52.     scriptdir        => "'$prefix\\bin'",
  53.     scriptdirexp        => "'$prefix\\bin'",
  54.     sitearch        => "'$prefix\\site\\lib'",
  55.     sitearchexp        => "'$prefix\\site\\lib'",
  56.     sitebin            => "'$prefix\\site\\bin'",
  57.     sitebinexp        => "'$prefix\\site\\bin'",
  58.     sitelib            => "'$prefix\\site\\lib'",
  59.     sitelibexp        => "'$prefix\\site\\lib'",
  60.     siteprefix        => "'$prefix\\site'",
  61.     siteprefixexp        => "'$prefix\\site'",
  62. );
  63.  
  64. my $pattern = '^(' . join('|', keys %replacements) . ')=.*';
  65.  
  66. chmod(0600, $file);
  67. if(open(FILE, "+<$file")) {
  68.     my @Config;
  69.     while(<FILE>) {
  70.     s/$pattern/$1=$replacements{$1}/;
  71.     push(@Config, $_); 
  72.     }
  73.  
  74.     seek(FILE, 0, 0);
  75.     truncate(FILE, 0);
  76.     print FILE @Config;
  77.     close(FILE);
  78. }
  79. else {
  80.     print "$file : $!\n\n";
  81.     print "Press [Enter] to continue:\n";
  82.     <STDIN>;
  83. }
  84.  
  85. ###############################################################################
  86. # Config.pm values to propogate when doing an upgrade installation
  87. ###############################################################################
  88. my @propagateThese = qw(
  89.     ar
  90.     archlib
  91.     archlibexp
  92.     awk
  93.     bash
  94.     bin
  95.     binexp
  96.     bison
  97.     byacc
  98.     cat
  99.     cc
  100.     cf_by
  101.     cf_email
  102.     cp
  103.     cryptlib
  104.     csh
  105.     date
  106.     echo
  107.     egrep
  108.     emacs
  109.     expr
  110.     find
  111.     flex
  112.     full_csh
  113.     full_sed
  114.     gccversion
  115.     glibpth
  116.     gzip
  117.     incpath
  118.     inews
  119.     installarchlib
  120.     installbin
  121.     installhtmldir
  122.     installhtmlhelpdir
  123.     installman1dir
  124.     installman3dir
  125.     installprivlib
  126.     installscript
  127.     installsitearch
  128.     installsitelib
  129.     ksh
  130.     ld
  131.     lddlflags
  132.     ldflags
  133.     less
  134.     libc
  135.     libpth
  136.     ln
  137.     lns
  138.     loincpth
  139.     lolibpth
  140.     lp
  141.     lpr
  142.     ls
  143.     mail
  144.     mailx
  145.     make
  146.     man1dir
  147.     man1direxp
  148.     man3dir
  149.     man3direxp
  150.     mkdir
  151.     more
  152.     mv
  153.     mydomain
  154.     myhostname
  155.     myuname
  156.     pager
  157.     perlpath
  158.     prefix
  159.     prefixexp
  160.     privlib
  161.     privlibexp
  162.     rm
  163.     rmail
  164.     scriptdir
  165.     scriptdirexp
  166.     sed
  167.     sendmail
  168.     sh
  169.     sitearch
  170.     sitearchexp
  171.     sitelib
  172.     sitelibexp
  173.     tar
  174.     touch
  175.     tr
  176.     usrinc
  177.     vi
  178.     xlibpth
  179.     zcat
  180.     zip
  181. );
  182.  
  183. if(-f $oldfile) {
  184.     mergeConfig($oldfile, $file);
  185. }
  186.  
  187. ###############################################################################
  188. #
  189. ###############################################################################
  190. sub mergeConfig {
  191.     my $file1 = shift;
  192.     my $file2 = shift;
  193.  
  194.     open(FILE1, "<$file1")
  195.     || return "Error: Could not open file $file1 : $!";
  196.     
  197.     my $foundConfigBegin = 0;
  198.     my $foundConfigEnd = 0;
  199.     my %Config1 = ();
  200.     while(<FILE1>) {
  201.     chomp;
  202.     if (!$foundConfigBegin && /^my \$config_sh = <<'!END!';$/) {
  203.         $foundConfigBegin = 1;
  204.         next;
  205.     } 
  206.     elsif (!$foundConfigEnd && /^!END!$/) {
  207.         last;
  208.     }
  209.     next if(!$foundConfigBegin);
  210.     my ($name, $value) = split(/=/, $_, 2);
  211.     if(grep(/$name/, @propagateThese)) {
  212.         $Config1{$name} = $value;
  213.     }
  214.     }
  215.     close(FILE1);
  216.  
  217.     open(FILE2, "+<$file2")
  218.     || return "Error: Could not open file $file2 : $!";
  219.  
  220.     $foundConfigBegin = 0;
  221.     $foundConfigEnd = 0;
  222.     my @Config2 = ();
  223.     while(<FILE2>) {
  224.     my $line = $_;
  225.     chomp($line);
  226.     if (!$foundConfigBegin && $line =~ /^my \$config_sh = <<'!END!';$/) {
  227.         $foundConfigBegin = 1;
  228.     } 
  229.     elsif (!$foundConfigEnd && $line =~ /^!END!$/) {
  230.         $foundConfigEnd = 1;
  231.     }
  232.     elsif ($foundConfigBegin && !$foundConfigEnd) {
  233.         my ($name, $value) = split(/=/, $line, 2);
  234.         if(exists $Config1{$name} && length($Config1{$name}) > 0) {
  235.         $line = "$name=$Config1{$name}";
  236.         }
  237.     }
  238.     push(@Config2, $line . "\n");
  239.     }
  240.     truncate(FILE2, 0);
  241.     seek(FILE2, 0, 0);
  242.     print FILE2 (@Config2);
  243.     close(FILE2);
  244.     return; 
  245. }
  246.