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 && $ARGV[0] =~ /^\d+$/;
  30 my $CHANGE = shift;
  31
  32 for my $p4opt (qw(p)) {
  33   push @P4opt, "-$p4opt $OPT{$p4opt}" if $OPT{$p4opt};
  34 }
  35
  36 my $system = "p4 @P4opt describe -s $CHANGE |";
  37 open my $p4, $system or die "Could not run $system";
  38 my @action;
  39 while (<$p4>) {
  40   print;
  41   next unless m|($OPT{b})|;
  42   my($prefix) = $1;
  43   $prefix =~ s|/[^/]+$||; # up to the last "/" in the match is to be stripped
  44   if (my($file,$action) = m|^\.\.\. (//depot.*)\s(\w+)$|) {
  45     next if $action eq "delete";
  46     push @action, [$action, $file, $prefix];
  47   }
  48 }
  49 close $p4;
  50
  51 my $tempdir;
  52 print "Differences ...\n";
  53 for my $a (@action) {
  54   $tempdir ||= tempdir( "tmp-XXXX", CLEANUP => 1, TMPDIR => 1 );
  55   my($action,$file,$prefix) = @$a;
  56   my($path,$basename,$number) = $file =~ m|\Q$prefix\E/(.+/)?([^/]+)#(\d+)|;
  57   my($depotfile) = $file =~ m|^(.+)#\d+\z|;
  58   die "Panic: Could not parse file[$file]" unless $number;
  59   $path = "" unless defined $path;
  60   my($d1,$d2,$prev,$prevchange,$prevfile);
  61   $prev = $number-1;
  62   $prevchange = $CHANGE-1;
  63   # can't assume previous rev == $number-1 due to obliterated revisions
  64   $prevfile = "$depotfile\@$prevchange";
  65   if ($number == 1 or $action =~ /^(add|branch)$/) {
  66     $d1 = "/dev/null";
  67   } elsif ($action =~ /^(edit|integrate)$/) {
  68     $d1 = "$path$basename-$prevchange";
  69     warn "==> $d1 <==\n" if $OPT{v};
  70     my $system = qq[p4 @P4opt print -o "$tempdir/$d1" "$prevfile"];
  71     my $status = `$system`;
  72     if ($?) {
  73       warn "$0: system[$system] failed, status[$?]\n";
  74       next;
  75     }
  76     chmod 0644, "$tempdir/$d1";
  77     if ($status =~ /\#(\d+) \s - \s \w+ \s change \s (\d+) \s /x) {
  78       ($prev,$prevchange) = ($1,$2);
  79       $prevfile = "$depotfile#$prev";
  80       my $oldd1 = $d1;
  81       $d1 =~ s/-\d+$/#$prev~$prevchange~/;
  82       rename "$tempdir/$oldd1", "$tempdir/$d1";
  83     }
  84   } else {
  85     die "Unknown action[$action]";
  86   }
  87   $d2 = "$path$basename";
  88   warn "==> $d2#$number <==\n" if $OPT{v};
  89   my $system = qq[p4 @P4opt print -o "$tempdir/$d2" "$file"];
  90   # warn "system[$system]";
  91   my $type = `$system`;
  92   if ($?) {
  93     warn "$0: `$system` failed, status[$?]\n";
  94     next;
  95   }
  96   chmod 0644, "$tempdir/$d2";
  97   $type =~ m|^//.*\((.+)\)$| or next;
  98   $type = $1;
  99   if (File::Compare::compare("$tempdir/$d1", "$tempdir/$d2")) {
 100     print "\n==== $file ($type) ====\n";
 101     unless ($type =~ /text/) {
 102       next;
 103     }
 104     print "Index: $path$basename\n";
 105     correctmtime($prevfile,$prev,"$tempdir/$d1");
 106     correctmtime($file,$number,"$tempdir/$d2");
 107     chdir $tempdir or warn "Could not chdir '$tempdir': $!";
 108     $system = qq[$OPT{D} -$OPT{d} "$d1" "$d2"];
 109     system($system); # no return check because diff doesn't always return 0
 110     chdir $TOPDIR or warn "Could not chdir '$TOPDIR': $!";
 111   }
 112   for ("$tempdir/$d1","$tempdir/$d2") {
 113     unlink or warn "Could not unlink $_: $!" if -f;
 114   }
 115 }
 116 print "End of Patch.\n";
 117
 118 sub correctmtime ($$$) {
 119   my($depotfile,$nr,$localfile) = @_;
 120   my %fstat = map { /^\.\.\. (\w+) (.*)$/ } `p4 @P4opt fstat "$depotfile"`;
 121   return unless $fstat{headRev} == $nr;
 122   utime $fstat{headTime}, $fstat{headTime}, $localfile;
 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       -D diff         diff(1) to use
 131       -b branch(es)   which branches to include (regex); everything up
 132                       to the last slash of matched portion of path is
 133                       stripped on local copy (default: //depot/perl)
 134       -v              verbose
 135       -h              print this help and exit
 136       -V              print version number and exit
 137
 138 Fetches all required files from the repository, puts them into a
 139 temporary directory with sensible names and sensible modification
 140 times and composes a patch to STDOUT using external diff command.
 141 Requires repository access.
 142
 143 Examples:
 144           perl $0 12345 | gzip -c > 12345.gz
 145           perl $0 -dc 12345 > change-12345.patch
 146           perl $0 -b //depot/maint-5.6/perl -v 8571 > 8571
 147 };
 148 }