#!/usr/perl5/5.8.4/bin/perl
#
# Copyright 2004 Sun Microsystems, Inc. All rights reserved.
# Use is subject to license terms.
#
#ident "%Z%%M% %I% %E% SMI"
#
# This script works out which files from a stock Perl 5.8.3 distribution need
# to be integrated into ON. It MUST be run inside a stock perl distribution
# directory AFTER the InstallPerl script has been run, as it uses the contents
# of the MANIFEST, build.touched, test.log and install.packlist files to figure
# out which files are needed in ON. The parameter for this script is the name
# of the output CSV file, which can be viewed in StarOffice.
#
use strict;
use warnings;
#
# Compare two files, return 0 for different, 1 for the same.
#
sub file_cmp
{
my ($f1, $f2) = @_;
# Quick check - they must exist and be the same size.
return (0) unless (-e $f1 && -e $f2 && -s $f1 == -s $f2);
# Open the files.
my ($fh1, $fh2);
open($fh1, '<', $f1) || return (0);
open($fh2, '<', $f2) || return (0);
# Compare.
my ($len1, $len2);
while (1) {
my ($buf1, $buf2);
$len1 = sysread($fh1, $buf1, 4096);
$len2 = sysread($fh2, $buf2, 4096);
last if ($len1 == 0 && $len2 == 0);
if ($len1 != $len2 || $buf1 ne $buf2) {
$len1 = -1;
$len2 = -2;
last;
}
}
close($fh1) || return (0);
close($fh2) || return (0);
return ($len1 == $len2 ? 1 : 0);
}
#
# Main.
#
# %file is indexed by (path, filename)
my ($infh, $outfh, $line, %file);
# Check args.
die("Args are <output.csv>\n") unless (@ARGV == 1);
my ($outf) = @ARGV;
# Check cwd is a valid perl build dir.
die("Must be run from a perl build directory\n")
unless (-f 'config.over' && -f 'MANIFEST' && -f 'Configure' &&
-f 'libperl.so' && -f 'build.touched' && -f 'install.packlist');
# Open output CSV file.
open($outfh, '>', $outf) || die("Can't open $outf: $!\n");
# Read the MANIFEST.
open($infh, '<', 'MANIFEST') || die("Can't open MANIFEST: $!\n");
while (defined($line = <$infh>)) {
chomp($line);
$line = (split(m{\s+}, $line, 2))[0];
my ($p, $f);
if ($line =~ m{/}) {
($p, $f) = $line =~ m{^(.*)/(.*)$};
} else {
$p = '';
$f = $line;
}
$file{$p}{$f}{mfst} = 'X';
}
close($infh);
# Read build.touched.
open($infh, '<', 'build.touched') || die("Can't open build.touched: $!\n");
while (defined($line = <$infh>)) {
chomp($line);
my ($p, $f);
if ($line =~ m{/}) {
($p, $f) = $line =~ m{^(.*)/(.*)$};
} else {
$p = '';
$f = $line;
}
$file{$p}{$f}{bld} = 'X';
}
close($infh);
# Read test.log.
open($infh, '<', 'test.log') || die("Can't open test.log: $!\n");
my %test;
while (defined($line = <$infh>)) {
chomp($line);
if ($line =~ m{^([\w/-]+)\.{2,}} && $line !~ /\.skipping test/) {
my $file = $1;
if (-f ($_ = "$file.t")) {
$test{$_} = 1;
} elsif ($file =~ m{/test$} && -f ($_ = "$file.pl")) {
$test{$_} = 1;
}
}
}
close($infh);
# Read install.packlist and build a hash indexed by (filename, path).
my %inst;
open($infh, '<', 'install.packlist')
|| die("Can't open install.packlist: $!\n");
$line = <$infh>;
chomp($line);
my $inst_pfx;
die("Invalid install.packlist\n")
unless (($inst_pfx) = $line =~ /^PREFIX:\s+(.*)$/);
while (defined($line = <$infh>)) {
# Skip manpages and bin/perlX.Y.Z
#next if ($line =~ m{^(?:man/man\d+/|bin/perl\d+\.\d+\.\d+)});
chomp($line);
my ($p, $f);
if ($line =~ m{/}) {
($p, $f) = $line =~ m{^(.*)/(.*)$};
} else {
$p = '';
$f = $line;
}
$inst{$f}{$p} = 1;
}
close($infh);
# Go through the MANIFEST files, trying to match to installed files.
foreach my $p (keys(%file)) {
foreach my $f (keys(%{$file{$p}})) {
my $v = $file{$p}{$f};
next unless (exists($v->{mfst}));
#
# Easy cases: Files that map directly into the install tree
#
if (exists($inst{$f}{$p})) {
$v->{inst} = 'X';
delete($inst{$f}{$p});
#
# Brute force: Compare the manifest file against each file with
# the same name in the install tree.
#
} else {
foreach my $ip (keys(%{$inst{$f}})) {
my ($mfst, $inst);
$mfst = "$p/" if ($p ne '');
$mfst .= $f;
$inst = $inst_pfx;
$inst .= "/$ip" if ($ip);
$inst .= "/$f";
if (file_cmp($mfst, $inst)) {
$v->{inst} = 'X';
delete($inst{$f}{$p});
}
}
}
}
}
undef(%inst);
# Intuit where we think the 5.8.x files should go in S10.
foreach my $p (keys(%file)) {
foreach my $f (keys(%{$file{$p}})) {
my $v = $file{$p}{$f};
my $pf = ($p ne '' ? "$p/" : $p) . $f;
#
# Some directories and files we can ignore completely,
# for example other architectures.
#
if ($p =~ m{^(?:Cross|NetWare|apollo|beos|cydwin|djgpp|emacs|
epoc|jpl|mint|mpeix|os2|plan9|qnx|uts|vmesa|vms|vos|win32|
wince|t/win32|lib/Thread|ext/threads)}x ||
$f =~ m{Makefile.SH|Thread.pm}) {
$v->{s10} = 'skip';
#
# Stuff that we don't want from the top-level directory.
#
} elsif ($p eq '' &&
$f =~ m{^(?:[Cc]onfigure.*|Makefile\.SH|Policy_sh.SH|
cflags\.SH|makeaperl\.SH|makedepend\.SH|makedir\.SH|
mv-if-diff)$}x) {
$v->{s10} = 'skip';
#
# We don't want README and other such files.
#
} elsif (($f =~ m{^(?:(?:readme|change|notes|patching).*|
manifest)$}ix && $f !~ m{\.e2x$}) ||
($f =~ m{^todo}i && $p !~ m{^t/|/t/|/t$})) {
$v->{s10} = 'skip';
#
# Pod files need a little finesse.
# We don't want any that are links to README files in the
# top-level directory, unless they are the Solaris or Unicode
# ones. We also exclude some others that aren't relevant,
# and include some that would otherwise be missed.
#
} elsif (($_) = $f =~ m{(\w+)\.pod$}) {
$_ =~ s{^perl}{};
if (exists($file{''}{"README.$_"})) {
if ($_ =~ m{^(?:solaris|cn|jp|ko|tw)$}) {
$v->{s10} = 'distrib';
} else {
$v->{s10} = 'skip';
}
} elsif (($v->{mfst} && ($v->{bld} || $v->{inst})) &&
$_ !~ m{^(?:Config|fork|othrtut|thrtut|pumpkin|
Win32|repository)$}x) {
$v->{s10} = 'distrib';
# perldelta.pod is a symlink, but we need to copy it.
} elsif ($_ eq 'delta') {
$v->{s10} = 'distrib';
} else {
$v->{s10} = 'skip';
}
#
# We only want test scripts that are actually run.
#
} elsif ($f =~ m{\.t$} || $f eq 'test.pl') {
if (exists($test{$pf}) || $pf eq 't/test.pl') {
$v->{s10} = 'distrib';
} else {
$v->{s10} = 'skip';
}
#
# Anything in the MANIFEST and touched during the
# build and install should be included.
#
} elsif ($v->{mfst} && ($v->{bld} || $v->{inst})) {
$v->{s10} = 'distrib';
} else {
$v->{s10} = 'skip';
}
}
}
#
# Files that we need to treat specially.
#
$file{'..'}{'extract_config.sh'}{s10} = 'fwd';
$file{'..'}{'extract_makeext.sh'}{s10} = 'fwd';
$file{'..'}{'get_no_keywords.sh'}{s10} = 'fwd';
$file{'..'}{'Makefile'}{s10} = 'fwd';
$file{'..'}{'req.flg'}{s10} = 'fwd';
$file{'../contrib'}{'Makefile'}{s10} = 'fwd';
$file{''}{'config.sh'}{s10} = 'arch';
$file{''}{'installperl'}{s10} = 'distrib';
$file{''}{'utils.lst'}{s10} = 'distrib';
$file{''}{'Makefile'}{s10} = 'fwd';
$file{''}{'Makefile.lib'}{s10} = 'fwd';
$file{'pod'}{'Makefile'}{s10} = 'fwd';
$file{'utils'}{'Makefile'}{s10} = 'fwd';
$file{'x2p'}{'Makefile'}{s10} = 'fwd';
# Write CSV contents.
print $outfh (qq{"Path","File","mfst","bld","inst","s10"\n});
foreach my $p (sort(keys(%file))) {
foreach my $f (sort(keys(%{$file{$p}}))) {
print $outfh (qq{"$p","$f"});
foreach my $c (qw{mfst bld inst s10}) {
print $outfh (',');
print $outfh (qq{"$file{$p}{$f}{$c}"})
if (defined($file{$p}{$f}{$c}));
}
print $outfh ("\n");
}
}
close($outfh);