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 File::Spec;
  14 use File::Spec::Unix;
  15 use Time::Local;
  16 use Getopt::Long;
  17 use Cwd qw(cwd);
  18
  19 sub correctmtime ($$$);
  20 sub Usage ();
  21
  22 $0 =~ s|^.*[\\/]||;
  23 my $VERSION = '0.05';
  24 my $TOPDIR = cwd();
  25 my @P4opt;
  26 our %OPT = ( "d" => "u", b => "//depot/perl/", "D" => "diff" );
  27 Getopt::Long::Configure("no_ignore_case");
  28 GetOptions(\%OPT, "b=s", "p=s", "d=s", "D=s", "h", "v", "V") or die Usage;
  29 print Usage and exit if $OPT{h};
  30 print "$VERSION\n" and exit if $OPT{V};
  31 die Usage unless @ARGV == 1 && $ARGV[0] =~ /^\d+$/;
  32 my $CHANGE = shift;
  33
  34 for my $p4opt (qw(p)) {
  35   push @P4opt, "-$p4opt $OPT{$p4opt}" if $OPT{$p4opt};
  36 }
  37
  38 my $system = "p4 @P4opt describe -s $CHANGE |";
  39 open my $p4, $system or die "Could not run $system";
  40 my @action;
  41 while (<$p4>) {
  42   print;
  43   next unless m|($OPT{b})|;
  44   my($prefix) = $1;
  45   $prefix =~ s|/$||;
  46   $prefix =~ s|/[^/]+$||; # up to the last "/" in the match is to be stripped
  47   if (my($file,$action) = m|^\.\.\. (//depot.*)\s(\w+)$|) {
  48     next if $action eq "delete";
  49     push @action, [$action, $file, $prefix];
  50   }
  51 }
  52 close $p4;
  53
  54 my $tempdir;
  55 my @unlink;
  56 print "Differences ...\n";
  57 for my $a (@action) {
  58   $tempdir ||= tempdir( "tmp-XXXX", CLEANUP => 1, TMPDIR => 1 );
  59   @unlink = ();
  60   my($action,$file,$prefix) = @$a;
  61   my($path,$basename,$number) = $file =~ m|\Q$prefix\E/(.+/)?([^/]+)#(\d+)|;
  62
  63   my @splitdir = File::Spec::Unix->splitdir($path);
  64   $path = File::Spec->catdir(@splitdir);
  65
  66   my($depotfile) = $file =~ m|^(.+)#\d+\z|;
  67   die "Panic: Could not parse file[$file]" unless $number;
  68   $path = "" unless defined $path;
  69   my($d1,$d2,$prev,$prevchange,$prevfile,$doadd,$t1,$t2);
  70   $prev = $number-1;
  71   $prevchange = $CHANGE-1;
  72   # can't assume previous rev == $number-1 due to obliterated revisions
  73   $prevfile = "$depotfile\@$prevchange";
  74   if ($number == 1 or $action =~ /^(add|branch)$/) {
  75     $d1 = $^O eq 'MacOS' ? File::Spec->devnull : "/dev/null";
  76     $t1 = $d1;
  77     ++$doadd;
  78   } elsif ($action =~ /^(edit|integrate)$/) {
  79     $d1 = File::Spec->catfile($path, "$basename-$prevchange");
  80     $t1 = File::Spec->catfile($tempdir, $d1);
  81     warn "==> $d1 <==\n" if $OPT{v};
  82     my $system = qq[p4 @P4opt print -o "$t1" "$prevfile"];
  83     my $status = `$system`;
  84     if ($?) {
  85       warn "$0: system[$system] failed, status[$?]\n";
  86       next;
  87     }
  88     chmod 0644, $t1;
  89     if ($status =~ /\#(\d+) \s - \s \w+ \s change \s (\d+) \s /x) {
  90       ($prev,$prevchange) = ($1,$2);
  91       $prevfile = "$depotfile#$prev";
  92       my $oldd1 = $d1;
  93       $d1 =~ s/-\d+$/#$prev~$prevchange~/;
  94       my $oldt1 = $t1;
  95       $t1 = File::Spec->catfile($tempdir, $d1);
  96       rename $oldt1, $t1;
  97     }
  98     push @unlink, $t1;
  99   } else {
 100     die "Unknown action[$action]";
 101   }
 102   $d2 = File::Spec->catfile($path, $basename);
 103   $t2 = File::Spec->catfile($tempdir, $d2);
 104   push @unlink, $t2;
 105   warn "==> $d2#$number <==\n" if $OPT{v};
 106   my $system = qq[p4 @P4opt print -o "$t2" "$file"];
 107   # warn "system[$system]";
 108   my $type = `$system`;
 109   if ($?) {
 110     warn "$0: `$system` failed, status[$?]\n";
 111     next;
 112   }
 113   chmod 0644, $t2;
 114   $type =~ m|^//.*\((.+)\)$| or next;
 115   $type = $1;
 116   if ($doadd or File::Compare::compare($t1, $t2)) {
 117     print "\n==== $file ($type) ====\n";
 118     unless ($type =~ /text/) {
 119       next;
 120     }
 121     unless ($^O eq 'MacOS') {
 122       $d1 =~ s,\\,/,g;
 123       $d2 =~ s,\\,/,g;
 124     }
 125     print "Index: $d2\n";
 126     correctmtime($prevfile,$prev,$t1) unless $doadd;
 127     correctmtime($file,$number,$t2);
 128     chdir $tempdir or warn "Could not chdir '$tempdir': $!";
 129     $system = qq[$OPT{D} -$OPT{d} "$d1" "$d2"];
 130     system($system); # no return check because diff doesn't always return 0
 131     chdir $TOPDIR or warn "Could not chdir '$TOPDIR': $!";
 132   }
 133 }
 134 continue {
 135   for (@unlink) {
 136     unlink or warn "Could not unlink $_: $!" if -f;
 137   }
 138 }
 139 print "End of Patch.\n";
 140
 141 my($tz_offset);
 142 sub correctmtime ($$$) {
 143   my($depotfile,$nr,$localfile) = @_;
 144   my %fstat = map { /^\.\.\. (\w+) (.*)$/ } `p4 @P4opt fstat -s "$depotfile"`;
 145   return unless exists($fstat{headRev}) and $fstat{headRev} == $nr;
 146
 147   if ($^O eq 'MacOS') {  # fix epoch ... still off by three hours (EDT->PDT)
 148     require Time::Local;
 149     $tz_offset ||= sprintf "%+0.4d\n", (
 150       Time::Local::timelocal(localtime) - Time::Local::timelocal(gmtime)
 151     );
 152     $fstat{headTime} += 2082844801 + $tz_offset;
 153   }
 154
 155   utime $fstat{headTime}, $fstat{headTime}, $localfile;
 156 }
 157
 158 sub Usage () {
 159     qq{Usage: $0 [OPTIONS] patchnumber
 160
 161       -p host:port    p4 port (e.g. myhost:1666)
 162       -d diffopt      option to pass to diff(1)
 163       -D diff         diff(1) to use
 164       -b branch(es)   which branches to include (regex); the last
 165                       directory within the matched part will be
 166                       preserved on the local copy, so that patch -p1
 167                       will work (default: "//depot/perl/")
 168       -v              verbose
 169       -h              print this help and exit
 170       -V              print version number and exit
 171
 172 Fetches all required files from the repository, puts them into a
 173 temporary directory with sensible names and sensible modification
 174 times and composes a patch to STDOUT using external diff command.
 175 Requires repository access.
 176
 177 Examples:
 178           perl $0 12345 | gzip -c > 12345.gz
 179           perl $0 -dc 12345 > change-12345.patch
 180           perl $0 -b //depot/maint-5.6/perl -v 8571 > 8571
 181 };
 182 }