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