############################################################################### # # Script: configPPM.pl # Author: Michael Smith # Description: Setup 'ppm.xml' for first use by inserting path strings # consistent with the installation we are performing. # # Copyright © 1999,2001 ActiveState Tool Corp. # ############################################################################### use Config; use PPM::XML::PPMConfig; use XML::Parser; my $ppmConfigFile = $ARGV[0]; my $srcDir = $ARGV[1] || ''; my $oldConfig = $ARGV[2]; my $repository = $ARGV[3]; my $sitelib = $Config{'sitelib'}; my $perldir = $Config{'prefix'}; my $osname = $Config{'osname'}; my $archname = $Config{'archname'}; my @ppmConfig; my $osversion = join ",", (split (/\./, $Config{'osvers'}), (0) x 4) [0 .. 3]; $tmp = $ENV{'TEMP'} || $ENV{'tmp'}; if ($^O =~ /MSWin/) { $tmp ||= 'c:/temp'; } else { $tmp ||= '/tmp'; } #if $repository is undef, leave it if ($repository) { $repository =~ s#\\#/#g; # weak series of regex to strip off extra dirs. $repository =~ s#/$##; $repository =~ s#(.*/).*$#$1#; $repository =~ s#/$##; $repository =~ s#(.*/).*$#$1#; if (-d $repository ."PPMPackages") { $repository = ''; } else { $repository = ''; } } else { $repository = ''; } print "Configuring PPM ...\n"; chmod(0666, $ppmConfigFile) or warn "Unable to chmod $ppmConfigFile: $!\n"; if(open(FILE, "+<$ppmConfigFile")) { while() { s/%SITELIB%/$sitelib/g; s/%PERLDIR%/$perldir/g; s/%SRCDIR%/$srcDir/g; s/%OSNAME%/$osname/g; s/%OSVERSION%/$osversion/g; s/%TEMP%/$tmp/g; s/%REPOSITORY%/$repository/g; s/%ARCHNAME%/$archname/g; push(@ppmConfig, $_); } seek(FILE, 0, 0); truncate(FILE, 0); foreach my $line (@ppmConfig) { print FILE $line; } close(FILE); sleep(1); } else { print "Unable to open $ppmConfigFile: $!\n"; print "Press [Enter] to continue\n"; ; } if ($oldConfig and -f $oldConfig) { mergePPMConfig($oldConfig, $ppmConfigFile); } ############################################################################### # ############################################################################### sub mergePPMConfig { my $file1 = shift; my $file2 = shift; my $parser = new XML::Parser(Style => 'Objects', Pkg => 'PPM::XML::PPMConfig'); my $Config1 = $parser->parsefile($file1); my $Config2 = $parser->parsefile($file2); my $i = 0; foreach my $elem (@{$Config1->[0]->{Kids}}) { if((ref $elem) =~ /.*::PACKAGE$/) { if (! existsInConfig('PACKAGE', $elem->{NAME}, $Config2)) { splice(@{$Config2->[0]->{Kids}}, $i, 0, $elem); } } ++$i; } open(FILE, ">$file2") || return "Error: Could not open $file2 : $!"; select(FILE); my $Config_ref = bless($Config2->[0], "PPM::XML::PPMConfig::PPMCONFIG"); $Config_ref->output(); close(FILE); return; } ############################################################################### # ############################################################################### sub existsInConfig { my $element = shift; my $name = shift; my $config = shift; foreach my $elem (@{$config->[0]->{Kids}}) { return 1 if ((ref $elem) =~ /.*::$element$/ && $elem->{NAME} eq $name); } return 0; }