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 works out which files from a stock Perl 5.8.3 distribution need 9# to be integrated into ON. It MUST be run inside a stock perl distribution 10# directory AFTER the InstallPerl script has been run, as it uses the contents 11# of the MANIFEST, build.touched, test.log and install.packlist files to figure 12# out which files are needed in ON. The parameter for this script is the name 13# of the output CSV file, which can be viewed in StarOffice. 14# 15 16use strict; 17use warnings; 18 19# 20# Compare two files, return 0 for different, 1 for the same. 21# 22sub file_cmp 23{ 24 my ($f1, $f2) = @_; 25 26 # Quick check - they must exist and be the same size. 27 return (0) unless (-e $f1 && -e $f2 && -s $f1 == -s $f2); 28 29 # Open the files. 30 my ($fh1, $fh2); 31 open($fh1, '<', $f1) || return (0); 32 open($fh2, '<', $f2) || return (0); 33 34 # Compare. 35 my ($len1, $len2); 36 while (1) { 37 my ($buf1, $buf2); 38 $len1 = sysread($fh1, $buf1, 4096); 39 $len2 = sysread($fh2, $buf2, 4096); 40 last if ($len1 == 0 && $len2 == 0); 41 if ($len1 != $len2 || $buf1 ne $buf2) { 42 $len1 = -1; 43 $len2 = -2; 44 last; 45 } 46 } 47 close($fh1) || return (0); 48 close($fh2) || return (0); 49 return ($len1 == $len2 ? 1 : 0); 50} 51 52# 53# Main. 54# 55 56# %file is indexed by (path, filename) 57my ($infh, $outfh, $line, %file); 58 59# Check args. 60die("Args are <output.csv>\n") unless (@ARGV == 1); 61my ($outf) = @ARGV; 62 63# Check cwd is a valid perl build dir. 64die("Must be run from a perl build directory\n") 65 unless (-f 'config.over' && -f 'MANIFEST' && -f 'Configure' && 66 -f 'libperl.so' && -f 'build.touched' && -f 'install.packlist'); 67 68# Open output CSV file. 69open($outfh, '>', $outf) || die("Can't open $outf: $!\n"); 70 71# Read the MANIFEST. 72open($infh, '<', 'MANIFEST') || die("Can't open MANIFEST: $!\n"); 73while (defined($line = <$infh>)) { 74 chomp($line); 75 $line = (split(m{\s+}, $line, 2))[0]; 76 my ($p, $f); 77 if ($line =~ m{/}) { 78 ($p, $f) = $line =~ m{^(.*)/(.*)$}; 79 } else { 80 $p = ''; 81 $f = $line; 82 } 83 $file{$p}{$f}{mfst} = 'X'; 84} 85close($infh); 86 87# Read build.touched. 88open($infh, '<', 'build.touched') || die("Can't open build.touched: $!\n"); 89while (defined($line = <$infh>)) { 90 chomp($line); 91 my ($p, $f); 92 if ($line =~ m{/}) { 93 ($p, $f) = $line =~ m{^(.*)/(.*)$}; 94 } else { 95 $p = ''; 96 $f = $line; 97 } 98 $file{$p}{$f}{bld} = 'X'; 99} 100close($infh); 101 102# Read test.log. 103open($infh, '<', 'test.log') || die("Can't open test.log: $!\n"); 104my %test; 105while (defined($line = <$infh>)) { 106 chomp($line); 107 if ($line =~ m{^([\w/-]+)\.{2,}} && $line !~ /\.skipping test/) { 108 my $file = $1; 109 if (-f ($_ = "$file.t")) { 110 $test{$_} = 1; 111 } elsif ($file =~ m{/test$} && -f ($_ = "$file.pl")) { 112 $test{$_} = 1; 113 } 114 } 115} 116close($infh); 117 118# Read install.packlist and build a hash indexed by (filename, path). 119my %inst; 120open($infh, '<', 'install.packlist') 121 || die("Can't open install.packlist: $!\n"); 122$line = <$infh>; 123chomp($line); 124my $inst_pfx; 125die("Invalid install.packlist\n") 126 unless (($inst_pfx) = $line =~ /^PREFIX:\s+(.*)$/); 127while (defined($line = <$infh>)) { 128 # Skip manpages and bin/perlX.Y.Z 129 #next if ($line =~ m{^(?:man/man\d+/|bin/perl\d+\.\d+\.\d+)}); 130 chomp($line); 131 my ($p, $f); 132 if ($line =~ m{/}) { 133 ($p, $f) = $line =~ m{^(.*)/(.*)$}; 134 } else { 135 $p = ''; 136 $f = $line; 137 } 138 $inst{$f}{$p} = 1; 139} 140close($infh); 141 142# Go through the MANIFEST files, trying to match to installed files. 143foreach my $p (keys(%file)) { 144 foreach my $f (keys(%{$file{$p}})) { 145 my $v = $file{$p}{$f}; 146 next unless (exists($v->{mfst})); 147 148 # 149 # Easy cases: Files that map directly into the install tree 150 # 151 if (exists($inst{$f}{$p})) { 152 $v->{inst} = 'X'; 153 delete($inst{$f}{$p}); 154 155 # 156 # Brute force: Compare the manifest file against each file with 157 # the same name in the install tree. 158 # 159 } else { 160 foreach my $ip (keys(%{$inst{$f}})) { 161 my ($mfst, $inst); 162 $mfst = "$p/" if ($p ne ''); 163 $mfst .= $f; 164 $inst = $inst_pfx; 165 $inst .= "/$ip" if ($ip); 166 $inst .= "/$f"; 167 if (file_cmp($mfst, $inst)) { 168 $v->{inst} = 'X'; 169 delete($inst{$f}{$p}); 170 } 171 } 172 } 173 } 174 175} 176undef(%inst); 177 178# Intuit where we think the 5.8.x files should go in S10. 179foreach my $p (keys(%file)) { 180 foreach my $f (keys(%{$file{$p}})) { 181 my $v = $file{$p}{$f}; 182 my $pf = ($p ne '' ? "$p/" : $p) . $f; 183 184 # 185 # Some directories and files we can ignore completely, 186 # for example other architectures. 187 # 188 if ($p =~ m{^(?:Cross|NetWare|apollo|beos|cydwin|djgpp|emacs| 189 epoc|jpl|mint|mpeix|os2|plan9|qnx|uts|vmesa|vms|vos|win32| 190 wince|t/win32|lib/Thread|ext/threads)}x || 191 $f =~ m{Makefile.SH|Thread.pm}) { 192 $v->{s10} = 'skip'; 193 194 # 195 # Stuff that we don't want from the top-level directory. 196 # 197 } elsif ($p eq '' && 198 $f =~ m{^(?:[Cc]onfigure.*|Makefile\.SH|Policy_sh.SH| 199 cflags\.SH|makeaperl\.SH|makedepend\.SH|makedir\.SH| 200 mv-if-diff)$}x) { 201 $v->{s10} = 'skip'; 202 203 # 204 # We don't want README and other such files. 205 # 206 } elsif (($f =~ m{^(?:(?:readme|change|notes|patching).*| 207 manifest)$}ix && $f !~ m{\.e2x$}) || 208 ($f =~ m{^todo}i && $p !~ m{^t/|/t/|/t$})) { 209 $v->{s10} = 'skip'; 210 211 # 212 # Pod files need a little finesse. 213 # We don't want any that are links to README files in the 214 # top-level directory, unless they are the Solaris or Unicode 215 # ones. We also exclude some others that aren't relevant, 216 # and include some that would otherwise be missed. 217 # 218 } elsif (($_) = $f =~ m{(\w+)\.pod$}) { 219 $_ =~ s{^perl}{}; 220 if (exists($file{''}{"README.$_"})) { 221 if ($_ =~ m{^(?:solaris|cn|jp|ko|tw)$}) { 222 $v->{s10} = 'distrib'; 223 } else { 224 $v->{s10} = 'skip'; 225 } 226 } elsif (($v->{mfst} && ($v->{bld} || $v->{inst})) && 227 $_ !~ m{^(?:Config|fork|othrtut|thrtut|pumpkin| 228 Win32|repository)$}x) { 229 $v->{s10} = 'distrib'; 230 # perldelta.pod is a symlink, but we need to copy it. 231 } elsif ($_ eq 'delta') { 232 $v->{s10} = 'distrib'; 233 } else { 234 $v->{s10} = 'skip'; 235 } 236 237 # 238 # We only want test scripts that are actually run. 239 # 240 } elsif ($f =~ m{\.t$} || $f eq 'test.pl') { 241 if (exists($test{$pf}) || $pf eq 't/test.pl') { 242 $v->{s10} = 'distrib'; 243 } else { 244 $v->{s10} = 'skip'; 245 } 246 247 # 248 # Anything in the MANIFEST and touched during the 249 # build and install should be included. 250 # 251 } elsif ($v->{mfst} && ($v->{bld} || $v->{inst})) { 252 $v->{s10} = 'distrib'; 253 254 } else { 255 $v->{s10} = 'skip'; 256 257 } 258 } 259} 260 261# 262# Files that we need to treat specially. 263# 264$file{'..'}{'extract_config.sh'}{s10} = 'fwd'; 265$file{'..'}{'extract_makeext.sh'}{s10} = 'fwd'; 266$file{'..'}{'get_no_keywords.sh'}{s10} = 'fwd'; 267$file{'..'}{'Makefile'}{s10} = 'fwd'; 268$file{'..'}{'req.flg'}{s10} = 'fwd'; 269$file{'../contrib'}{'Makefile'}{s10} = 'fwd'; 270$file{''}{'config.sh'}{s10} = 'arch'; 271$file{''}{'installperl'}{s10} = 'distrib'; 272$file{''}{'utils.lst'}{s10} = 'distrib'; 273$file{''}{'Makefile'}{s10} = 'fwd'; 274$file{''}{'Makefile.lib'}{s10} = 'fwd'; 275$file{'pod'}{'Makefile'}{s10} = 'fwd'; 276$file{'utils'}{'Makefile'}{s10} = 'fwd'; 277$file{'x2p'}{'Makefile'}{s10} = 'fwd'; 278 279# Write CSV contents. 280print $outfh (qq{"Path","File","mfst","bld","inst","s10"\n}); 281foreach my $p (sort(keys(%file))) { 282 foreach my $f (sort(keys(%{$file{$p}}))) { 283 print $outfh (qq{"$p","$f"}); 284 foreach my $c (qw{mfst bld inst s10}) { 285 print $outfh (','); 286 print $outfh (qq{"$file{$p}{$f}{$c}"}) 287 if (defined($file{$p}{$f}{$c})); 288 } 289 print $outfh ("\n"); 290 } 291} 292close($outfh); 293