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