#!/usr/bin/perl use strict; use warnings; use File::Basename; use Getopt::Long; # $Id: //guest/jonathan_kamens/p4pr.perl#14 $ # 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. my $whoami = basename $0; my $P4 = ($ENV{'P4'} || "p4") ; use vars qw($opt_after $print_line_numbers); $print_line_numbers = 0; # 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) = @_; # Quote magic characters in each argument in the command map(s/([ #])/"$1"/g, @command); my(@results) = `@command`; if ($?) { my($err) = ($? >> 8); print STDERR @results; die qq($whoami: "@command" exited with status $err.\n); } @results } # Fatal usage error sub usage { my($err) = @_; warn "$whoami: $err\n" if ($err); die ("Usage: $whoami [-n] [ --after=YYYY/MM/DD ] <file> | <file>#<rev> | " . "<file>\@<change>\n" . " -n means print a line number on each output line\n" . " <file> may be a client file name or depot file name.\n"); } usage() if (! GetOptions("after=s" => \$opt_after, "n" => \$print_line_numbers)); usage("invalid date \"$opt_after\"") if ($opt_after && $opt_after !~ /^\d{4}(\/\d{2}){2}$/); # Get file argument. usage("file name expected") if !@ARGV; usage("invalid argument") if @ARGV > 1; my $file = shift; # Handle # and @ notation (only for numeric changes and revisions). my $change = $1 if $file =~ s/@(\d+)//; my $head = $1 if $file =~ s/\#(\d+)//; # Check that the file specification maps to exactly one file. my $check_file; if ($change) { $check_file = "$file\@$change"; } elsif ($head) { $check_file = "$file\#$head"; } else { $check_file = $file; } my(@list) = command($P4, 'files', $check_file); if (@list > 1) { die("$whoami: 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("$whoami: revision $1 is deleted.\n") } # Get the fullname of the file and the history, all from # the filelog for the file. my($fullname, @history) = command($P4, 'filelog', '-i', $check_file); chop($fullname); $fullname =~ s/\#.*//; my(@fullname) = split(m./., $fullname); my $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. my(%change, @change, %author, %date, $thisbranch, $thisrev, $headseen); for (@history) { if (m,^//,) { chop($thisname = $_); next; } if (/^\.\.\. \#(\d+)\s+change\s+(\d+)\s+(\S+)\s+on\s+(\S+)\s+by\s+(\S+)@/) { my $this_rev = $1; my $this_change = $2; my $this_type = $3; my $this_date = $4; my $this_author = $5; last if ($this_type eq "delete"); last if ($opt_after && ($this_date lt $opt_after)); # If a change number or revision is specified, then ignore # later revisions. next if ($change && ($change < $this_change)); next if ($head && ($fullname eq $thisname) && ($head < $this_rev)); $change{"$thisname#$this_rev"} = $this_change; push(@change, "$thisname#$this_rev"); $author{"$thisname#$this_rev"} = $thisbranch ? "$this_author\@$thisbranch" : $this_author; $date{"$thisname#$this_rev"} = $this_date; $head = $this_rev if !$head; $thisrev = "$thisname#$this_rev"; $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; } } } usage("no revisions after $opt_after") if ($opt_after && ! @change); 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 my($base, @revs) = reverse @change; # Get the contents of the base revision of the file, # purely for the purposes of counting the lines. my(@text) = command($P4, 'print', '-q', $base); # For each line in the file, set the change revision # to be the base revision. my(@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. my $lastrev = $base; for my $rev (@revs) { # Apply the diffs in reverse order to maintain correctness # of line numbers for each range as we apply it. for (reverse command($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. my $header; ($header, @text) = command($P4, 'print', "$file#$head"); if (@text != @lines) { die("$whoami: internal error applying diffs - please contact the author\n") } # Print a pretty header. my $fmt = "%10s %15s %6s %4s %s"; my(@fields) = ("date", "author/branch", "change", "rev", $header); if ($print_line_numbers) { $fmt = "%5s $fmt"; unshift(@fields, "line"); } 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,.*\#,,; my(@values) = ($date{$rev}, $author{$rev}, $change{$rev}, $revno, shift @text); if ($print_line_numbers) { unshift(@values, $line++); } printf($fmt, @values); }
# | 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. |