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