PatchPerl revision 7c478bd95313f5f23a4c958a745db2134aa03244
#!/bin/perl
#
# Copyright 2002 Sun Microsystems, Inc. All rights reserved.
# Use is subject to license terms.
#
#ident "%Z%%M% %I% %E% SMI"
#
# This script takes a file mapping CSV file as input (see Flist.csv for an
# example) and copies all the changed files from a stock perl build directory
# into an ON workspace. If you are patching perl, make sure to run
# 'ConfigPerl; make regen_headers; make; make test' before running this script.
# Note also that if the patches include new files they will NOT be dealt with
# correctly by this script - you should update fhe Flist.csv file and copy the
# files across manually. Also, it will be necessary to manually generate and
# check in the appropriate config.h file for other architectures.
#
use 5.6.1;
use strict;
use warnings;
use POSIX qw(uname);
use File::Spec::Functions qw(:ALL);
use File::Copy;
@ARGV == 3 || die("Usage is $0 <mapping file> <perl build dir> <workspace>\n");
my ($mapfile, $src, $ws) = @ARGV;
$mapfile = rel2abs($mapfile);
$src = rel2abs($src);
$ws = rel2abs($ws);
my $dst = catdir($ws, '/usr/src/cmd/perl/5.6.1');
die("$src is not a perl build dir\n") if (! -f catfile($src, 'config.sh'));
die("$ws is not a workspace\n") if (! -d catdir($ws, 'Codemgr_wsdata'));
my $arch = ((uname())[4] eq 'i86pc') ? 'i386' : 'sparc';
my $otherarch = $arch eq 'i386' ? 'sparc' : 'i386';
# Read in the mapping file
print("Scanning for files to be patched, please wait.\n");
my ($fh, $line, %files);
open($fh, '<', $mapfile) || die("Can't open $mapfile: $!\n");
while (defined($line = <$fh>) && $line !~ /^Path/) {
;
}
while (defined($line = <$fh>)) {
$line =~ s/\r$//; chomp($line);
my ($path, $file, $p500503, $s8, $p561, $s9, $new) =
split(/,/, $line, 8);
$files{$path}{$file}{500503} = $p500503 if ($p500503);
$files{$path}{$file}{s8} = $s8 if ($s8);
$files{$path}{$file}{561} = $p561 if ($p561);
$files{$path}{$file}{s9} = $s9 if ($s9);
$files{$path}{$file}{new} = $new if ($new);
}
close($fh);
# Process the mappings, looking for files to patch.
my @patchfiles;
foreach my $path (sort(keys(%files))) {
foreach my $file (sort(keys(%{$files{$path}}))) {
my $rec = $files{$path}{$file};
next unless (exists($rec->{s9}));
my ($p, $f) = ($path, $file);
# If it is to go into the s9 distrib directory
if ($rec->{s9} eq 'distrib') {
my $sd = catdir($src, $p);
my $sf = catfile($sd, $f);
my $dd = catdir($dst, 'distrib', $p);
my $df = catfile($dd, $f);
if (system("cmp -s $sf $df")) {
my $sccs = catfile($dd, 'SCCS', "p.$f");
die(catfile('distrib', $p, $f),
" already edited\n") if (-f $sccs);
push(@patchfiles, { f => $f, p => $p,
sd => $sd, dd => $dd});
}
# If it is to go into the s9 arch directory
} elsif ($rec->{s9} eq 'arch' && $p !~ /$otherarch/) {
my $sd = catdir($src, $p);
my $sf = catfile($sd, $f);
my $dd = catdir($dst, $arch, $p);
my $df = catfile($dd, $f);
if (system("cmp -s $sf $df")) {
my $sccs = catfile($dd, 'SCCS', "p.$f");
die(catfile($arch, $p, $f),
" already edited\n") if (-f $sccs);
push(@patchfiles, { f => $f, p => $p,
sd => $sd, dd => $dd});
}
}
}
}
die("No files to patch\n") unless (@patchfiles);
print("Patching files:\n");
foreach my $p (@patchfiles) {
my ($f, $p, $sd, $dd) = @$p{qw(f p sd dd)};
my $pf = catfile($p, $f);
$pf =~ s!^\./!!;
my $sf = catfile($sd, $f);
my $df = catfile($dd, $f);
print("$pf\n");
system("cd $dd && sccs edit $f") == 0 || die("Can't check out $pf\n");
copy($sf, $df) || die("Can't copy $pf: $!\n");
}