3 # patchls - patch listing utility
5 # Input is one or more patchfiles, output is a list of files to be patched.
7 # Copyright (c) 1997 Tim Bunce. All rights reserved.
8 # This program is free software; you can redistribute it and/or
9 # modify it under the same terms as Perl itself.
11 # With thanks to Tom Horsley for the seed code.
13 # $Id: patchls,v 1.3 1997/06/10 21:38:45 timbo Exp $
16 use Text::Wrap qw(wrap $columns);
17 use Text::Tabs qw(expand unexpand);
23 patchls [options] patchfile [ ... ]
25 -i Invert: for each patched file list which patch files patch it
26 -h no filename headers (like grep), only the listing
27 -l no listing (like grep), only the filename headers
28 -c Categorise the patch and sort by category (perl specific)
29 -m print formatted Meta-information (Subject,From,Msg-ID etc)
30 -p N strip N levels of directory Prefix (like patch), else automatic
31 -v more verbose (-d for noisy debugging)
38 $::opt_p = undef; # undef != 0
49 getopts("mihlvcp:") or usage;
53 'DOC' => 'DOCUMENTATION',
54 'UTIL' => 'UTILITIES',
55 'PORT' => 'PORTABILITY',
56 'LIB' => 'LIBRARY AND EXTENSIONS',
57 'CORE' => 'CORE LANGUAGE',
58 'BUILD' => 'BUILD PROCESS',
65 # *** perl-5.004/embed.h Sat May 10 03:39:32 1997
66 # --- perl-5.004.fixed/embed.h Thu May 29 19:48:46 1997
72 # --- perl5.004001/mg.c Sun Jun 08 12:26:24 1997
73 # +++ perl5.004-bc/mg.c Sun Jun 08 11:56:08 1997
74 # @@ -656,9 +656,27 @@
75 # or (rcs, note the different date format)
76 # --- 1.18 1997/05/23 19:22:04
77 # +++ ./pod/perlembed.pod 1997/06/03 21:41:38
82 my($in, $prevline, $prevtype, $ls);
84 foreach my $argv (@ARGV) {
86 unless (open F, "<$in") {
87 warn "Unable to open $in: $!\n";
90 print "Reading $in...\n" if $::opt_v and @ARGV > 1;
91 $ls = $ls{$in} ||= { is_in => 1, in => $in };
94 unless (/^([-+*]{3}) / || /^(Index):/) {
95 # not an interesting patch line but possibly meta-information
97 $ls->{From}{$1}=1 if /^From: (.*\S)/i;
98 $ls->{Title}{$1}=1 if /^Subject: (?:Re: )?(.*\S)/i;
99 $ls->{'Msg-ID'}{$1}=1 if /^Message-Id: (.*\S)/i;
100 $ls->{Date}{$1}=1 if /^Date: (.*\S)/i;
104 next if /^--- [0-9,]+ ----$/ || /^\*\*\* [0-9,]+ \*\*\*\*$/;
106 print "Last: $prevline","This: ${_}Got: $1\n\n" if $::opt_d;
108 # Some patches have Index lines but not diff headers
109 # Patch copes with this, so must we. It's also handy for
110 # documenting manual changes by simply adding Index: lines
111 # to the file which describes the problem bing fixed.
112 add_file($ls, $1), next if /^Index:\s+(.*)/;
114 if ( ($type eq '---' and $prevtype eq '***') # Style 1
115 or ($type eq '+++' and $prevtype eq '---') # Style 2
117 if (/^[-+*]{3} (\S+)\s+.*\d\d:\d\d:\d\d/) { # double check
121 warn "$in $.: parse error (prev $prevtype, type $type)\n$prevline$_";
130 # if we don't have a title for -m then use the file name
131 $ls->{Title}{$in}=1 if $::opt_m
132 and !$ls->{Title} and $ls->{out};
134 $ls->{category} = $::opt_c
135 ? categorize_files([keys %{ $ls->{out} }], $::opt_v) : '';
137 print scalar(@ARGV)." files read.\n" if $::opt_v and @ARGV > 1;
141 $a->{category} cmp $b->{category} || $a->{in} cmp $b->{in}
144 unless ($::opt_c and $::opt_m) {
146 next unless ($::opt_i) ? $ls->{is_out} : $ls->{is_in};
147 list_files_by_patch($ls);
153 next unless ($::opt_i) ? $ls->{is_out} : $ls->{is_in};
154 print "\n $cat_title{$ls->{category}}\n" if $ls->{category} ne $c;
155 $c = $ls->{category};
157 list_files_by_patch($ls);
161 print "\n$out patched by:\n";
162 # find all the patches which patch $out and list them
163 my @p = grep { $_->{out}->{$out} } values %ls;
165 list_files_by_patch($ls, '');
180 my $out = trim_name(shift);
182 $ls->{out}->{$out} = 1;
184 # do the -i inverse as well, even if we're not doing -i
185 my $i = $ls{$out} ||= {
188 category => $::opt_c ? categorize_files([ $out ], $::opt_v) : '',
190 $i->{out}->{$in} = 1;
194 sub trim_name { # reduce/tidy file paths from diff lines
196 $name = "$name ($in)" if $name eq "/dev/null";
197 if (defined $::opt_p) {
198 # strip on -p levels of directory prefix
200 $name =~ s:^[^/]+/(.+)$:$1: while $dc-- > 0;
202 else { # try to strip off leading path to perl directory
203 # if absolute path, strip down to any *perl* directory first
204 $name =~ s:^/.*?perl.*?/::i;
205 $name =~ s:.*perl[-_]?5\.[-_a-z0-9.]+/::i;
212 sub list_files_by_patch {
214 $name = $ls->{in} unless defined $name;
217 foreach(qw(Title From Msg-ID)) {
218 next unless $ls->{$_};
219 my @list = sort keys %{$ls->{$_}};
220 push @meta, sprintf "%7s: ", $_;
221 @list = map { "\"$_\"" } @list if $_ eq 'Title';
222 push @meta, my_wrap(""," ", join(", ",@list)."\n");
224 $name = "\n$name" if @meta and $name;
226 # don't print the header unless the file contains something interesting
227 return if !@meta and !$ls->{out};
228 print("$ls->{in}\n"),return if $::opt_l; # -l = no listing
230 # a twisty maze of little options
231 my $cat = ($ls->{category} and !$::opt_m) ? "\t$ls->{category}" : "";
232 print "$name$cat: " unless ($::opt_h and !$::opt_v) or !"$name$cat";
233 print join('',"\n",@meta) if @meta;
235 my @v = sort PATORDER keys %{ $ls->{out} };
237 print $::opt_m ? " Files: ".my_wrap(""," ",$v) : $v;
242 return expand(wrap(@_));
247 sub categorize_files {
248 my($files, $verb) = @_;
251 foreach (@$files) { # assign a score to a file path
252 # the order of some of the tests is important
253 $c{TEST} += 5,next if m:^t/:;
254 $c{DOC} += 5,next if m:^pod/:;
255 $c{UTIL} += 10,next if m:^(utils|x2p|h2pl)/:;
257 if m:^(cygwin32|os2|plan9|qnx|vms|win32)/:
258 or m:^(hints|Porting|ext/DynaLoader)/:
262 $c{'CORE'} += 15,next
263 if m:^[^/]+[\._]([chH]|sym)$:;
265 if m:^[A-Z]+$: or m:^[^/]+\.SH$:
266 or m:^(install|configure):i;
267 print "Couldn't categorise $_\n" if $::opt_v;
270 if (keys %c > 1) { # sort to find category with highest score
273 my @c = sort { $c{$b} <=> $c{$a} || $a cmp $b } keys %c;
274 my @v = map { $c{$_} } @c;
275 if (@v > 1 and $refine <= 1 and "@v" =~ /^(\d) \1/
276 and $c[0] =~ m/^(DOC|TESTS|OTHER)/) { # rare
277 print "Tie, promoting $c[1] over $c[0]\n" if $::opt_d;
281 print " ".@$files." patches: ", join(", ", map { "$_: $c{$_}" } @c),".\n"
283 return $c[0] || 'OTHER';
287 $c ||= 'OTHER'; $v ||= 0;
288 print " ".@$files." patches: $c: $v\n" if $verb;
294 sub PATORDER { # PATORDER sort by Chip Salzenberg
297 $i = ($a =~ m#^[A-Z]+$#);
298 $j = ($b =~ m#^[A-Z]+$#);
299 return $j - $i if $i != $j;
301 $i = ($a =~ m#configure|hint#i) || ($a =~ m#[S_]H$#);
302 $j = ($b =~ m#configure|hint#i) || ($b =~ m#[S_]H$#);
303 return $j - $i if $i != $j;
305 $i = ($a =~ m#\.pod$#);
306 $j = ($b =~ m#\.pod$#);
307 return $j - $i if $i != $j;
309 $i = ($a =~ m#include/#);
310 $j = ($b =~ m#include/#);
311 return $j - $i if $i != $j;
313 if ((($i = $a) =~ s#/+[^/]*$##)
314 && (($j = $b) =~ s#/+[^/]*$##)) {
315 return $i cmp $j if $i ne $j;
318 $i = ($a =~ m#\.h$#);
319 $j = ($b =~ m#\.h$#);
320 return $j - $i if $i != $j;