#!/usr/bin/perl

# $Id: //depot/main/p4-contrib/misc/p4pr.perl#2$

# Interpolate change information into a source listing of a p4 file.
# Takes a file name or depot filename, with #<ref> or @<change>.
# Originally by Bob Sidebotham.
# Modifications by Jonathan Kamens <jik@kamens.brookline.ma.us> to
# support annotating changes back through branchings, rather than
# only annotating back to revision 1 on the current branch.

# Simplify program name, if it is a path.
$0 =~ s,.*/,,;

###
### Small change:
###
my $P4= ($ENV{'P4'} || "p4") ;

# Execute a command, keeping the output of the command in an array.
# Returns the array, unless an error occured, in which case the an
# exception is thrown (via die) with an appropriate message.
sub command {
    my($command) = @_;
    my(@results) = `$command`;
    if ($?) {
	my($err) = ($? >> 8);
	print STDERR @results;
	die qq($0: "$command" exited with status $err.\n);
    }
    @results
}

# Fatal usage error
sub usage {
    my($err) = @_;
    die
      "$0: $err\n" .
      "usage: $0 <file> | <file>#<rev> | <file>\@<change>\n" .
      " <file> may be a client file name or depot file name.\n";
}

# Default options
$showauthor = 1;
$showchange = 1;
$showrev = 1;

#print STDERR "PATH: $ENV{PATH}\n" ;

# Undocumented options
if (@ARGV && $ARGV[0] =~ /^-/) {
    $showchange = 0;
}

# Parse options
while (@ARGV && $ARGV[0] =~ /^-/) {
    $opt = shift;
    if ($opt eq '-r') {
	$showrev = 1; # Show revision numbers instead of changes.
    } elsif ($opt eq '-c') {
	$showchange = 1;
    } else {
	usage("invalid option $opt"); 
    }
}

# Get file argument.
usage("file name expected") if !@ARGV;
usage("invalid argument") if @ARGV > 1;
$file = shift;

# Handle # and @ notation (only for numeric changes and revisions).
$change = $1 if $file =~ s/@(\d+)//;
$head = $1 if $file =~ s/\#(\d+)//;

# Check that the file specification maps to exactly one file.
@list = command qq($P4 files $file);
if (@list > 1) {
    die("$0: the specified file pattern maps to more than one file.\n");
}

# Check that the revision is not deleted.
if ($list[0] =~ /(.*\#\d+) - delete change/) {
    die("$0: revision $1 is deleted.\n")
}

# Get the fullname of the file and the history, all from
# the filelog for the file.
($fullname, @history) = command qq($P4 filelog -i $file);
chop($fullname);
$fullname =~ s/\#.*//;
@fullname = split(m./., $fullname);

$thisname = $fullname;

# Extract the revision to change number mapping. Also
# get the author of each revision, and for merged
# or copied revisions, the "branch name", which we
# use instead of an author.
for (@history) {
    if (m,^//,) {
        chop($thisname = $_);
        next;
    }
    if (/^\.\.\. \#(\d+) change (\d+)\s+(\w+) .*? by (.*?)@/) {
	# If a change number or revision is specified, then ignore
	# later revisions.
	last if $3 eq "delete" ; # Small bug fix by Fredric Fredricson
	next if $change && $change < $2;
	next if ($head && ($fullname eq $thisname) && ($head < $1));
	$change{"$thisname#$1"} = $2;
        push(@change, "$thisname#$1");
 	$author{"$thisname#$1"} = $thisbranch ? "$4\@$thisbranch" : $4;
	$head = $1 if !$head;
 	$thisrev = "$thisname#$1";
	$headseen = 1;
    } else {
	# If we see a branch from, then we know that
	# previous revisions did not contribute to the current
	# revision. Don't do this, however, if we haven't seen
	# the revision we've been requested to print, yet.
	# We used to do this for copy from, but I think
	# it's better not to.
	next unless $headseen;
	if (/^\.\.\. \.\.\. branch from (\/\/[^\#]*)\#/) {
	    # If merged or copied from another part of the
	    # tree, then we use the components of the
	    # name that is different, and call that the "branch"
	    # Further, we make the "author" be the name of the
	    # branch.
	    my($fromfile) = $1;
	    my(@from) = split(m,/,, $fromfile);
            $thisbranch = &find_branch_part($fullname, $fromfile);
            $author{$thisrev} = $thisbranch;
	}
    }
}

sub find_branch_part {
    # Strips identical substrings from the beginning and end of
    # $origname and $branchname and then returns what remains of
    # $branchname.
    my($origname, $branchname) = @_;
    my(@origname) = split('/', $origname);
    my(@branchname) = split('/', $branchname);
    while (@origname && ($origname[0] eq $branchname[0])) {
        shift @origname;
        shift @branchname;
    }
    while (@origname &&
           ($origname[@origname-1] eq $branchname[@branchname-1])) {
        pop @origname;
        pop @branchname;
    }
    join('/', @branchname);
}

# Get first revision, and list of remaining revisions
($base, @revs) = reverse @change;

# Get the contents of the base revision of the file,
# purely for the purposes of counting the lines.
@text = command qq($P4 print -q $base);

# For each line in the file, set the change revision
# to be the base revision.
@lines = ($base) x @text;

# For each revision from the base to the selected revision
# "apply" the diffs by manipulating the array of revision
# numbers. If lines are added, we add a corresponding 
# set of entries with the revision number that added it.
# We ignore the actual revision text--that will be merged
# with the change information later.
$lastrev = $base;
for $rev (@revs) {
    # Apply the diffs in reverse order to maintain correctness
    # of line numbers for each range as we apply it.
    for (reverse command qq($P4 diff2 $lastrev $rev)) {
	my( $la, $lb, $op, $ra, $rb ) = /^(\d+),?(\d*)([acd])(\d+),?(\d*)/;
	next unless defined($ra);
	$lb = $la if ! $lb;
	++$la if $op eq 'a';
	$rb = $ra if ! $rb;
	++$ra if $op eq 'd';
	splice @lines, $la - 1, $lb - $la + 1, ($rev) x ($rb - $ra + 1);
    }
    $lastrev = $rev;
}
			
# Get the text of the selected revision. The number of lines
# resulting from applying the diffs should equal the number of
# of lines in this revision.
($header, @text) = command qq($P4 print $file\#$head);
if (@text != @lines) {
    die("$0: internal error applying diffs - please contact the author\n")
}    

# Print a pretty header. Note that the interpolated information
# at the beginning of the line is a multiple of 8 bytes (currently 24)
# so that the default tabbing of 8 characters works correctly.
my($fmt) = "%5s %15s %6s %4s %s";
@fields = ("line", "author/branch", "change", "rev", $header);
printf($fmt, @fields);
printf("$fmt\n", map('-' x length($_), @fields));

# Interpolate the change author and number into the text.
my($line) = 1;
while (@text) {
    my($rev) = shift(@lines);
    my($revno);

    ($revno = $rev) =~ s,.*\#,,;
    printf($fmt, $line++, $author{$rev}, $change{$rev}, $revno, shift @text);
}