Remove a couple of p4-specific utilities
authorRafael Garcia-Suarez <rgarciasuarez@gmail.com>
Tue, 6 Jan 2009 08:49:02 +0000 (09:49 +0100)
committerRafael Garcia-Suarez <rgarciasuarez@gmail.com>
Tue, 6 Jan 2009 10:43:25 +0000 (11:43 +0100)
MANIFEST
Porting/apply [deleted file]
Porting/p4d2p [deleted file]
Porting/p4genpatch [deleted file]
Porting/patchls [deleted file]

index aa38aab..fe68438 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -3497,7 +3497,6 @@ pod/splitman                      Splits perlfunc into multiple man pages
 pod/splitpod                   Splits perlfunc into multiple pod pages
 Policy_sh.SH           Hold site-wide preferences between Configure runs.
 Porting/add-package.pl Add/Update CPAN modules that are part of Core
-Porting/apply          Apply patches sent by mail
 Porting/check83.pl     Check whether we are 8.3-friendly
 Porting/checkansi.pl   Check source code for ANSI-C violations
 Porting/checkARGS_ASSERT.pl    Check we use every PERL_ARGS_ASSERT* macro
@@ -3528,9 +3527,6 @@ Porting/Maintainers.pm    Library to pretty print info in Maintainers.pl
 Porting/makemeta       Create the top-level META.yml
 Porting/makerel                Release making utility
 Porting/manicheck      Check against MANIFEST
-Porting/p4d2p          Generate patch from p4 diff
-Porting/p4genpatch     Generate patch from p4 change in repository (obsoletes p4desc)
-Porting/patchls                Flexible patch file listing utility
 Porting/podtidy                Reformat pod using Pod::Tidy
 Porting/pumpkin.pod    Guidelines and hints for Perl maintainers
 Porting/README.y2038   Perl notes for the 2038 fix
diff --git a/Porting/apply b/Porting/apply
deleted file mode 100644 (file)
index cfa76e0..0000000
+++ /dev/null
@@ -1,72 +0,0 @@
-#!/usr/bin/perl -w
-my $file = pop(@ARGV);
-my %meta;
-$ENV{'P4PORT'} ||= 'bactrian:1667';
-$ENV{'P4CLIENT'} ||= 'ni-s';
-open(FILE,$file) || die "Cannot open $file:$!";
-while (<FILE>)
- {
-  if (/^(From|Subject|Date|Message-ID):(.*)$/i)
-   {
-    $meta{lc($1)} = $2;
-   }
- }
-my @results = `patch @ARGV <$file 2>&1`;
-warn @results;
-my $code = $?;
-warn "$code from patch\n";
-foreach (@results)
- {
-  if (/[Pp]atching\s+file\s*(\S+)/)
-   {
-    push(@edit,$1);
-   }
- }
-my @have = `p4 have @edit`;
-
-if ($code == 0)
- {
-  System("p4 edit @edit");
-  open(PIPE,"|p4 change -i") || die "Cannot open pipe to p4:$!";
-  print PIPE "Change: new\n";
-  print PIPE "Description:\n";
-  foreach my $key (qw(Subject From Date Message-Id))
-   {
-    if (exists $meta{lc($key)})
-     {
-      print PIPE "\t$key: ",$meta{lc($key)},"\n";
-      print "$key: ",$meta{lc($key)},"\n";
-     }
-   }
-  print PIPE "Files:\n";
-  foreach (@have)
-   {
-    if (m,^(.*)#,)
-     {
-      print PIPE "\t$1\n"
-     }
-   }
-  close(PIPE);
- }
-else
- {
-  if (@edit)
-   {
-    System("p4 refresh @edit");
-   }
- }
-
-sub System
-{
- my $cmd = join(' ',@_);
- warn "$cmd\n";
- if (fork)
-  {
-   wait;
-  }
- else
-  {
-   _exit(exec $cmd);
-  }
-}
-
diff --git a/Porting/p4d2p b/Porting/p4d2p
deleted file mode 100755 (executable)
index 8003bf7..0000000
+++ /dev/null
@@ -1,84 +0,0 @@
-#!/usr/bin/perl -wspi~
-
-#
-# reads a perforce style diff on stdin and outputs appropriate headers
-# so the diff can be applied with the patch program
-#
-# Gurusamy Sarathy <gsar@activestate.com>
-#
-
-BEGIN {
-    $0 =~ s|.*/||;
-    if ($h or $help) {
-       print STDERR <<USAGE;
-Usage: $0 [-v] [-h] files
-
-       -h      print this help
-       -v      output progress messages
-
-Does inplace edit of diff files output by the perforce commands
-"p4 describe", "p4 diff", and "p4 diff2". The result is suitable
-for feeding to the "patch" program.
-
-If no files are specified, reads from stdin and writes to stdout.
-
-WARNING: It only handles context or unified diffs.
-
-Example: p4 describe -du 123 | $0 > change-123.patch
-
-USAGE
-       exit(0);
-    }
-    unless (@ARGV) { @ARGV = '-'; undef $^I; }
-    use vars qw($thisfile $time $file $fnum $v $h $help);
-    $thisfile = "";
-    $time = localtime(time);
-}
-
-my ($cur, $match);
-$cur = m<^==== //depot/(.+?)\#\d+.* ====( \w+)?$> ... m<^(\@\@.+\@\@|\*+)$>;
-
-$match = $1;
-
-if ($ARGV ne $thisfile) {
-    warn "processing patchfile [$ARGV]\n" unless $ARGV eq '-';
-    $thisfile = $ARGV;
-}
-
-# while we are within range
-if ($cur) {
-    # set the file name after first line
-    if ($cur == 1) {
-       $file = $match;
-       $fnum++;
-    }
-    # emit the diff header when we hit last line
-    elsif ($cur =~ /E0$/) {
-       my $f = $file;
-
-       # special hack for perl so we can always use "patch -p1"
-       $f =~ s<^.*?(perl.*?/)><$1>;
-
-       # unified diff
-       if ($match =~ /^\@/) {
-           warn "emitting udiff header\n" if $v;
-           $_ = "Index: $f\n--- $f.~1~\t$time\n+++ $f\t$time\n$_";
-       }
-       # context diff
-       elsif ($match =~ /^\*/) {
-           warn "emitting cdiff header\n" if $v;
-           $_ = "Index: $f\n*** $f.~1~\t$time\n--- $f\t$time\n$_";
-       }
-    }
-    # see if we hit another patch (i.e. previous patch was empty)
-    elsif (m<^==== //depot/(.+?)\#\d+.* ====( \w+)?$>) {
-       $file = $match = $1;
-    }
-    # suppress all other lines in the header
-    else {
-       $_ = "";
-    }
-    warn "file [$file] line [$cur] file# [$fnum]\n" if $v;
-}
-
-$_ .= "End of Patch.\n" if eof;
diff --git a/Porting/p4genpatch b/Porting/p4genpatch
deleted file mode 100644 (file)
index 543baa9..0000000
+++ /dev/null
@@ -1,182 +0,0 @@
-#!/usr/bin/perl -w
-
-
-# p4genpatch - Generate a perl patch from the repository
-
-# Usage: $0 -h
-
-# andreas.koenig@anima.de
-
-use strict;
-use File::Temp qw(tempdir);
-use File::Compare;
-use File::Spec;
-use File::Spec::Unix;
-use Time::Local;
-use Getopt::Long;
-use Cwd qw(cwd);
-
-sub correctmtime ($$$);
-sub Usage ();
-
-$0 =~ s|^.*[\\/]||;
-my $VERSION = '0.05';
-my $TOPDIR = cwd();
-my @P4opt;
-our %OPT = ( "d" => "u", b => "//depot/perl/", "D" => "diff" );
-Getopt::Long::Configure("no_ignore_case");
-GetOptions(\%OPT, "b=s", "p=s", "d=s", "D=s", "h", "v", "V") or die Usage;
-print Usage and exit if $OPT{h};
-print "$VERSION\n" and exit if $OPT{V};
-die Usage unless @ARGV == 1 && $ARGV[0] =~ /^\d+$/;
-my $CHANGE = shift;
-
-for my $p4opt (qw(p)) {
-  push @P4opt, "-$p4opt $OPT{$p4opt}" if $OPT{$p4opt};
-}
-
-my $system = "p4 @P4opt describe -s $CHANGE |";
-open my $p4, $system or die "Could not run $system";
-my @action;
-while (<$p4>) {
-  print;
-  next unless m|($OPT{b})|;
-  my($prefix) = $1;
-  $prefix =~ s|/$||;
-  $prefix =~ s|/[^/]+$||; # up to the last "/" in the match is to be stripped
-  if (my($file,$action) = m|^\.\.\. (//depot.*)\s(\w+)$|) {
-    next if $action eq "delete";
-    push @action, [$action, $file, $prefix];
-  }
-}
-close $p4;
-
-my $tempdir;
-my @unlink;
-print "Differences ...\n";
-for my $a (@action) {
-  $tempdir ||= tempdir( "tmp-XXXX", CLEANUP => 1, TMPDIR => 1 );
-  @unlink = ();
-  my($action,$file,$prefix) = @$a;
-  my($path,$basename,$number) = $file =~ m|\Q$prefix\E/(.+/)?([^/]+)#(\d+)|;
-
-  my @splitdir = File::Spec::Unix->splitdir($path);
-  $path = File::Spec->catdir(@splitdir);
-
-  my($depotfile) = $file =~ m|^(.+)#\d+\z|;
-  die "Panic: Could not parse file[$file]" unless $number;
-  $path = "" unless defined $path;
-  my($d1,$d2,$prev,$prevchange,$prevfile,$doadd,$t1,$t2);
-  $prev = $number-1;
-  $prevchange = $CHANGE-1;
-  # can't assume previous rev == $number-1 due to obliterated revisions
-  $prevfile = "$depotfile\@$prevchange";
-  if ($number == 1 or $action =~ /^(add|branch)$/) {
-    $d1 = $^O eq 'MacOS' ? File::Spec->devnull : "/dev/null";
-    $t1 = $d1;
-    ++$doadd;
-  } elsif ($action =~ /^(edit|integrate)$/) {
-    $d1 = File::Spec->catfile($path, "$basename-$prevchange");
-    $t1 = File::Spec->catfile($tempdir, $d1);
-    warn "==> $d1 <==\n" if $OPT{v};
-    my $system = qq[p4 @P4opt print -o "$t1" "$prevfile"];
-    my $status = `$system`;
-    if ($?) {
-      warn "$0: system[$system] failed, status[$?]\n";
-      next;
-    }
-    chmod 0644, $t1;
-    if ($status =~ /\#(\d+) \s - \s \w+ \s change \s (\d+) \s /x) {
-      ($prev,$prevchange) = ($1,$2);
-      $prevfile = "$depotfile#$prev";
-      my $oldd1 = $d1;
-      $d1 =~ s/-\d+$/#$prev~$prevchange~/;
-      my $oldt1 = $t1;
-      $t1 = File::Spec->catfile($tempdir, $d1);
-      rename $oldt1, $t1;
-    }
-    push @unlink, $t1;
-  } else {
-    die "Unknown action[$action]";
-  }
-  $d2 = File::Spec->catfile($path, $basename);
-  $t2 = File::Spec->catfile($tempdir, $d2);
-  push @unlink, $t2;
-  warn "==> $d2#$number <==\n" if $OPT{v};
-  my $system = qq[p4 @P4opt print -o "$t2" "$file"];
-  # warn "system[$system]";
-  my $type = `$system`;
-  if ($?) {
-    warn "$0: `$system` failed, status[$?]\n";
-    next;
-  }
-  chmod 0644, $t2;
-  $type =~ m|^//.*\((.+)\)$| or next;
-  $type = $1;
-  if ($doadd or File::Compare::compare($t1, $t2)) {
-    print "\n==== $file ($type) ====\n";
-    unless ($type =~ /text/) {
-      next;
-    }
-    unless ($^O eq 'MacOS') {
-      $d1 =~ s,\\,/,g;
-      $d2 =~ s,\\,/,g;
-    }
-    print "Index: $d2\n";
-    correctmtime($prevfile,$prev,$t1) unless $doadd;
-    correctmtime($file,$number,$t2);
-    chdir $tempdir or warn "Could not chdir '$tempdir': $!";
-    $system = qq[$OPT{D} -$OPT{d} "$d1" "$d2"];
-    system($system); # no return check because diff doesn't always return 0
-    chdir $TOPDIR or warn "Could not chdir '$TOPDIR': $!";
-  }
-}
-continue {
-  for (@unlink) {
-    unlink or warn "Could not unlink $_: $!" if -f;
-  }
-}
-print "End of Patch.\n";
-
-my($tz_offset);
-sub correctmtime ($$$) {
-  my($depotfile,$nr,$localfile) = @_;
-  my %fstat = map { /^\.\.\. (\w+) (.*)$/ } `p4 @P4opt fstat -s "$depotfile"`;
-  return unless exists($fstat{headRev}) and $fstat{headRev} == $nr;
-
-  if ($^O eq 'MacOS') {  # fix epoch ... still off by three hours (EDT->PDT)
-    require Time::Local;
-    $tz_offset ||= sprintf "%+0.4d\n", (
-      Time::Local::timelocal(localtime) - Time::Local::timelocal(gmtime)
-    );
-    $fstat{headTime} += 2082844801 + $tz_offset;
-  }
-
-  utime $fstat{headTime}, $fstat{headTime}, $localfile;
-}
-
-sub Usage () {
-    qq{Usage: $0 [OPTIONS] patchnumber
-
-      -p host:port    p4 port (e.g. myhost:1666)
-      -d diffopt      option to pass to diff(1)
-      -D diff         diff(1) to use
-      -b branch(es)   which branches to include (regex); the last
-                      directory within the matched part will be
-                      preserved on the local copy, so that patch -p1
-                      will work (default: "//depot/perl/")
-      -v              verbose
-      -h              print this help and exit
-      -V              print version number and exit
-
-Fetches all required files from the repository, puts them into a
-temporary directory with sensible names and sensible modification
-times and composes a patch to STDOUT using external diff command.
-Requires repository access.
-
-Examples:
-          perl $0 12345 | gzip -c > 12345.gz
-          perl $0 -dc 12345 > change-12345.patch
-          perl $0 -b //depot/maint-5.6/perl -v 8571 > 8571
-};
-}
diff --git a/Porting/patchls b/Porting/patchls
deleted file mode 100644 (file)
index 1803ef7..0000000
+++ /dev/null
@@ -1,574 +0,0 @@
-#!/usr/bin/perl -w
-# 
-#      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.
-
-
-use Getopt::Std;
-use Text::Wrap qw(wrap $columns);
-use Text::Tabs qw(expand unexpand);
-use strict;
-use vars qw($VERSION);
-
-$VERSION = 2.11;
-
-sub usage {
-die qq{
-  patchls [options] patchfile [ ... ]
-
-    -h     no filename headers (like grep), only the listing.
-    -l     no listing (like grep), only the filename headers.
-    -i     Invert: for each patched file list which patch files patch it.
-    -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).
-    -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)
-           Will print warnings for files which don't. Also affects -4 option.
-    -      Read patch from STDIN
-  other options for special uses:
-    -I     just gather and display summary Information about the patches.
-    -4     write to stdout the PerForce commands to prepare for patching.
-    -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_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;
-$::opt_c = 0;
-$::opt_f = '';
-$::opt_e = 0;
-
-# special purpose options
-$::opt_I = 0;
-$::opt_4 = 0;  # output PerForce commands to prepare for patching
-$::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("dmnihlvecC45Xp:f:IM:W:") or usage;
-
-$columns = $::opt_W || 9999999;
-
-$::opt_m = 1 if $::opt_M;
-$::opt_4 = 1 if $::opt_5;
-$::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',
-    'PORT1'    => 'PORTABILITY - WIN32',
-    'PORT2'    => 'PORTABILITY - GENERAL',
-    'TEST'     => 'TESTS',
-    'UTIL'     => 'UTILITIES',
-    'OTHER'    => 'OTHER CHANGES',
-    'EXT'      => 'EXTENSIONS',
-    'UNKNOWN'  => 'UNKNOWN - NO FILES PATCHED',
-);
-
-
-sub get_meta_info {
-    my $ls = shift;
-    local($_) = shift;
-    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)/;
-}
-
-
-# Style 1:
-#      *** perl-5.004/embed.h  Sat May 10 03:39:32 1997
-#      --- perl-5.004.fixed/embed.h    Thu May 29 19:48:46 1997
-#      ***************
-#      *** 308,313 ****
-#      --- 308,314 ----
-#
-# Style 2:
-#      --- perl5.004001/mg.c   Sun Jun 08 12:26:24 1997
-#      +++ perl5.004-bc/mg.c   Sun Jun 08 11:56:08 1997
-#      @@ .. @@
-# or for deletions
-#      --- perl5.004001/mg.c   Sun Jun 08 12:26:24 1997
-#      +++ /dev/null   Sun Jun 08 11:56:08 1997
-#      @@ ... @@
-# or (rcs, note the different date format)
-#      --- 1.18        1997/05/23 19:22:04
-#      +++ ./pod/perlembed.pod 1997/06/03 21:41:38
-#
-# Variation:
-#      Index: embed.h
-
-my %ls;
-
-my $in;
-my $ls;
-my $prevline = '';
-my $prevtype = '';
-my (%removed, %added);
-my $prologue = 1;      # assume prologue till patch or /^exit\b/ seen
-
-
-foreach my $argv (@ARGV) {
-    $in = $argv;
-    if (-d $in) {
-       warn "Ignored directory $in\n";
-       next;
-    }
-    if ($in eq "-") {
-      *F = \*STDIN;
-    } elsif (not open F, "<$in") {
-       warn "Unable to open $in: $!\n";
-       next;
-    }
-    print "Reading $in...\n" if $::opt_v and @ARGV > 1;
-    $ls = $ls{$in} ||= { is_in => 1, in => $in };
-    my $type;
-    while (<F>) {
-       unless (/^([-+*]{3}) / || /^(Index):/) {
-           # not an interesting patch line
-           # but possibly meta-information or prologue
-           if ($prologue) {
-               $added{$1}   = 1    if /^touch\s+(\S+)/;
-               $removed{$1} = 1    if /^rm\s+(?:-f)?\s*(\S+)/;
-               $prologue = 0       if /^exit\b/;
-           }
-           get_meta_info($ls, $_) if $::opt_m;
-           next;
-       }
-       $type = $1;
-       next if /^--- [0-9,]+ ----$/ || /^\*\*\* [0-9,]+ \*\*\*\*$/;
-       $prologue = 0;
-
-       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 being fixed.
-       if (/^Index:\s+(.*)/) {
-           my $f;
-           foreach $f (split(/ /, $1)) { add_patched_file($ls, $f) }
-           next;
-       }
-
-       if (    ($type eq '---' and $prevtype eq '***') # Style 1
-           or  ($type eq '+++' and $prevtype eq '---') # Style 2
-       ) {
-           if (/^[-+*]{3} (\S+)\s*(.*?\d\d:\d\d:\d\d)?/) {     # double check
-               if ($1 eq "/dev/null") {
-                   $prevline =~ /^[-+*]{3} (\S+)\s*/;
-                   add_deleted_file($ls, $1);
-               }
-               else {
-                   add_patched_file($ls, $1);
-               }
-           }
-           else {
-               warn "$in $.: parse error (prev $prevtype, type $type)\n$prevline$_";
-           }
-       }
-    }
-    continue {
-       $prevline = $_;
-       $prevtype = $type || '';
-       $type = '';
-    }
-
-    # special mode for patch sets from Chip
-    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 } if $is_chip && !$ls->{From};
-    }
-
-    # if we don't have a title for -m then use the file name
-    $ls->{Title}{"Untitled: $in"}=1 if $::opt_m
-       and !$ls->{Title} and $ls->{out};
-
-    $ls->{category} = $::opt_c
-       ? categorize_files([keys %{ $ls->{out} }], $::opt_v) : '';
-}
-print scalar(@ARGV)." files read.\n" if $::opt_v and @ARGV > 1;
-
-
-# --- Firstly we filter and sort as needed ---
-
-my @ls  = values %ls;
-
-if ($::opt_f) {                # filter out patches based on -f <regexp>
-    $::opt_f .= '$' unless $::opt_f =~ m:/:;
-    @ls = grep {
-       my $match = 0;
-       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;
-}
-
-@ls  = sort {
-    $a->{category} cmp $b->{category} || $a->{in} cmp $b->{in}
-} @ls;
-
-
-# --- Handle special modes ---
-
-if ($::opt_4) {
-    my $tail = ($::opt_5) ? "|| exit 1" : "";
-    print map { "p4 delete $_$tail\n" } sort keys %removed if %removed;
-    print map { "p4 add    $_$tail\n" } sort keys %added   if %added;
-    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{keys %added};
-    my @patched = sort keys %patched;
-    foreach(@patched) {
-       next if $removed{$_};
-       my $edit = ($::opt_e && !-f $_) ? "add " : "edit";
-       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 || @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", $out    unless $::opt_h;
-           print $all_out{$out}        unless $::opt_l;
-           print "\n";
-       }
-    }
-    print "Added files:   ".join(" ",sort keys %added  )."\n" if %added;
-    print "Removed files: ".join(" ",sort keys %removed)."\n" if %removed;
-    exit 0+@missing;
-}
-
-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);
-    }
-}
-else {
-    my $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};
-       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_patched_file {
-    my $ls = shift;
-       my $raw_name = shift;
-    my $action = shift || 1;   # 1==patched, 2==deleted
-
-    my $out = trim_name($raw_name);
-    print "add_patched_file '$out' ($raw_name, $action)\n" if $::opt_d;
-
-    $ls->{out}->{$out} = $action;
-
-    warn "$out patched but not present\n" if $::opt_e && !-f $out;
-
-    # 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;
-}
-
-sub add_deleted_file {
-    my $ls = shift;
-       my $raw_name = shift;
-    my $out = trim_name($raw_name);
-    print "add_deleted_file '$out' ($raw_name)\n" if $::opt_d;
-       $removed{$out} = 1;
-    #add_patched_file(@_[0,1], 2);
-}
-
-
-sub trim_name {                # reduce/tidy file paths from diff lines
-    my $name = shift;
-    $name =~ s:\\:/:g; # adjust windows paths
-    $name =~ s://:/:g; # simplify (and make win \\share into absolute path)
-    if ($name eq "/dev/null") {
-       # do nothing (XXX but we need a way to record deletions)
-    }
-    elsif (defined $::opt_p) {
-       # strip on -p levels of directory prefix
-       my $dc = $::opt_p;
-       $name =~ s:^[^/]+/(.+)$:$1: while $dc-- > 0;
-    }
-    else {     # try to strip off leading path to perl directory
-       # if absolute path, strip down to any *perl* directory first
-       $name =~ s:^/.*?perl.*?/::i;
-       $name =~ s:.*(perl|maint)[-_]?5?[._]?[-_a-z0-9.+]*/::i;
-       $name =~ s:^\./::;
-    }
-    return $name;
-}
-
-
-sub list_files_by_patch {
-    my($ls, $name) = @_;
-    $name = $ls->{in} unless defined $name;
-    my @meta;
-    if ($::opt_m) {
-       my $meta;
-       foreach $meta (@show_meta) {
-           next unless $ls->{$meta};
-           my @list = sort keys %{$ls->{$meta}};
-           push @meta, sprintf "%7s:  ", $meta;
-           if ($meta eq 'Title') {
-               @list = map { "\"$_\""; } @list;
-               push @list, "#$1" if $::opt_C && $ls->{in} =~ m:\b(\w\d+)/patch$:;
-           }
-           elsif ($meta eq 'From') {
-               # fix-up bizzare addresses from japan and ibm :-)
-               foreach(@list) {
-                   s:\W+=?iso.*?<: <:;
-                   s/\d\d-\w\w\w-\d{4}\s+\d\d:\S+\s*//;
-               }
-           }
-           elsif ($meta eq 'Msg-ID') {
-               my %from; # limit long threads to one msg-id per site
-               @list = map {
-                   $from{(/@(.*?)>/ ? $1 : $_)}++ ? () : ($_);
-               } @list;
-           }
-           push @meta, my_wrap("","          ", join(", ",@list)."\n");
-       }
-       $name = "\n$name" if @meta and $name;
-    }
-    # don't print the header unless the file contains something interesting
-    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";
-    my $sep = "\n";
-    $sep = "" if @show_meta==1 && $::opt_c && $::opt_h;
-    print join('', $sep, @meta) if @meta;
-
-    return if $::opt_m && !$show_meta{Files};
-    my @v = sort PATORDER keys %{ $ls->{out} };
-    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";
-}
-
-
-sub my_wrap {
-       my $txt = eval { expand(wrap(@_)) };    # die's on long lines!
-    return $txt unless $@;
-       return expand("@_");
-}
-
-
-
-sub categorize_files {
-    my($files, $verb) = @_;
-    my(%c, $refine);
-
-    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{PORT1}+= 15,next  if m:^win32:;
-       $c{PORT2} += 15,next
-           if m:^(cygwin|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)/:;
-       $c{'CORE'} += 15,next
-           if m:^[^/]+[\._]([chH]|sym|pl)$:;
-       $c{BUILD} += 10,next
-           if m:^[A-Z]+$: or m:^[^/]+\.SH$:
-           or m:^(install|configure|configpm):i;
-       print "Couldn't categorise $_\n" if $::opt_v;
-       $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';
-    }
-    else {
-       my($c, $v) = %c;
-       $c ||= 'UNKNOWN'; $v ||= 0;
-       print "  ".@$files." patches: $c: $v\n" if $verb;
-       return $c;
-    }
-}
-
-
-sub PATORDER {         # PATORDER sort by Chip Salzenberg
-    my ($i, $j);
-
-    $i = ($a =~ m#^[A-Z]+$#);
-    $j = ($b =~ m#^[A-Z]+$#);
-    return $j - $i if $i != $j;
-
-    $i = ($a =~ m#configure|hint#i) || ($a =~ m#[S_]H$#);
-    $j = ($b =~ m#configure|hint#i) || ($b =~ m#[S_]H$#);
-    return $j - $i if $i != $j;
-
-    $i = ($a =~ m#\.pod$#);
-    $j = ($b =~ m#\.pod$#);
-    return $j - $i if $i != $j;
-
-    $i = ($a =~ m#include/#);
-    $j = ($b =~ m#include/#);
-    return $j - $i if $i != $j;
-
-    if ((($i = $a) =~ s#/+[^/]*$##)
-       && (($j = $b) =~ s#/+[^/]*$##)) {
-           return $i cmp $j if $i ne $j;
-    }
-
-    $i = ($a =~ m#\.h$#);
-    $j = ($b =~ m#\.h$#);
-    return $j - $i if $i != $j;
-
-    return $a cmp $b;
-}
-