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 );
  54   my($action,$file,$prefix) = @$a;
  55   my($path,$basename,$number) = $file =~ m|\Q$prefix\E/(.+/)?([^/]+)#(\d+)|;
  56   die "Panic: Could not parse file[$file]" unless $number;
  57   $path = "" unless defined $path;
  58   my($d1,$d2,$prev);
  59   $prev = $number-1;
  60   if ($prev==0 or $action =~ /^(add|branch)$/) {
  61     $d1 = "/dev/null";
  62   } elsif ($action =~ /^(edit|integrate)$/) {
  63     $d1 = "$path$basename#$prev";
  64     warn "==> $d1 <==\n" if $OPT{v};
  65     my $system = "p4 @P4opt print -o $tempdir/$d1 //depot/$path$basename#$prev";
  66     my $status = `$system`;
  67     if ($?) {
  68       warn "$0: system[$system] failed, status[$?]\n";
  69       next;
  70     }
  71     chmod 0644, "$tempdir/$d1";
  72     if (my($prevch) = $status =~ / \s change \s (\d+) \s /x) {
  73       my $oldd1 = $d1;
  74       $d1 .= "~$prevch~";
  75       rename "$tempdir/$oldd1", "$tempdir/$d1";
  76     }
  77   } else {
  78     die "Unknown action[$action]";
  79   }
  80   $d2 = "$path$basename";
  81   warn "==> $d2#$number <==\n" if $OPT{v};
  82   my $system = "p4 @P4opt print -o $tempdir/$d2 $file";
  83   # warn "system[$system]";
  84   my $type = `$system`;
  85   if ($?) {
  86     warn "$0: `$system` failed, status[$?]\n";
  87     next;
  88   }
  89   chmod 0644, "$tempdir/$d2";
  90   $type =~ m|^//.*\((.+)\)$| or next;
  91   $type = $1;
  92   if (File::Compare::compare("$tempdir/$d1", "$tempdir/$d2")) {
  93     print "\n==== $file ($type) ====\n";
  94     unless ($type =~ /text/) {
  95       next;
  96     }
  97     print "Index: $path$basename\n";
  98     my @filelog = `p4 @P4opt filelog $file`;
  99     correctmtime(\@filelog,$prev,"$tempdir/$d1");
 100     correctmtime(\@filelog,$number,"$tempdir/$d2");
 101     chdir $tempdir or warn "Could not chdir '$tempdir': $!";
 102     $system = qq[$OPT{D} -$OPT{d} "$d1" "$d2"];
 103     system($system); # no return check because diff doesn't always return 0
 104     chdir $TOPDIR or warn "Could not chdir '$TOPDIR': $!";
 105   }
 106   for ("$tempdir/$d1","$tempdir/$d2") {
 107     unlink or warn "Could not unlink $_: $!" if -f;
 108   }
 109 }
 110 print "End of Patch.\n";
 111
 112 sub correctmtime ($$$) {
 113   my($filelog,$nr,$file) = @_;
 114   for my $line (@$filelog) {
 115     my($rev,$change,$action,$date) =
 116         $line =~ m{ ^ \.\.\. \s
 117                     \#
 118                     (\d+)            # rev
 119                     \s change \s
 120                     (\d+)            # change
 121                     \s (\w+) \s      # action
 122                     on \s (\S+)      # date
 123                   }x or next;
 124     # warn "rev[$rev]";
 125     next unless $rev == $nr;
 126     my(@date) = split m|/|, $date;
 127     $date[0] -= 1900;
 128     $date[1]--;
 129     my $time = timelocal(0,0,0,reverse @date);
 130     utime $time, $time, $file;
 131     last;
 132   }
 133 }
 134
 135 sub Usage () {
 136     qq{Usage: $0 [OPTIONS] patchnumber
 137
 138       -p host:port    p4 port (e.g. myhost:1666)
 139       -d diffopt      option to pass to diff(1)
 140       -D diff         diff(1) to use
 141       -b branch(es)   which branches to include (regex); everything up
 142                       to the last slash of matched portion of path is
 143                       stripped on local copy (default: //depot/perl)
 144       -v              verbose
 145       -h              print this help and exit
 146       -V              print version number and exit
 147
 148 Fetches all required files from the repository, puts them into a
 149 temporary directory with sensible names and sensible modification
 150 times and composes a patch to STDOUT using external diff command.
 151 Requires repository access.
 152
 153 Examples:
 154           perl $0 12345 | gzip -c > 12345.gz
 155           perl $0 -dc 12345 > change-12345.patch
 156           perl $0 -b //depot/maint-5.6/perl -v 8571 > 8571
 157 };
 158 }