#!/usr/bin/perl 

# Print a version tree of a Perforce controlled file
#
# Usage: p4tree files...
#
# 1997-1999 Jeremy Fitzhardinge <jeremy@goop.org>
#
# $Id: //depot/perforce/p4tree#7 $

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@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;
    
    $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->{"type"} = $5;
		$currentver->{"comment"} = $6;
		$currentver->{"comment"} =~ s/"/\\"/g;

		$currentfile->[$ver] = $currentver;
	    } elsif ($1 eq "...") {
		$rest =~ /^([a-z]+) ([a-z]+) ([^\#]+)\#([0-9]+)(,\#([0-9]+))?$/ || die "bad line: $rest";
		my $link = [$1, $2, $3, $4, $6];
		my $links = $currentver->{"links"};

		push @files, $3;

		$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_labels: 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|branch/);

	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->[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\" $arrow linestyle: $style priority: $pri color: $colour }\n";
	    }
	}
	$prev = $nodename;
	$style = ($v->{"op"} eq "delete") ? "invisible" : "solid";
    }
    $order++;
}

print VCG "}\n";

close VCG;