Home | History | Annotate | Download | only in port
      1 #!/usr/perl5/5.8.4/bin/perl
      2 #
      3 # Copyright 2004 Sun Microsystems, Inc.  All rights reserved.
      4 # Use is subject to license terms.
      5 #
      6 #ident	"%Z%%M%	%I%	%E% SMI"
      7 #
      8 # This script takes a file mapping CSV file as input (see flist_5.8.4_on10.csv
      9 # for an example), a perl build directory and a ON workspace and reports files
     10 # that are different in the build and ON directories.  This show up any manual
     11 # edits that have been made during the integration process, useful for
     12 # identifying files that need to be preserved during future reintegrations.
     13 # Run with the '-d' option to produce a diff file suitable for applying with
     14 # gpatch.
     15 
     16 use strict;
     17 use warnings;
     18 use POSIX qw(uname);
     19 use Getopt::Std;
     20 
     21 #
     22 # Compare two files, return 0 for different, 1 for the same.
     23 #
     24 sub file_cmp
     25 {
     26 	my ($f1, $f2) = @_;
     27 
     28 	# Quick check - they must exist and be the same size.
     29 	return (0) unless (-e $f1 && -e $f2 && -s $f1 == -s $f2);
     30 
     31 	# Open the files.
     32 	my ($fh1, $fh2);
     33 	open($fh1, '<', $f1) || return (0);
     34 	open($fh2, '<', $f2) || return (0);
     35 
     36 	# Compare.
     37 	my ($len1, $len2);
     38 	while (1) {
     39 		my ($buf1, $buf2);
     40 		$len1 = sysread($fh1, $buf1, 4096);
     41 		$len2 = sysread($fh2, $buf2, 4096);
     42 		last if ($len1 == 0 && $len2 == 0);
     43 		if ($len1 != $len2 || $buf1 ne $buf2) {
     44 			$len1 = -1;
     45 			$len2 = -2;
     46 			last;
     47 		}
     48 	}
     49 	close($fh1) || return (0);
     50 	close($fh2) || return (0);
     51 	return ($len1 == $len2 ? 1 : 0);
     52 }
     53 
     54 #
     55 # Main.
     56 #
     57 
     58 # Basic sanity checks.
     59 our $opt_d;
     60 getopts('d') && @ARGV == 3 ||
     61    die("Usage is $0 [ -d ] <mapping file> <perl build dir> <workspace>\n");
     62 my ($mapfile, $bld, $ws) = @ARGV;
     63 die("$bld is not a perl build dir\n") if (! -f "$bld/config.sh");
     64 die("$ws is not a workspace\n") if (! -d "$ws/Codemgr_wsdata");
     65 my ($fh, $line);
     66 
     67 # Work out perl version.
     68 open($fh, '<', "$bld/patchlevel.h") || die("$bld is not a perl build dir\n");
     69 my ($r, $v, $s);
     70 while (defined($line = <$fh>)) {
     71 	($line =~ /#define\s+PERL_REVISION\s+(\S+)/) && ($r = $1);
     72 	($line =~ /#define\s+PERL_VERSION\s+(\S+)/) && ($v = $1);
     73 	($line =~ /#define\s+PERL_SUBVERSION\s+(\S+)/) && ($s = $1);
     74 	last if (defined($r) && defined($v) && defined ($s));
     75 }
     76 close($fh);
     77 die("Can't find perl version\n") 
     78     unless (defined($r) && defined($v) && defined($s));
     79 my $ver = "$r.$v.$s";
     80 undef($r);
     81 undef($v);
     82 undef($s);
     83 
     84 # Work out directory locations.
     85 our $ver_dst = "$ws/usr/src/cmd/perl/$ver";
     86 my $arch = ((uname())[4] eq 'i86pc') ? 'i386' : 'sparc';
     87 
     88 # Read in the mapping file.
     89 my %file;
     90 open($fh, '<', $mapfile) || die("Can't open $mapfile: $!\n");
     91 while (defined($line = <$fh>) && $line !~ m{^"Path",}) {
     92 	;
     93 }
     94 while (defined($line = <$fh>)) {
     95 	chomp($line);
     96 	my @field;
     97 	push(@field, $+) while $line =~
     98 	    m{["']([^"'\\]*(?:\\.[^"'\\]*)*)["'],?|([^,]+),?|,}g;
     99 	push(@field, undef) if (substr($line, -1, 1) eq ',');
    100 	my $p = shift(@field);
    101 	my $f = shift(@field);
    102 	# We just want the s10 column.
    103 	$file{$p}{$f} = defined($field[3]) ? $field[3] : '';
    104 }
    105 close($fh);
    106 
    107 # Process the mappings.
    108 foreach my $p (sort(keys(%file))) {
    109 	foreach my $f (sort(keys(%{$file{$p}}))) {
    110 		my $d = $file{$p}{$f};
    111 		my $pf = ($p ne '' ? "$p/" : $p) . $f;
    112 		my $cpf = ($p ne '' ? "$p/" : $p) . ",$f";
    113 		my ($src, $dst);
    114 
    115 		# If it has gone into the distrib directory.
    116 		if ($d eq 'distrib') {
    117 			$src = "$bld/$pf";
    118 			$dst = "$ver_dst/distrib/$pf";
    119 
    120 		# If it has gone into the arch directory.
    121 		} elsif ($d eq 'arch') {
    122 			$src = "$bld/$pf";
    123 			$dst = "$ver_dst/$arch/$f";
    124 
    125 		# If it is to be copied forwards from the last version.
    126 		} elsif ($d eq 'fwd') {
    127 			$dst = "$ver_dst/distrib/$pf";
    128 		}
    129 
    130 
    131 		# Short forms of the filenames.
    132 		my ($ssrc, $sdst);
    133 		if ($src) {
    134 			$ssrc = $src;
    135 			$ssrc =~ s{^$bld/}{}o;
    136 			$ssrc =~ s{[^/]+/\.\./}{}g;
    137 		}
    138 		if ($dst) {
    139 			$sdst = $dst;
    140 			$sdst =~ s{^$ver_dst/}{}o;
    141 			$sdst =~ s{[^/]+/\.\./}{}g;
    142 		}
    143 
    144 		# New files.
    145 		if (! $src && $dst) {
    146 			if (! $opt_d) {
    147 				print("New:    $sdst\n");
    148 			}
    149 
    150 		# Modified files.
    151 		} elsif ($src && $dst && ! file_cmp($src, $dst)) {
    152 			if ($opt_d) {
    153 				system("diff -u $src $dst | " .
    154 				    "sed -e 's!$src!$ssrc!g' " .
    155 				    "-e 's!$dst!$sdst!g'");
    156 			} else {
    157 				print("Edited: $sdst\n");
    158 			}
    159 		}
    160 	}
    161 }
    162