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);
22 patchls [options] patchfile [ ... ]
24 -i Invert: for each patched file list which patch files patch it.
25 -h no filename headers (like grep), only the listing.
26 -l no listing (like grep), only the filename headers.
27 -c Categorise the patch and sort by category (perl specific).
28 -m print formatted Meta-information (Subject,From,Msg-ID etc).
29 -p N strip N levels of directory Prefix (like patch), else automatic.
30 -v more verbose (-d for noisy debugging).
31 -f F only list patches which patch files matching regexp F
32 (F has $ appended unless it contains a /).
33 -I just gather and display summary Information about the patches.
39 $::opt_p = undef; # undef != 0
52 getopts("mihlvcp:f:I") or usage;
55 'BUILD' => 'BUILD PROCESS',
56 'CORE' => 'CORE LANGUAGE',
57 'DOC' => 'DOCUMENTATION',
58 'LIB' => 'LIBRARY AND EXTENSIONS',
59 'PORT1' => 'PORTABILITY - WIN32',
60 'PORT2' => 'PORTABILITY - OTHER',
62 'UTIL' => 'UTILITIES',
63 'OTHER' => 'OTHER CHANGES',
69 # *** perl-5.004/embed.h Sat May 10 03:39:32 1997
70 # --- perl-5.004.fixed/embed.h Thu May 29 19:48:46 1997
76 # --- perl5.004001/mg.c Sun Jun 08 12:26:24 1997
77 # +++ perl5.004-bc/mg.c Sun Jun 08 11:56:08 1997
78 # @@ -656,9 +656,27 @@
79 # or (rcs, note the different date format)
80 # --- 1.18 1997/05/23 19:22:04
81 # +++ ./pod/perlembed.pod 1997/06/03 21:41:38
86 my($in, $prevline, $prevtype, $ls);
88 foreach my $argv (@ARGV) {
90 unless (open F, "<$in") {
91 warn "Unable to open $in: $!\n";
94 print "Reading $in...\n" if $::opt_v and @ARGV > 1;
95 $ls = $ls{$in} ||= { is_in => 1, in => $in };
98 unless (/^([-+*]{3}) / || /^(Index):/) {
99 # not an interesting patch line but possibly meta-information
100 next unless $::opt_m;
101 $ls->{From}{$1}=1 if /^From:\s+(.*\S)/i;
102 $ls->{Title}{$1}=1 if /^Subject:\s+(?:Re: )?(.*\S)/i;
103 $ls->{'Msg-ID'}{$1}=1 if /^Message-Id:\s+(.*\S)/i;
104 $ls->{Date}{$1}=1 if /^Date:\s+(.*\S)/i;
108 next if /^--- [0-9,]+ ----$/ || /^\*\*\* [0-9,]+ \*\*\*\*$/;
110 print "Last: $prevline","This: ${_}Got: $1\n\n" if $::opt_d;
112 # Some patches have Index lines but not diff headers
113 # Patch copes with this, so must we. It's also handy for
114 # documenting manual changes by simply adding Index: lines
115 # to the file which describes the problem bing fixed.
116 add_file($ls, $1), next if /^Index:\s+(.*)/;
118 if ( ($type eq '---' and $prevtype eq '***') # Style 1
119 or ($type eq '+++' and $prevtype eq '---') # Style 2
121 if (/^[-+*]{3} (\S+)\s+.*\d\d:\d\d:\d\d/) { # double check
125 warn "$in $.: parse error (prev $prevtype, type $type)\n$prevline$_";
134 # if we don't have a title for -m then use the file name
135 $ls->{Title}{$in}=1 if $::opt_m
136 and !$ls->{Title} and $ls->{out};
138 $ls->{category} = $::opt_c
139 ? categorize_files([keys %{ $ls->{out} }], $::opt_v) : '';
141 print scalar(@ARGV)." files read.\n" if $::opt_v and @ARGV > 1;
145 $a->{category} cmp $b->{category} || $a->{in} cmp $b->{in}
148 if ($::opt_f) { # filter out patches based on -f <regexp>
150 $::opt_f .= '$' unless $::opt_f =~ m:/:;
152 my @out = keys %{$_->{out}};
155 ++$match if $out =~ m/$::opt_f/o;
166 next unless $in->{is_in};
168 my @outs = keys %{$in->{out}};
169 @all_out{@outs} = ($in->{in}) x @outs;
171 my @all_out = sort keys %all_out;
172 my @missing = grep { ! -f $_ } @all_out;
173 print "$n_patches patch files patch ".@all_out." files (".@missing." missing)\n";
174 if ($::opt_v and @missing) {
175 print "Missing files:\n";
176 foreach $out (@missing) {
177 printf " %-20s\t%s\n", $out, $all_out{$out};
183 unless ($::opt_c and $::opt_m) {
185 next unless ($::opt_i) ? $ls->{is_out} : $ls->{is_in};
186 list_files_by_patch($ls);
192 next unless ($::opt_i) ? $ls->{is_out} : $ls->{is_in};
193 print "\n ------ $cat_title{$ls->{category}} ------\n"
194 if $ls->{category} ne $c;
195 $c = $ls->{category};
197 list_files_by_patch($ls);
201 print "\n$out patched by:\n";
202 # find all the patches which patch $out and list them
203 my @p = grep { $_->{out}->{$out} } values %ls;
205 list_files_by_patch($ls, '');
220 my $out = trim_name(shift);
222 $ls->{out}->{$out} = 1;
224 # do the -i inverse as well, even if we're not doing -i
225 my $i = $ls{$out} ||= {
228 category => $::opt_c ? categorize_files([ $out ], $::opt_v) : '',
230 $i->{out}->{$in} = 1;
234 sub trim_name { # reduce/tidy file paths from diff lines
236 $name = "$name ($in)" if $name eq "/dev/null";
237 $name =~ s:\\:/:g; # adjust windows paths
238 $name =~ s://:/:g; # simplify (and make win \\share into absolute path)
239 if (defined $::opt_p) {
240 # strip on -p levels of directory prefix
242 $name =~ s:^[^/]+/(.+)$:$1: while $dc-- > 0;
244 else { # try to strip off leading path to perl directory
245 # if absolute path, strip down to any *perl* directory first
246 $name =~ s:^/.*?perl.*?/::i;
247 $name =~ s:.*perl[-_]?5?[._]?[-_a-z0-9.+]*/::i;
254 sub list_files_by_patch {
256 $name = $ls->{in} unless defined $name;
259 foreach(qw(Title From Msg-ID)) {
260 next unless $ls->{$_};
261 my @list = sort keys %{$ls->{$_}};
262 push @meta, sprintf "%7s: ", $_;
263 @list = map { "\"$_\"" } @list if $_ eq 'Title';
264 push @meta, my_wrap(""," ", join(", ",@list)."\n");
266 $name = "\n$name" if @meta and $name;
268 # don't print the header unless the file contains something interesting
269 return if !@meta and !$ls->{out};
270 print("$ls->{in}\n"),return if $::opt_l; # -l = no listing
272 # a twisty maze of little options
273 my $cat = ($ls->{category} and !$::opt_m) ? "\t$ls->{category}" : "";
274 print "$name$cat: " unless ($::opt_h and !$::opt_v) or !"$name$cat";
275 print join('',"\n",@meta) if @meta;
277 my @v = sort PATORDER keys %{ $ls->{out} };
279 print $::opt_m ? " Files: ".my_wrap(""," ",$v) : $v;
284 my $txt = eval { expand(wrap(@_)) }; # die's on long lines!
285 return $txt unless $@;
291 sub categorize_files {
292 my($files, $verb) = @_;
295 foreach (@$files) { # assign a score to a file path
296 # the order of some of the tests is important
297 $c{TEST} += 5,next if m:^t/:;
298 $c{DOC} += 5,next if m:^pod/:;
299 $c{UTIL} += 10,next if m:^(utils|x2p|h2pl)/:;
300 $c{PORT1}+= 15,next if m:^win32:;
302 if m:^(cygwin32|os2|plan9|qnx|vms)/:
303 or m:^(hints|Porting|ext/DynaLoader)/:
307 $c{'CORE'} += 15,next
308 if m:^[^/]+[\._]([chH]|sym|pl)$:;
310 if m:^[A-Z]+$: or m:^[^/]+\.SH$:
311 or m:^(install|configure|configpm):i;
312 print "Couldn't categorise $_\n" if $::opt_v;
315 if (keys %c > 1) { # sort to find category with highest score
318 my @c = sort { $c{$b} <=> $c{$a} || $a cmp $b } keys %c;
319 my @v = map { $c{$_} } @c;
320 if (@v > 1 and $refine <= 1 and "@v" =~ /^(\d) \1/
321 and $c[0] =~ m/^(DOC|TESTS|OTHER)/) { # rare
322 print "Tie, promoting $c[1] over $c[0]\n" if $::opt_d;
326 print " ".@$files." patches: ", join(", ", map { "$_: $c{$_}" } @c),".\n"
328 return $c[0] || 'OTHER';
332 $c ||= 'OTHER'; $v ||= 0;
333 print " ".@$files." patches: $c: $v\n" if $verb;
339 sub PATORDER { # PATORDER sort by Chip Salzenberg
342 $i = ($a =~ m#^[A-Z]+$#);
343 $j = ($b =~ m#^[A-Z]+$#);
344 return $j - $i if $i != $j;
346 $i = ($a =~ m#configure|hint#i) || ($a =~ m#[S_]H$#);
347 $j = ($b =~ m#configure|hint#i) || ($b =~ m#[S_]H$#);
348 return $j - $i if $i != $j;
350 $i = ($a =~ m#\.pod$#);
351 $j = ($b =~ m#\.pod$#);
352 return $j - $i if $i != $j;
354 $i = ($a =~ m#include/#);
355 $j = ($b =~ m#include/#);
356 return $j - $i if $i != $j;
358 if ((($i = $a) =~ s#/+[^/]*$##)
359 && (($j = $b) =~ s#/+[^/]*$##)) {
360 return $i cmp $j if $i ne $j;
363 $i = ($a =~ m#\.h$#);
364 $j = ($b =~ m#\.h$#);
365 return $j - $i if $i != $j;