#!/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 (/^\.\.\. \.\.\. (copy|branch|merge) from (\/\/[^\#]*)\#/) { # If merged or copied from another part of the # tree, then we use the first component of the # name that is different, and call that the "branch" # Further, we make the "author" be the name of the # branch. my($type) = $1; my(@from) = split(m,/,, $2); $thisbranch = &find_branch_part($fullname, $2); $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[0] && ($origname[0] eq $branchname[0])) { shift @origname; shift @branchname; } while ($origname[@origname-1] && ($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); }
# | Change | User | Description | Committed | |
---|---|---|---|---|---|
#14 | 5998 | Jonathan Kamens |
Add "use strict" and "use warnings" to make code cleaner. Suggestion from Dan Nicolaescu: Make printing line numbers optional, disabled by default. Change from dan Nicolaescu: Print the change date for each line in the file. |
||
#13 | 1331 | Jonathan Kamens | Allow file names with spaces in them to work properly. | ||
#12 | 1224 | Jonathan Kamens |
Fix type -- should be text+xk instead of text+x so that Id string is substituted. |
||
#11 | 1112 | Jonathan Kamens |
Fix a bug that made it impossible to annotate an earlier version of a file which is deleted at its head revision. |
||
#10 | 1111 | Jonathan Kamens |
Put the name of the program in "$whoami" instead of messing with $0. Use "basename" in the "File::Basename" package to determine the name of the program. Whitespace cleanups. Better usage message. Add support for "--after" to only look at revisions after the specified date. Redo command-line parsing to use "Getopt::Long". Remove previous parsing of no-op, undocumented "-r" and "-c" options. Removed unused variables $showauthor, $showchange, $showrev. |
||
#9 | 365 | Jonathan Kamens |
(find_branch_part): When figuring out what part of the file name to display for a previous branch of the file, display all different path components rather than displaying all different characters. That is, when comparing the current file name to the previous one, split it up on slashes and compare the components instead of doing a character-by-character comparison. This gives a much more intuitive result. |
||
#8 | 341 | Jonathan Kamens |
When looking for where a file was branched from, ignore "copy from" and "merge from" lines -- we only really care about "branch from" lines. |
||
#7 | 336 | Jonathan Kamens | Missing caret in the regular expression matching diff lines. | ||
#6 | 335 | Jonathan Kamens |
Use P4 environment variable for name of p4 executable, if it's set. |
||
#5 | 328 | Jonathan Kamens |
Instead of hard-coding the path to /usr/local/bin/p4, set $P4 to just "p4" by default, so it'll get whatever p4 is in the search path. |
||
#4 | 327 | Jonathan Kamens |
Eliminate some unnecessary usages of the character '#', and quote others with backslashes, to make Perl mode in Emacs indent more happily. |
||
#3 | 326 | Jonathan Kamens |
Add a comment with my name and address indicating that I've modified the script to annotate past branchings. |
||
#2 | 325 | Jonathan Kamens | Changes to make p4pr.perl display annotation back through branchings. | ||
#1 | 324 | Jonathan Kamens |
Branch in preparation for committing my changes which will cause p4pr to trace changes back through branchings. |
||
//guest/perforce_software/utils/p4db/p4pr.perl | |||||
#1 | 11 | Perforce maintenance | Add Fredric Fredricson's depot browser, P4DB. |