use strict;
use vars qw($VERSION);
-$VERSION = 2.05;
+$VERSION = 2.08;
sub usage {
die qq{
-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).
+ -n give a count of the number of patches applied to a file if >1.
-f F only list patches which patch files matching regexp F
(F has \$ appended unless it contains a /).
-e Expect patched files to Exist (relative to current directory)
-5 like -4 but add "|| exit 1" after each command
-M T Like -m but only output listed meta tags (eg -M 'Title From')
-W N set wrap width to N (defaults to 70, use 0 for no wrap)
+ -X list patchfiles that may clash (i.e. patch the same file)
patchls version $VERSION by Tim Bunce
}
$::opt_d = 0;
$::opt_v = 0;
$::opt_m = 0;
+$::opt_n = 0;
$::opt_i = 0;
$::opt_h = 0;
$::opt_l = 0;
$::opt_M = ''; # like -m but only output these meta items (-M Title)
$::opt_W = 70; # set wrap width columns (see Text::Wrap module)
$::opt_C = 0; # 'Chip' mode (handle from/tags/article/bug files) undocumented
+$::opt_X = 0; # list patchfiles that patch the same file
usage unless @ARGV;
-getopts("mihlvecC45p:f:IM:W:") or usage;
+getopts("dmnihlvecC45Xp:f:IM:W:") or usage;
$columns = $::opt_W || 9999999;
$::opt_m = 1 if $::opt_M;
$::opt_4 = 1 if $::opt_5;
-my @show_meta = split(' ', $::opt_M || 'Title From Msg-ID'); # see get_meta_info()
+$::opt_i = 1 if $::opt_X;
+
+# see get_meta_info()
+my @show_meta = split(' ', $::opt_M || 'Title From Msg-ID Files');
+my %show_meta = map { ($_,1) } @show_meta;
my %cat_title = (
'BUILD' => 'BUILD PROCESS',
'CORE' => 'CORE LANGUAGE',
'DOC' => 'DOCUMENTATION',
- 'LIB' => 'LIBRARY AND EXTENSIONS',
+ 'LIB' => 'LIBRARY',
'PORT1' => 'PORTABILITY - WIN32',
'PORT2' => 'PORTABILITY - GENERAL',
'TEST' => 'TESTS',
'UTIL' => 'UTILITIES',
'OTHER' => 'OTHER CHANGES',
+ 'EXT' => 'EXTENSIONS',
+ 'UNKNOWN' => 'UNKNOWN - NO FILES PATCH',
);
sub get_meta_info {
my $ls = shift;
local($_) = shift;
- $ls->{From}{$1}=1 if /^From:\s+(.*\S)/i;
- $ls->{Title}{$1}=1 if /^Subject:\s+(?:Re: )?(.*\S)/i;
+ if (/^From:\s+(.*\S)/i) {;
+ my $from = $1; # temporary measure for Chip Salzenberg
+ $from =~ s/chip\@(atlantic\.net|perlsupport\.com)/chip\@pobox.com/;
+ $from =~ s/\(Tim Bunce\) \(Tim Bunce\)/(Tim Bunce)/;
+ $ls->{From}{$from} = 1
+ }
+ if (/^Subject:\s+(?:Re: )?(.*\S)/i) {
+ my $title = $1;
+ $title =~ s/\[(PATCH|PERL)[\w\. ]*\]:?//g;
+ $title =~ s/\b(PATCH|PERL)[\w\.]*://g;
+ $title =~ s/\bRe:\s+/ /g;
+ $title =~ s/\s+/ /g;
+ $title =~ s/^\s*(.*?)\s*$/$1/g;
+ $ls->{Title}{$title} = 1;
+ }
$ls->{'Msg-ID'}{$1}=1 if /^Message-Id:\s+(.*\S)/i;
$ls->{Date}{$1}=1 if /^Date:\s+(.*\S)/i;
$ls->{$1}{$2}=1 if $::opt_M && /^([-\w]+):\s+(.*\S)/;
my %ls;
-my ($in, $prevline, $ls);
+my $in;
+my $ls;
+my $prevline = '';
my $prevtype = '';
my (@removed, @added);
my $prologue = 1; # assume prologue till patch or /^exit\b/ seen
next if /^--- [0-9,]+ ----$/ || /^\*\*\* [0-9,]+ \*\*\*\*$/;
$prologue = 0;
- print "Last: $prevline","This: ${_}Got: $1\n\n" if $::opt_d;
+ print "Last: $prevline","This: ${_}Got: $type\n\n" if $::opt_d;
# Some patches have Index lines but not diff headers
# 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+(\S+)/;
+ # to the file which describes the problem being fixed.
+ if (/^Index:\s+(.*)/) {
+ my $f;
+ foreach $f (split(/ /, $1)) { add_file($ls, $f) }
+ next;
+ }
if ( ($type eq '---' and $prevtype eq '***') # Style 1
or ($type eq '+++' and $prevtype eq '---') # Style 2
}
continue {
$prevline = $_;
- $prevtype = $type;
+ $prevtype = $type || '';
$type = '';
}
# special mode for patch sets from Chip
- if ($::opt_C && $in =~ m:[\\/]patch$:) {
+ if ($in =~ m:[\\/]patch$:) {
+ my $is_chip;
my $chip;
my $dir; ($dir = $in) =~ s:[\\/]patch$::;
if (!$ls->{From} && (open(CHIP,"$dir/article") || open(CHIP,"$dir/bug"))) {
get_meta_info($ls, $_) while (<CHIP>);
+ $is_chip = 1;
}
if (open CHIP,"<$dir/from") {
chop($chip = <CHIP>);
$ls->{From} = { $chip => 1 };
+ $is_chip = 1;
}
if (open CHIP,"<$dir/tag") {
chop($chip = <CHIP>);
$ls->{Title} = { $chip => 1 };
+ $is_chip = 1;
}
- $ls->{From} = { "Chip Salzenberg" => 1 } unless $ls->{From};
+ $ls->{From} = { "Chip Salzenberg" => 1 } if $is_chip && !$ls->{From};
}
# if we don't have a title for -m then use the file name
my @ls = values %ls;
if ($::opt_f) { # filter out patches based on -f <regexp>
- my $out;
$::opt_f .= '$' unless $::opt_f =~ m:/:;
@ls = grep {
- my @out = keys %{$_->{out}};
my $match = 0;
- for $out (@out) {
- ++$match if $out =~ m/$::opt_f/o;
+ if ($_->{is_in}) {
+ my @out = keys %{ $_->{out} };
+ $match=1 if grep { m/$::opt_f/o } @out;
+ }
+ else {
+ $match=1 if $_->{in} =~ m/$::opt_f/o;
}
$match;
} @ls;
my $tail = ($::opt_5) ? "|| exit 1" : "";
print map { "p4 delete $_$tail\n" } @removed if @removed;
print map { "p4 add $_$tail\n" } @added if @added;
- my @patches = grep { $_->{is_in} } @ls;
+ my @patches = sort grep { $_->{is_in} } @ls;
+ my @no_outs = grep { keys %{$_->{out}} == 0 } @patches;
+ warn "Warning: Some files contain no patches:",
+ join("\n\t", '', map { $_->{in} } @no_outs), "\n" if @no_outs;
my %patched = map { ($_, 1) } map { keys %{$_->{out}} } @patches;
delete @patched{@added};
my @patched = sort keys %patched;
- print map {
+ foreach(@patched) {
my $edit = ($::opt_e && !-f $_) ? "add " : "edit";
- "p4 $edit $_$tail\n"
- } @patched if @patched;
+ print "p4 $edit $_$tail\n";
+ }
exit 0 unless $::opt_C;
}
+
if ($::opt_I) {
my $n_patches = 0;
my($in,$out);
my %all_out;
+ my @no_outs;
foreach $in (@ls) {
next unless $in->{is_in};
++$n_patches;
my @outs = keys %{$in->{out}};
+ push @no_outs, $in unless @outs;
@all_out{@outs} = ($in->{in}) x @outs;
}
my @all_out = sort keys %all_out;
my @missing = grep { ! -f $_ } @all_out;
print "$n_patches patch files patch ".@all_out." files (".@missing." missing)\n";
+ print @no_outs." patch files don't contain patches.\n" if @no_outs;
print "(use -v to list patches which patch 'missing' files)\n"
- if @missing && !$::opt_v;
+ if (@missing || @no_outs) && !$::opt_v;
+ if ($::opt_v and @no_outs) {
+ print "Patch files which don't contain patches:\n";
+ foreach $out (@no_outs) {
+ printf " %-20s\n", $out->{in};
+ }
+ }
if ($::opt_v and @missing) {
print "Missing files:\n";
foreach $out (@missing) {
- printf " %-20s\t%s\n", $out, $all_out{$out};
+ printf " %-20s\t", $out unless $::opt_h;
+ print $all_out{$out} unless $::opt_l;
+ print "\n";
}
}
print "Added files: @added\n" if @added;
unless ($::opt_c and $::opt_m) {
foreach $ls (@ls) {
next unless ($::opt_i) ? $ls->{is_out} : $ls->{is_in};
+ next if $::opt_X and keys %{$ls->{out}} <= 1;
list_files_by_patch($ls);
}
}
sub add_file {
my $ls = shift;
+ print "add_file '$_[0]'\n" if $::opt_d;
my $out = trim_name(shift);
$ls->{out}->{$out} = 1;
my @list = sort keys %{$ls->{$meta}};
push @meta, sprintf "%7s: ", $meta;
if ($meta eq 'Title') {
- @list = map { s/\[?(PATCH|PERL)\]?:?\s*//g; "\"$_\""; } @list;
+ @list = map { "\"$_\""; } @list;
push @list, "#$1" if $::opt_C && $ls->{in} =~ m:\b(\w\d+)/patch$:;
}
elsif ($meta eq 'From') {
$name = "\n$name" if @meta and $name;
}
# don't print the header unless the file contains something interesting
- return if !@meta and !$ls->{out};
- print("$ls->{in}\n"),return if $::opt_l; # -l = no listing, just names
+ return if !@meta and !$ls->{out} and !$::opt_v;
+ if ($::opt_l) { # -l = no listing, just names
+ print "$ls->{in}";
+ my $n = keys %{ $ls->{out} };
+ print " ($n patches)" if $::opt_n and $n>1;
+ print "\n";
+ return;
+ }
# 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;
+ return if $::opt_m && !$show_meta{Files};
my @v = sort PATORDER keys %{ $ls->{out} };
- my $v = "@v\n";
+ my $n = @v;
+ my $v = "@v";
print $::opt_m ? " Files: ".my_wrap(""," ",$v) : $v;
+ print " ($n patches)" if $::opt_n and $n>1;
+ print "\n";
}
if m:^(cygwin32|os2|plan9|qnx|vms)/:
or m:^(hints|Porting|ext/DynaLoader)/:
or m:^README\.:;
+ $c{EXT} += 10,next
+ if m:^(ext|lib/ExtUtils)/:;
$c{LIB} += 10,next
- if m:^(lib|ext)/:;
+ if m:^(lib)/:;
$c{'CORE'} += 15,next
if m:^[^/]+[\._]([chH]|sym|pl)$:;
$c{BUILD} += 10,next
}
else {
my($c, $v) = %c;
- $c ||= 'OTHER'; $v ||= 0;
+ $c ||= 'UNKNOWN'; $v ||= 0;
print " ".@$files." patches: $c: $v\n" if $verb;
return $c;
}
projects / p5sagit/p5-mst-13.2.git / commitdiff