1 files changed, 118 insertions, 0 deletions
diff --git a/contrib/perl5/Porting/p4desc b/contrib/perl5/Porting/p4desc
new file mode 100755
index 0000000..0bf79da
--- /dev/null
+++ b/contrib/perl5/Porting/p4desc
@@ -0,0 +1,118 @@
+#!/usr/bin/perl -wpi.bak
+
+#
+# Munge "p4 describe ..." output to include new files.
+#
+# Gurusamy Sarathy <gsar@activestate.com>
+#
+
+use vars qw($thisfile $change $file $fnum $h $v $p4port @addfiles);
+
+BEGIN {
+    $0 =~ s|^.*/||;
+    $p4port = $ENV{P4PORT} || 'localhost:1666';
+    for (@ARGV) {
+        if ($p4port =~ /^\s+$/) {
+	   $p4port = $_;
+	}
+        elsif (/^-p(.*)$/) {
+	    $p4port = $1 || ' ';
+	}
+	elsif (/^-v$/) {
+	    $v++;
+	}
+	elsif (/^-h/) {
+	    $h++;
+	}
+	else {
+	    push @files, $_;
+	}
+    }
+    unless (@files) { @files = '-'; undef $^I; }
+    @ARGV = @files;
+    if ($h) {
+	print STDERR <<USAGE;
+Usage: $0 [-p \$P4PORT] [-v] [-h] [files]
+
+	-p host:port	p4 port (e.g. myhost:1666)
+	-h		print this help
+	-v		output progress messages
+
+A smart 'cat'.  When fed the spew from "p4 describe ..." on STDIN,
+spits it right out on STDOUT, followed by patches for any new files
+detected in the spew.  Can also be used to edit insitu a bunch of
+files containing said spew.
+
+WARNING: Currently only emits unified diffs.
+
+Examples:
+	p4 describe -du 123 | $0 > change-123.desc
+	p4 describe -du 123 | $0 | p4d2p > change-123.patch
+
+USAGE
+	exit(0);
+    }
+    $thisfile = "";
+}
+
+
+if ($ARGV ne $thisfile) {
+    warn "processing patchfile [$ARGV]\n" unless $ARGV eq '-';
+    $thisfile = $ARGV;
+}
+
+my $cur = m|^Affected files| ... m|^Differences|;
+
+# while we are within range
+if ($cur) {
+    if (m{^\.\.\. (//depot/.+?#\d+) (add|branch)$}) {
+	my $newfile = $1;
+	push @addfiles, $newfile;
+	warn "$newfile add, revision != 1!\n" unless $newfile =~ /#1$/;
+    }
+    warn "file [$file] line [$cur] file# [$fnum]\n" if $v;
+}
+
+if (/^Change (\d+) by/) {
+    $_ = "\n\n" . $_ if $change;	# start of a new change list
+    $change = $1;
+    my $new = newfiles();
+    if ($new) {
+	$_ = $new . $_;
+    }
+}
+
+if (eof) {
+    $_ .= newfiles();
+}
+
+sub newfiles {
+    my $addfile;
+    my $ret = "";
+    for $addfile (@addfiles) {
+	my $type = `p4 -p $p4port files '$addfile'`;
+	if ($?) {
+	    warn "$0: `p4 -p $p4port print '$addfile'` failed, status[$?]\n";
+	    next;
+	}
+	$type =~ m|^//.*\((.+)\)$| or next;
+	$type = $1;
+	unless ($type =~ /text/) {
+	    $ret .= "\n==== $addfile ($type) ====\n\n";
+	    next;
+	}
+	my @new = `p4 -p $p4port print '$addfile'`;
+	if ($?) {
+	    die "$0: `p4 -p $p4port print '$addfile'` failed, status[$?]\n";
+	}
+	my $desc = shift @new;		# discard initial description
+	$ret .= "\n==== $addfile ($type) ====\n\n";
+	my $lines = "," . @new;
+	$lines = "" if @new < 2;
+	$ret .= "\@\@ -0,0 +1$lines \@\@\n";
+	$ret .= join("+","",@new);
+	$ret .= "\n\\ No newline at end of file\n" if $ret !~ /\n$/;
+    }
+    @addfiles = ();
+    return $ret;
+}