Porting/p4genpatch

   1 #!/usr/bin/perl -w
   2
   3
   4 # p4genpatch - Generate a perl patch from the repository
   5
   6 # Usage: $0 -h
   7
   8 # andreas.koenig@anima.de
   9
  10 use strict;
  11 use File::Temp qw(tempdir);
  12 use File::Compare;
  13 use Time::Local;
  14 use Getopt::Long;
  15 use Cwd qw(cwd);
  16
  17 sub correctmtime ($$$);
  18 sub Usage ();
  19
  20 $0 =~ s|^.*[\\/]||;
  21 my $VERSION = '0.05';
  22 my $TOPDIR = cwd();
  23 my @P4opt;
  24 our %OPT = ( "d" => "u", b => "//depot/perl", "D" => "diff" );
  25 Getopt::Long::Configure("no_ignore_case");
  26 GetOptions(\%OPT, "b=s", "p=s", "d=s", "D=s", "h", "v", "V") or die Usage;
  27 print Usage and exit if $OPT{h};
  28 print "$VERSION\n" and exit if $OPT{V};
  29 die Usage unless @ARGV == 1;
  30
  31 for my $p4opt (qw(p)) {
  32   push @P4opt, "-$p4opt $OPT{$p4opt}" if $OPT{$p4opt};
  33 }
  34
  35 my $system = "p4 @P4opt describe -s @ARGV |";
  36 open my $p4, $system or die "Could not run $system";
  37 my @action;
  38 while (<$p4>) {
  39   print;
  40   next unless m|($OPT{b})|;
  41   my($prefix) = $1;
  42   $prefix =~ s|/[^/]+$||; # up to the last "/" in the match is to be stripped
  43   if (my($file,$action) = m|^\.\.\. (//depot.*)\s(\w+)$|) {
  44     next if $action eq "delete";
  45     push @action, [$action, $file, $prefix];
  46   }
  47 }
  48 close $p4;
  49
  50 my $tempdir;
  51 print "Differences ...\n";
  52 for my $a (@action) {
  53   $tempdir ||= tempdir( "tmp-XXXX", CLEANUP => 1, TMPDIR => 1 );
  54   my($action,$file,$prefix) = @$a;
  55   my($path,$basename,$number) = $file =~ m|\Q$prefix\E/(.+/)?([^/]+)#(\d+)|;
  56   my($prevfile) = $file =~ m|^(.+)#\d+\z|;
  57   die "Panic: Could not parse file[$file]" unless $number;
  58   $path = "" unless defined $path;
  59   my($d1,$d2,$prev);
  60   $prev = $number-1;
  61   $prevfile .= "#$prev";
  62   if ($prev==0 or $action =~ /^(add|branch)$/) {
  63     $d1 = "/dev/null";
  64   } elsif ($action =~ /^(edit|integrate)$/) {
  65     $d1 = "$path$basename#$prev";
  66     warn "==> $d1 <==\n" if $OPT{v};
  67     my $system = "p4 @P4opt print -o $tempdir/$d1 $prevfile";
  68     my $status = `$system`;
  69     if ($?) {
  70       warn "$0: system[$system] failed, status[$?]\n";
  71       next;
  72     }
  73     chmod 0644, "$tempdir/$d1";
  74     if (my($prevch) = $status =~ / \s change \s (\d+) \s /x) {
  75       my $oldd1 = $d1;
  76       $d1 .= "~$prevch~";
  77       rename "$tempdir/$oldd1", "$tempdir/$d1";
  78     }
  79   } else {
  80     die "Unknown action[$action]";
  81   }
  82   $d2 = "$path$basename";
  83   warn "==> $d2#$number <==\n" if $OPT{v};
  84   my $system = "p4 @P4opt print -o $tempdir/$d2 $file";
  85   # warn "system[$system]";
  86   my $type = `$system`;
  87   if ($?) {
  88     warn "$0: `$system` failed, status[$?]\n";
  89     next;
  90   }
  91   chmod 0644, "$tempdir/$d2";
  92   $type =~ m|^//.*\((.+)\)$| or next;
  93   $type = $1;
  94   if (File::Compare::compare("$tempdir/$d1", "$tempdir/$d2")) {
  95     print "\n==== $file ($type) ====\n";
  96     unless ($type =~ /text/) {
  97       next;
  98     }
  99     print "Index: $path$basename\n";
 100     my @filelog = `p4 @P4opt filelog $file`;
 101     correctmtime(\@filelog,$prev,"$tempdir/$d1");
 102     correctmtime(\@filelog,$number,"$tempdir/$d2");
 103     chdir $tempdir or warn "Could not chdir '$tempdir': $!";
 104     $system = qq[$OPT{D} -$OPT{d} "$d1" "$d2"];
 105     system($system); # no return check because diff doesn't always return 0
 106     chdir $TOPDIR or warn "Could not chdir '$TOPDIR': $!";
 107   }
 108   for ("$tempdir/$d1","$tempdir/$d2") {
 109     unlink or warn "Could not unlink $_: $!" if -f;
 110   }
 111 }
 112 print "End of Patch.\n";
 113
 114 sub correctmtime ($$$) {
 115   my($filelog,$nr,$file) = @_;
 116   for my $line (@$filelog) {
 117     my($rev,$change,$action,$date) =
 118         $line =~ m{ ^ \.\.\. \s
 119                     \#
 120                     (\d+)            # rev
 121                     \s change \s
 122                     (\d+)            # change
 123                     \s (\w+) \s      # action
 124                     on \s (\S+)      # date
 125                   }x or next;
 126     # warn "rev[$rev]";
 127     next unless $rev == $nr;
 128     my(@date) = split m|/|, $date;
 129     $date[0] -= 1900;
 130     $date[1]--;
 131     my $time = timelocal(0,0,0,reverse @date);
 132     utime $time, $time, $file;
 133     last;
 134   }
 135 }
 136
 137 sub Usage () {
 138     qq{Usage: $0 [OPTIONS] patchnumber
 139
 140       -p host:port    p4 port (e.g. myhost:1666)
 141       -d diffopt      option to pass to diff(1)
 142       -D diff         diff(1) to use
 143       -b branch(es)   which branches to include (regex); everything up
 144                       to the last slash of matched portion of path is
 145                       stripped on local copy (default: //depot/perl)
 146       -v              verbose
 147       -h              print this help and exit
 148       -V              print version number and exit
 149
 150 Fetches all required files from the repository, puts them into a
 151 temporary directory with sensible names and sensible modification
 152 times and composes a patch to STDOUT using external diff command.
 153 Requires repository access.
 154
 155 Examples:
 156           perl $0 12345 | gzip -c > 12345.gz
 157           perl $0 -dc 12345 > change-12345.patch
 158           perl $0 -b //depot/maint-5.6/perl -v 8571 > 8571
 159 };
 160 }