This message is in MIME format ---_=XFMail.1.2.p0.Linux:980320142700:11679=_ Content-Type: text/plain; charset=us-ascii

On 20-Mar-98 Andrea Adams wrote:

I wrote p4tree which, given a file, displays a graph of all history, merges, deletes, renames, etc. It uses vcg to do the actual display (see source for details). I've attached it below.

It generates a pretty general datastrucure of the file's history, so it should be pretty easy to hack to generate other outputs.

J

---_=XFMail.1.2.p0.Linux:980320142700:11679=_ Content-Disposition: attachment; filename="p4tree" Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset=us-ascii; name=p4tree; SizeOnDisk=4168

#!/usr/local/bin/perl

# Print a version tree of a Perforce controlled file # # Usage: p4tree files... # # Requires VCG for display. See # http://www.cs.uni-sb.de/RW/users/sander/html/gsvcg1.html # # Jeremy Fitzhardinge <jeremy at softway.com.au> 1997,1998

require 5.002;

sub p4 ($@) { my ($op, @args) = (@_); my $cmd = "p4 $op ".(join " ", @args); # print "doing $cmd\n"; system $cmd || die "Perforce command $cmd failed\n"; }

sub canon($) { my ($f) = @_; $f =~ s,/+,/,g; $f =~ s,/\.$,/,; return $f; }

@files = @ARGV;

# %db = ( # "//depot/depotname" => [ # { # indexed by version # "op" => "add/delete/edit/branch", # "date" => "1997/08/01", # "who" => "jeremy at ixodes", # "comment" => "fingled the wazzit", # "change" => 1234, # "links" => [ # [ "branch", "from", \%other, 2, 3 ], # [ "merge", "from", \%other ] # ] # } # ] # )

file: foreach $file (@files) { my $currentfile; my $currentver; my $depotname; my $interesting = 1;

$file =~ s/#.*$//;

open P4, "p4 filelog $file|";

while(<P4>) { chop;

if (/^\/\//) { $depotname = $_; $currentfile = $db{$_}; next file if $done{$_}; $done{$_} = "doing";

print "depotname = $_\n"; next; } elsif (/^\.\.\. ([^\s]+) (.*)$/) { my $rest = $2;

if ($1 =~ /#([0-9]+)/) { my $ver = $1; $rest =~ /change ([0-9]+) ([a-z]+) on ([^ ]+) by ([^ ]+) '(.*)'$/ || die "bad line: $rest";

$currentver = $currentfile->[$ver];

$currentver->{"ver"} = $ver; $currentver->{"change"} = $1; $currentver->{"op"} = $2; $currentver->{"date"} = $3; $currentver->{"who"} = $4; $currentver->{"comment"} = $5; $currentver->{"comment"} =~ s,",\\",g; $currentver->{"interesting"} = $interesting; $interesting = 0;

$currentfile->[$ver] = $currentver; } elsif ($1 eq "...") { $rest =~ /^(([a-z]+) ([a-z]+)|ignored) ([^\#]+)\#([0-9]+)(,\#([0-9]+))?$/ || d ie "bad line: $rest"; my $link; if ($1 eq 'ignored') { $link = [$1, 'noop', $4, $5, $7]; } else { $link = [$2, $3, $4, $5, $7]; } my $links = $currentver->{"links"};

push @files, $4;

$links = [ @$links, $link ];

$currentver->{"links"} = $links; } $db{$depotname} = $currentfile; $done{$depotname} = "done"; } else { die "Unrecognised line $_\n"; }

}

close P4; die "Failed to get file details for $file: $?\n" if $?; }

open VCG, "| xvcg -"; #open VCG, "| cat -";

print VCG "graph: { title: \"versions\" display_edge_labels: yes late_edge_label s: yes fine_tuning: yes edge.priority: 10 arrowmode: free straight_phase: yes \ n";

my $order = 1;

foreach $f (keys %db) { my $vers = $db{$f}; my ($prev, $style);

foreach $v (@$vers) { next if !defined $v; my $links = $v->{"links"}; next if (!defined $links && $v->{"op"} !~ /add|delete/ && !$v->{"interesting"}) ;

my $nodename = "$f#$v->{\"ver\"}";

print VCG "node: { title: \"$nodename\" label: \"$f\@$v->{\"change\"}\\n$v->{\" op\"}: $v->{\"comment\"}\" } \n"; print VCG "edge: { sourcename: \"$prev\" targetname: \"$nodename\" linestyle: $ style }\n" if $prev;

if ($links) { for $l (@$links) { my $style; my $pri = 5; my $colour = "black"; my $arrow = ""; next if $l->[1] eq "from";

my $target = "$l->[2]#";

if (defined $l->[4]) { $target .= $l->[4]; } else { $target .= $l->[3]; } if ($l->[1] eq 'noop') { $style = "dotted"; $arrow = "arrowstyle: none"; } elsif ($l->[0] eq 'branch') { $style = "solid"; $colour = "blue"; } elsif ($l->[0] eq 'merge' || $l->[0] eq 'copy') { $style = "dotted"; $colour = "blue"; $arrow = "arrowstyle: line"; } else { $style = "solid"; }

# print VCG "edge: { sourcename: \"$nodename\" targetname: \"$target\" label: \"$l->[0]\" linestyle: $style priority: $pri color: $colour }\n"; print VCG "nearedge: { sourcename: \"$nodename\" targetname: \"$target\" $arro w linestyle: $style priority: $pri color: $colour }\n"; } } $prev = $nodename; $style = ($v->{"op"} eq "delete") ? "invisible" : "solid"; } $order++; }

print VCG "}\n";

close VCG;

---_=XFMail.1.2.p0.Linux:980320142700:11679=_-- End of MIME message