From: Gurusamy Sarathy Date: Sat, 1 Aug 1998 19:22:13 +0000 (+0000) Subject: newer Porting/patchls from maint-5.004 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b73f56772c75866d31e08a5f5c123e238222b74d;p=p5sagit%2Fp5-mst-13.2.git newer Porting/patchls from maint-5.004 p4raw-id: //depot/maint-5.005/perl@1675 --- diff --git a/Porting/patchls b/Porting/patchls index 5b95832..38c4dd1 100644 --- a/Porting/patchls +++ b/Porting/patchls @@ -17,7 +17,7 @@ use Text::Tabs qw(expand unexpand); use strict; use vars qw($VERSION); -$VERSION = 2.05; +$VERSION = 2.08; sub usage { die qq{ @@ -30,6 +30,7 @@ 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) @@ -40,6 +41,7 @@ die qq{ -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 } @@ -49,6 +51,7 @@ $::opt_p = undef; # undef != 0 $::opt_d = 0; $::opt_v = 0; $::opt_m = 0; +$::opt_n = 0; $::opt_i = 0; $::opt_h = 0; $::opt_l = 0; @@ -63,35 +66,55 @@ $::opt_5 = 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)/; @@ -118,7 +141,9 @@ sub get_meta_info { 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 @@ -149,13 +174,17 @@ foreach my $argv (@ARGV) { 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 @@ -170,26 +199,30 @@ foreach my $argv (@ARGV) { } 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 (); + $is_chip = 1; } if (open CHIP,"<$dir/from") { chop($chip = ); $ls->{From} = { $chip => 1 }; + $is_chip = 1; } if (open CHIP,"<$dir/tag") { chop($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 @@ -207,13 +240,15 @@ print scalar(@ARGV)." files read.\n" if $::opt_v and @ARGV > 1; my @ls = values %ls; if ($::opt_f) { # filter out patches based on -f - 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; @@ -230,36 +265,51 @@ if ($::opt_4) { 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; @@ -270,6 +320,7 @@ if ($::opt_I) { 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); } } @@ -304,6 +355,7 @@ exit 0; sub add_file { my $ls = shift; + print "add_file '$_[0]'\n" if $::opt_d; my $out = trim_name(shift); $ls->{out}->{$out} = 1; @@ -351,7 +403,7 @@ sub list_files_by_patch { 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') { @@ -372,17 +424,27 @@ sub list_files_by_patch { $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"; } @@ -408,8 +470,10 @@ sub categorize_files { 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 @@ -435,7 +499,7 @@ sub categorize_files { } else { my($c, $v) = %c; - $c ||= 'OTHER'; $v ||= 0; + $c ||= 'UNKNOWN'; $v ||= 0; print " ".@$files." patches: $c: $v\n" if $verb; return $c; }