Upgrade to Digest::MD5 2.20.

[perl5.git] / Porting / p4desc

#!/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
	    $branches $skip);

BEGIN {
    $0 =~ s|^.*/||;
    $p4port = $ENV{P4PORT} || 'localhost:1666';
    for (@ARGV) {
        if ($p4port =~ /^\s+$/) {
	   $p4port = $_;
	}
        elsif (/^-p(.*)$/) {
	    $p4port = $1 || ' ';
	}
        elsif (/^-b(.*)$/) {
	    $branches = $1;
	}
	elsif (/^-v$/) {
	    $v++;
	}
	elsif (/^-h/) {
	    $h++;
	}
	else {
	    push @files, $_;
	}
    }
    unless (@files) { @files = '-'; undef $^I; }
    @ARGV = @files;
    $branches = '//depot/perl/' unless defined $branches;
    if ($h) {
	print STDERR <<USAGE;
Usage: $0 [-p \$P4PORT] [-v] [-h] [files]

	-phost:port	p4 port (e.g. myhost:1666)
	-h		print this help
	-v		output progress messages
	-bbranch(es)	which branches to include (regex)
			(default: //depot/perl/)
	-h		show this help

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 1: Currently only emits unified diffs (diff -u).

WARNING 2: By default only the changes in the //depot/perl branch
are shown.  To include all the branches, supply "-b." arguments
to $0.

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|^\.\.\. |) {
	if (m|$branches|) {
	    if (m{^\.\.\. (//depot/.+?\#\d+) (add|branch)$}) {
		my $newfile = $1;
		push @addfiles, $newfile;
		warn "$newfile add, revision != 1!\n" unless $newfile =~ /#1$/;
	    }
        } else {
	    push @skipped, "# $_";
	    $_ = '';
	}
    }
    warn "file [$file] line [$cur] file# [$fnum]\n" if $v;
}

if (m|^==== //depot/|) { 
    $skip = !m|$branches|;
    print "# Skipped because not under branches: $branches\n" if $skip;
}

$_ = "# $_" if $skip; 

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();
    $_ .= join('', "\n",
               "# Skipped because not under branches: $branches\n",
               @skipped, "\n") if @skipped; 
}

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;
}