New port, p4genpatch, automatically generates patch(1)-compatible diffs

from Perforce diffs and changelists.

2 files changed, 266 insertions, 0 deletions

diff --git a/devel/p4genpatch/files/bin/p4d2p b/devel/p4genpatch/files/bin/p4d2p
new file mode 100644
index 000000000000..83b0021da596
--- /dev/null
+++ b/devel/p4genpatch/files/bin/p4d2p
@@ -0,0 +1,84 @@
+#!/usr/bin/perl -wspi~
+
+#
+# reads a perforce style diff on stdin and outputs appropriate headers
+# so the diff can be applied with the patch program
+#
+# Gurusamy Sarathy <gsar@activestate.com>
+#
+
+BEGIN {
+    $0 =~ s|.*/||;
+    if ($h or $help) {
+	print STDERR <<USAGE;
+Usage: $0 [-v] [-h] files
+
+	-h	print this help
+	-v	output progress messages
+
+Does inplace edit of diff files output by the perforce commands
+"p4 describe", "p4 diff", and "p4 diff2". The result is suitable
+for feeding to the "patch" program.
+
+If no files are specified, reads from stdin and writes to stdout.
+
+WARNING: It only handles context or unified diffs.
+
+Example: p4 describe -du 123 | $0 > change-123.patch
+
+USAGE
+	exit(0);
+    }
+    unless (@ARGV) { @ARGV = '-'; undef $^I; }
+    use vars qw($thisfile $time $file $fnum $v $h $help);
+    $thisfile = "";
+    $time = localtime(time);
+}
+
+my ($cur, $match);
+$cur = m<^==== //depot/(.+?)\#\d+.* ====$> ... m<^(\@\@.+\@\@|\*+)$>;
+
+$match = $1;
+
+if ($ARGV ne $thisfile) {
+    warn "processing patchfile [$ARGV]\n" unless $ARGV eq '-';
+    $thisfile = $ARGV;
+}
+
+# while we are within range
+if ($cur) {
+    # set the file name after first line
+    if ($cur == 1) {
+	$file = $match;
+	$fnum++;
+    }
+    # emit the diff header when we hit last line
+    elsif ($cur =~ /E0$/) {
+	my $f = $file;
+
+	# special hack for perl so we can always use "patch -p1"
+	$f =~ s<^.*?(perl.*?/)><$1>;
+
+	# unified diff
+	if ($match =~ /^\@/) {
+	    warn "emitting udiff header\n" if $v;
+	    $_ = "Index: $f\n--- $f.~1~\t$time\n+++ $f\t$time\n$_";
+	}
+	# context diff
+	elsif ($match =~ /^\*/) {
+	    warn "emitting cdiff header\n" if $v;
+	    $_ = "Index: $f\n*** $f.~1~\t$time\n--- $f\t$time\n$_";
+	}
+    }
+    # see if we hit another patch (i.e. previous patch was empty)
+    elsif (m<^==== //depot/(.+?)\#\d+.* ====$>) {
+	$file = $match = $1;
+    }
+    # suppress all other lines in the header
+    else {
+	$_ = "";
+    }
+    warn "file [$file] line [$cur] file# [$fnum]\n" if $v;
+}
+
+$_ .= "End of Patch.\n" if eof;
diff --git a/devel/p4genpatch/files/bin/p4genpatch b/devel/p4genpatch/files/bin/p4genpatch
new file mode 100644
index 000000000000..6de838bed829
--- /dev/null
+++ b/devel/p4genpatch/files/bin/p4genpatch
@@ -0,0 +1,182 @@
+#!/usr/bin/perl -w
+
+
+# p4genpatch - Generate a perl patch from the repository
+
+# Usage: $0 -h
+
+# andreas.koenig@anima.de
+
+use strict;
+use File::Temp qw(tempdir);
+use File::Compare;
+use File::Spec;
+use File::Spec::Unix;
+use Time::Local;
+use Getopt::Long;
+use Cwd qw(cwd);
+
+sub correctmtime ($$$);
+sub Usage ();
+
+$0 =~ s|^.*[\\/]||;
+my $VERSION = '0.05';
+my $TOPDIR = cwd();
+my @P4opt;
+our %OPT = ( "d" => "u", b => "//depot/", "D" => "diff" );
+Getopt::Long::Configure("no_ignore_case");
+GetOptions(\%OPT, "b=s", "p=s", "d=s", "D=s", "h", "v", "V") or die Usage;
+print Usage and exit if $OPT{h};
+print "$VERSION\n" and exit if $OPT{V};
+die Usage unless @ARGV == 1 && $ARGV[0] =~ /^\d+$/;
+my $CHANGE = shift;
+
+for my $p4opt (qw(p)) {
+  push @P4opt, "-$p4opt $OPT{$p4opt}" if $OPT{$p4opt};
+}
+
+my $system = "p4 @P4opt describe -s $CHANGE |";
+open my $p4, $system or die "Could not run $system";
+my @action;
+while (<$p4>) {
+  print;
+  next unless m|($OPT{b})|;
+  my($prefix) = $1;
+  $prefix =~ s|/$||;
+  $prefix =~ s|/[^/]+$||; # up to the last "/" in the match is to be stripped
+  if (my($file,$action) = m|^\.\.\. (//depot.*)\s(\w+)$|) {
+    next if $action eq "delete";
+    push @action, [$action, $file, $prefix];
+  }
+}
+close $p4;
+
+my $tempdir;
+my @unlink;
+print "Differences ...\n";
+for my $a (@action) {
+  $tempdir ||= tempdir( "tmp-XXXX", CLEANUP => 1, TMPDIR => 1 );
+  @unlink = ();
+  my($action,$file,$prefix) = @$a;
+  my($path,$basename,$number) = $file =~ m|\Q$prefix\E/(.+/)?([^/]+)#(\d+)|;
+
+  my @splitdir = File::Spec::Unix->splitdir($path);
+  $path = File::Spec->catdir(@splitdir);
+
+  my($depotfile) = $file =~ m|^(.+)#\d+\z|;
+  die "Panic: Could not parse file[$file]" unless $number;
+  $path = "" unless defined $path;
+  my($d1,$d2,$prev,$prevchange,$prevfile,$doadd,$t1,$t2);
+  $prev = $number-1;
+  $prevchange = $CHANGE-1;
+  # can't assume previous rev == $number-1 due to obliterated revisions
+  $prevfile = "$depotfile\@$prevchange";
+  if ($number == 1 or $action =~ /^(add|branch)$/) {
+    $d1 = $^O eq 'MacOS' ? File::Spec->devnull : "/dev/null";
+    $t1 = $d1;
+    ++$doadd;
+  } elsif ($action =~ /^(edit|integrate)$/) {
+    $d1 = File::Spec->catfile($path, "$basename-$prevchange");
+    $t1 = File::Spec->catfile($tempdir, $d1);
+    warn "==> $d1 <==\n" if $OPT{v};
+    my $system = qq[p4 @P4opt print -o "$t1" "$prevfile"];
+    my $status = `$system`;
+    if ($?) {
+      warn "$0: system[$system] failed, status[$?]\n";
+      next;
+    }
+    chmod 0644, $t1;
+    if ($status =~ /\#(\d+) \s - \s \w+ \s change \s (\d+) \s /x) {
+      ($prev,$prevchange) = ($1,$2);
+      $prevfile = "$depotfile#$prev";
+      my $oldd1 = $d1;
+      $d1 =~ s/-\d+$/#$prev~$prevchange~/;
+      my $oldt1 = $t1;
+      $t1 = File::Spec->catfile($tempdir, $d1);
+      rename $oldt1, $t1;
+    }
+    push @unlink, $t1;
+  } else {
+    die "Unknown action[$action]";
+  }
+  $d2 = File::Spec->catfile($path, $basename);
+  $t2 = File::Spec->catfile($tempdir, $d2);
+  push @unlink, $t2;
+  warn "==> $d2#$number <==\n" if $OPT{v};
+  my $system = qq[p4 @P4opt print -o "$t2" "$file"];
+  # warn "system[$system]";
+  my $type = `$system`;
+  if ($?) {
+    warn "$0: `$system` failed, status[$?]\n";
+    next;
+  }
+  chmod 0644, $t2;
+  $type =~ m|^//.*\((.+)\)$| or next;
+  $type = $1;
+  if ($doadd or File::Compare::compare($t1, $t2)) {
+    print "\n==== $file ($type) ====\n";
+    unless ($type =~ /text/) {
+      next;
+    }
+    unless ($^O eq 'MacOS') {
+      $d1 =~ s,\\,/,g;
+      $d2 =~ s,\\,/,g;
+    }
+    print "Index: $d2\n";
+    correctmtime($prevfile,$prev,$t1) unless $doadd;
+    correctmtime($file,$number,$t2);
+    chdir $tempdir or warn "Could not chdir '$tempdir': $!";
+    $system = qq[$OPT{D} -$OPT{d} "$d1" "$d2"];
+    system($system); # no return check because diff doesn't always return 0
+    chdir $TOPDIR or warn "Could not chdir '$TOPDIR': $!";
+  }
+}
+continue {
+  for (@unlink) {
+    unlink or warn "Could not unlink $_: $!" if -f;
+  }
+}
+print "End of Patch.\n";
+
+my($tz_offset);
+sub correctmtime ($$$) {
+  my($depotfile,$nr,$localfile) = @_;
+  my %fstat = map { /^\.\.\. (\w+) (.*)$/ } `p4 @P4opt fstat -s "$depotfile"`;
+  return unless exists($fstat{headRev}) and $fstat{headRev} == $nr;
+
+  if ($^O eq 'MacOS') {  # fix epoch ... still off by three hours (EDT->PDT)
+    require Time::Local;
+    $tz_offset ||= sprintf "%+0.4d\n", (
+      Time::Local::timelocal(localtime) - Time::Local::timelocal(gmtime)
+    );
+    $fstat{headTime} += 2082844801 + $tz_offset;
+  }
+
+  utime $fstat{headTime}, $fstat{headTime}, $localfile;
+}
+
+sub Usage () {
+    qq{Usage: $0 [OPTIONS] patchnumber
+
+      -p host:port    p4 port (e.g. myhost:1666)
+      -d diffopt      option to pass to diff(1)
+      -D diff         diff(1) to use
+      -b branch(es)   which branches to include (regex); the last
+                      directory within the matched part will be
+                      preserved on the local copy, so that patch -p1
+                      will work (default: "//depot/perl/")
+      -v              verbose
+      -h              print this help and exit
+      -V              print version number and exit
+
+Fetches all required files from the repository, puts them into a
+temporary directory with sensible names and sensible modification
+times and composes a patch to STDOUT using external diff command.
+Requires repository access.
+
+Examples:
+          perl $0 12345 | gzip -c > 12345.gz
+          perl $0 -dc 12345 > change-12345.patch
+          perl $0 -b //depot/maint-5.6/perl -v 8571 > 8571
+};
+}