home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 May / Chip_2000-05_cd1.bin / zkuste / Perl / ActivePerl-5.6.0.613.msi / 䆊䌷䈹䈙䏵-䞅䞆䞀㡆䞃䄦䠥 / _77dafebc175a4a2f515756c827ab29dc < prev    next >
Text File  |  2000-03-23  |  3KB  |  108 lines
  1. ###############################################################################
  2. #
  3. # Script:    configPPM.pl
  4. # Author:    Michael Smith
  5. # Description:    Setup 'ppm.xml' for first use by inserting path strings 
  6. #        consistent with the installation we are performing.
  7. #
  8. # Copyright ⌐ 1999, ActiveState Tool Corp.
  9. #
  10. ###############################################################################
  11. BEGIN {
  12.     $tmp = $ENV{'TEMP'} || $ENV{'tmp'} || 
  13.     ($Config{'osname'} eq 'MSWin32' ? 'c:/temp' : '/tmp');
  14.     open(STDERR, ">> $tmp/ActivePerlInstall.log");
  15. }
  16.  
  17. use Config;
  18. use XML::PPMConfig;
  19. use XML::Parser;
  20.  
  21. my $ppmConfigFile = $ARGV[0];
  22. my $srcDir = $ARGV[1];
  23. my $oldConfig = $ARGV[2];
  24. my $sitelib = $Config{'sitelib'};
  25. my $perldir = $Config{'prefix'};
  26. my $osname = $Config{'osname'};
  27. my @ppmConfig;
  28. my $osversion = join ",", (split (/\./,  $Config{'osvers'}), (0) x 4) [0 .. 3];
  29.  
  30. print "Configuring PPM ...\n";
  31. chmod($ppmConfigFile, '0600');
  32. if(open(FILE, "+<$ppmConfigFile")) {
  33.     while(<FILE>) {
  34.     s/%SITELIB%/$sitelib/g;
  35.     s/%PERLDIR%/$perldir/g;
  36.     s/%SRCDIR%/$srcDir/g;
  37.     s/%OSNAME%/$osname/g;
  38.     s/%OSVERSION%/$osversion/g;
  39.     s/%TEMP%/$tmp/g;
  40.     push(@ppmConfig, $_);
  41.     }
  42.  
  43.     seek(FILE, 0, 0);
  44.     truncate(FILE, 0);
  45.  
  46.     foreach my $line (@ppmConfig) {
  47.     print FILE $line;
  48.     }
  49.  
  50.     close(FILE);
  51.     sleep(1);
  52. }
  53. else {
  54.     print "$ppmConfigFile : $!\n";
  55.     print "Press [Enter] to continue\n";
  56.     <STDIN>;
  57. }
  58.  
  59. if(-f $oldConfig) {
  60.     mergePPMConfig($oldConfig, $ppmConfigFile);
  61. }
  62.  
  63.  
  64. ###############################################################################
  65. #
  66. ###############################################################################
  67. sub mergePPMConfig {
  68.     my $file1 = shift;
  69.     my $file2 = shift;
  70.     my $parser = new XML::Parser(Style => 'Objects', Pkg => 'XML::PPMConfig');
  71.     my $Config1 = $parser->parsefile($file1);
  72.     my $Config2 = $parser->parsefile($file2);
  73.     
  74.     my $i = 0;
  75.     foreach my $elem (@{$Config1->[0]->{Kids}}) {
  76.         if((ref $elem) =~ /.*::PACKAGE$/) {
  77.         if (! existsInConfig('PACKAGE', $elem->{NAME}, $Config2)) {
  78.             splice(@{$Config2->[0]->{Kids}}, $i, 0, $elem);
  79.         }
  80.         }
  81.         ++$i;
  82.     }
  83.     
  84.     open(FILE, ">$file2")
  85.         || return "Error: Could not open $file2 : $!";
  86.     select(FILE);
  87.     my $Config_ref = bless($Config2->[0], "XML::PPMConfig::PPMCONFIG");
  88.     $Config_ref->output();
  89.     close(FILE);
  90.     return;
  91. }
  92.  
  93. ###############################################################################
  94. #
  95. ###############################################################################
  96. sub existsInConfig {
  97.     my $element = shift;
  98.     my $name = shift;
  99.     my $config = shift;
  100.  
  101.     foreach my $elem (@{$config->[0]->{Kids}}) {
  102.         return 1 
  103.         if ((ref $elem) =~ /.*::$element$/ && $elem->{NAME} eq $name);
  104.     }
  105.     return 0;
  106. }
  107.  
  108.