[differences between cumulative patch application and perl5.004_01]perl-5.004_01

[editor's note: The changes between this and 5.004 were processed from
the m1t2 release, which was a bad idea as it was the _01 release which
had the final corrected attributions.  The differences between the
various m*t* releases do that; I considered it most valuable just to
look at the _NN releases.  Many patches have been separated out and/or
applied from the p5p archives nonetheless.]

1 files changed, 127 insertions, 76 deletions

diff --git a/Porting/patchls b/Porting/patchls
index e9e902fc48..b3e968de4b 100644..100755
--- a/Porting/patchls
+++ b/Porting/patchls
@@ -1,20 +1,41 @@
 #!/bin/perl -w
 # 
-# Originally from Tom Horsley. Generally hacked and extended by Tim Bunce.
+#	patchls - patch listing utility
 #
 # Input is one or more patchfiles, output is a list of files to be patched.
 #
+# Copyright (c) 1997 Tim Bunce. All rights reserved.
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+#
+# With thanks to Tom Horsley for the seed code.
+#
 # $Id: patchls,v 1.3 1997/06/10 21:38:45 timbo Exp $
 
-require "getopts.pl";
-
+use Getopt::Std;
 use Text::Wrap qw(wrap $columns);
 use Text::Tabs qw(expand unexpand);
 use strict;
 
+sub usage {
+die qq{
+
+  patchls [options] patchfile [ ... ]
+
+    -i     Invert: for each patched file list which patch files patch it
+    -h     no filename headers (like grep), only the listing
+    -l     no listing (like grep), only the filename headers
+    -c     Categorise the patch and sort by category (perl specific)
+    -m     print formatted Meta-information (Subject,From,Msg-ID etc)
+    -p N   strip N levels of directory Prefix (like patch), else automatic
+    -v     more verbose (-d for noisy debugging)
+
+}
+}
+
 $columns = 70;
 
-$::opt_p = undef;	# like patch -pN, strip off N dir levels from file names
+$::opt_p = undef;	# undef != 0
 $::opt_d = 0;
 $::opt_v = 0;
 $::opt_m = 0;
@@ -23,22 +44,20 @@ $::opt_h = 0;
 $::opt_l = 0;
 $::opt_c = 0;
 
-die qq{
-
-  patchls [options] patchfile [ ... ]
-
-    -m     print formatted Meta-information (Subject,From,Msg-ID etc)
-    -p N   strip N levels of directory Prefix (like patch), else automatic
-    -i     Invert: for each patched file list which patch files patch it
-    -h     no filename headers (like grep), only the listing
-    -l     no listing (like grep), only the filename headers
-    -c     attempt to Categorise the patch (sort by category with -m)
-    -v     more verbose
-    -d     still more verbosity for debugging
+usage unless @ARGV;
 
-} unless @ARGV;
+getopts("mihlvcp:") or usage;
 
-&Getopts("mihlvcp:");
+my %cat_title = (
+    'TEST'	=> 'TESTS',
+    'DOC'	=> 'DOCUMENTATION',
+    'UTIL'	=> 'UTILITIES',
+    'PORT'	=> 'PORTABILITY',
+    'LIB'	=> 'LIBRARY AND EXTENSIONS',
+    'CORE'	=> 'CORE LANGUAGE',
+    'BUILD'	=> 'BUILD PROCESS',
+    'OTHER'	=> 'OTHER',
+);
 
 my %ls;
 
@@ -69,7 +88,7 @@ foreach my $argv (@ARGV) {
 	next;
     }
     print "Reading $in...\n" if $::opt_v and @ARGV > 1;
-    $ls = $ls{$in} ||= { in => $in };
+    $ls = $ls{$in} ||= { is_in => 1, in => $in };
     my $type;
     while (<F>) {
 	unless (/^([-+*]{3}) / || /^(Index):/) {
@@ -87,7 +106,9 @@ foreach my $argv (@ARGV) {
 	print "Last: $prevline","This: ${_}Got:  $1\n\n" if $::opt_d;
 
 	# Some patches have Index lines but not diff headers
-	# Patch copes with this, so must we
+	# Patch copes with this, so must we. It's also handy for
+	# documenting manual changes by simply adding Index: lines
+	# to the file which describes the problem bing fixed.
 	add_file($ls, $1), next if /^Index:\s+(.*)/;
 
 	if (	($type eq '---' and $prevtype eq '***')	# Style 1
@@ -106,34 +127,67 @@ foreach my $argv (@ARGV) {
 	$prevtype = $type;
 	$type = '';
     }
-    $ls->{Title}{$in}=1 if !$ls->{Title} and $::opt_m and $::opt_c
-				and $ls->{files_by_patch};
-    $ls->{category} = intuit_category($ls, $::opt_v) if $::opt_c;
+    # if we don't have a title for -m then use the file name
+    $ls->{Title}{$in}=1 if $::opt_m
+	and !$ls->{Title} and $ls->{out};
+
+    $ls->{category} = $::opt_c
+	? categorize_files([keys %{ $ls->{out} }], $::opt_v) : '';
 }
-print "All files read.\n" if $::opt_v and @ARGV > 1;
+print scalar(@ARGV)." files read.\n" if $::opt_v and @ARGV > 1;
+
+
+my @ls  = sort {
+    $a->{category} cmp $b->{category} || $a->{in} cmp $b->{in}
+} values %ls;
 
 unless ($::opt_c and $::opt_m) {
-    foreach $in (sort keys %ls) {
-	$ls = $ls{$in};
+    foreach $ls (@ls) {
+	next unless ($::opt_i) ? $ls->{is_out} : $ls->{is_in};
 	list_files_by_patch($ls);
     }
 }
 else {
     my $c = '';
-    foreach $ls (sort { $a->{category} cmp $b->{category} } values %ls) {
-	print "\n  $ls->{category}\n" if $ls->{category} ne $c;
+    foreach $ls (@ls) {
+	next unless ($::opt_i) ? $ls->{is_out} : $ls->{is_in};
+	print "\n  $cat_title{$ls->{category}}\n" if $ls->{category} ne $c;
 	$c = $ls->{category};
-	list_files_by_patch($ls);
+	unless ($::opt_i) {
+	    list_files_by_patch($ls);
+	}
+	else {
+	    my $out = $ls->{in};
+	    print "\n$out patched by:\n";
+	    # find all the patches which patch $out and list them
+	    my @p = grep { $_->{out}->{$out} } values %ls;
+	    foreach $ls (@p) {
+		list_files_by_patch($ls, '');
+	    }
+	}
     }
     print "\n";
 }
 
+exit 0;
+
+
+# ---
+
 
 sub add_file {
     my $ls = shift;
     my $out = trim_name(shift);
-    ($ls, $out) = ($ls{$out} ||= { in => $out }, $in) if $::opt_i;
-    $ls->{files_by_patch}->{$out} = 1;
+
+    $ls->{out}->{$out} = 1;
+
+    # do the -i inverse as well, even if we're not doing -i
+    my $i = $ls{$out} ||= {
+	is_out   => 1,
+	in       => $out,
+	category => $::opt_c ? categorize_files([ $out ], $::opt_v) : '',
+    };
+    $i->{out}->{$in} = 1;
 }
 
 
@@ -156,8 +210,8 @@ sub trim_name {		# reduce/tidy file paths from diff lines
 
 
 sub list_files_by_patch {
-    my $ls = shift;
-    my $name = $ls->{in};
+    my($ls, $name) = @_;
+    $name = $ls->{in} unless defined $name;
     my @meta;
     if ($::opt_m) {
 	foreach(qw(Title From Msg-ID)) {
@@ -167,18 +221,18 @@ sub list_files_by_patch {
 	    @list = map { "\"$_\"" } @list if $_ eq 'Title';
 	    push @meta, my_wrap("","          ", join(", ",@list)."\n");
 	}
-	$name = "\n$name" if @meta;
+	$name = "\n$name" if @meta and $name;
     }
     # don't print the header unless the file contains something interesting
-    return if !@meta and !$ls->{files_by_patch};
+    return if !@meta and !$ls->{out};
     print("$ls->{in}\n"),return  if $::opt_l;	# -l = no listing
 
-	# a twisty maze of little options
-    my $cat = ($ls->{category} and !$::opt_m) ? " $ls->{category}" : "";
-    print "$name$cat: "	unless $::opt_h and !$::opt_v;
+    # a twisty maze of little options
+    my $cat = ($ls->{category} and !$::opt_m) ? "\t$ls->{category}" : "";
+    print "$name$cat: "	unless ($::opt_h and !$::opt_v) or !"$name$cat";
     print join('',"\n",@meta) if @meta;
 
-    my @v = sort PATORDER keys %{ $ls->{files_by_patch} };
+    my @v = sort PATORDER keys %{ $ls->{out} };
     my $v = "@v\n";
     print $::opt_m ? "  Files:  ".my_wrap("","          ",$v) : $v;
 }
@@ -190,53 +244,50 @@ sub my_wrap {
 
 
 
-# CORE LANGUAGE CHANGES
-# CORE PORTABILITY
-# OTHER CORE CHANGES
-# BUILD PROCESS
-# LIBRARY AND EXTENSIONS
-# TESTS
-# UTILITIES
-# DOCUMENTATION
-
-sub intuit_category {
-    my($ls, $verb) = @_;
-    return 'OTHER' unless $ls->{files_by_patch};
+sub categorize_files {
+    my($files, $verb) = @_;
     my(%c, $refine);
-    foreach (keys %{ $ls->{files_by_patch} }) {
-	++$c{'DOCUMENTATION'},next
-	    if m:^pod/:;
-	++$c{'UTILITIES'},next
-	    if m:^(utils|x2p|h2pl)/:;
-	++$c{'PORTABILITY'},next
+
+    foreach (@$files) {	# assign a score to a file path
+	# the order of some of the tests is important
+	$c{TEST} += 5,next   if m:^t/:;
+	$c{DOC}  += 5,next   if m:^pod/:;
+	$c{UTIL} += 10,next  if m:^(utils|x2p|h2pl)/:;
+	$c{PORT} += 15,next
 	    if m:^(cygwin32|os2|plan9|qnx|vms|win32)/:
 	    or m:^(hints|Porting|ext/DynaLoader)/:
 	    or m:^README\.:;
-	++$c{'LIBRARY AND EXTENSIONS'},next
+	$c{LIB}  += 10,next
 	    if m:^(lib|ext)/:;
-	++$c{'TESTS'},next
-	    if m:^t/:;
-	++$c{'CORE LANGUAGE'},next
-	    if m:^[^/]+\.([chH]|sym)$:;
-	++$c{'BUILD PROCESS'},next
+	$c{'CORE'} += 15,next
+	    if m:^[^/]+[\._]([chH]|sym)$:;
+	$c{BUILD} += 10,next
 	    if m:^[A-Z]+$: or m:^[^/]+\.SH$:
 	    or m:^(install|configure):i;
 	print "Couldn't categorise $_\n" if $::opt_v;
-	++$c{OTHER};
+	$c{OTHER} += 1;
+    }
+    if (keys %c > 1) {	# sort to find category with highest score
+      refine:
+	++$refine;
+	my @c = sort { $c{$b} <=> $c{$a} || $a cmp $b } keys %c;
+	my @v = map  { $c{$_} } @c;
+	if (@v > 1 and $refine <= 1 and "@v" =~ /^(\d) \1/
+		and $c[0] =~ m/^(DOC|TESTS|OTHER)/) { # rare
+	    print "Tie, promoting $c[1] over $c[0]\n" if $::opt_d;
+	    ++$c{$c[1]};
+	    goto refine;
+	}
+	print "  ".@$files." patches: ", join(", ", map { "$_: $c{$_}" } @c),".\n"
+	    if $verb;
+	return $c[0] || 'OTHER';
     }
-refine:
-    ++$refine;
-    my @c = sort { $c{$b} <=> $c{$a} || $a cmp $b } keys %c;
-    my @v = map  { $c{$_} } @c;
-    if (@v > 1 and $refine <= 1 and "@v" =~ /^(\d) \1/
-	    and $c[0] =~ m/^(DOC|TESTS|OTHER)/) {
-	print "Tie, promoting $c[1] over $c[0]\n" if $::opt_d;
-	++$c{$c[1]};
-	goto refine;
+    else {
+	my($c, $v) = %c;
+	$c ||= 'OTHER'; $v ||= 0;
+	print "  ".@$files." patches: $c: $v\n" if $verb;
+	return $c;
     }
-    print "  ", join(", ", map { "$_: $c{$_}" } @c),".\n"
-	if $verb and @v > 1;
-    return $c[0];
 }