#!/usr/bin/perl -w
# -*- perl -*-
use GD ;
use P4CGI;
use strict ;
use Math::Trig;
#
#################################################################
# CONFIGURATION INFORMATION
# All config info should be in P4CGI.pm
#
#################################################################
#
# P4 Branch/Merge Grapher
#
#################################################################
my $FONT; # defaults to variables sizes based on graph size if undefined
#######
# Parameters:
#
######
$| = 1 ;
#
# Get parameter(s)
#
my $FSPC = &P4CGI::cgi()->param("FSPC");
&P4CGI::bail("No file specified") unless defined $FSPC ;
my $TYPE = &P4CGI::cgi()->param("TYPE");
$TYPE = "html" unless defined $TYPE;
my $COMPACT = &P4CGI::cgi()->param("COMPACT");
$COMPACT = "no" unless defined $COMPACT;
my @filelog;
my %filerev;
my %filename;
my %fileuser;
my %filechange;
my %filefromfile;
my %filefromfile2;
my %fileboxid;
my %filecol;
my %fileaction;
my %filefromaction;
my %filemaxrev;
my %fileminrev;
my %otherfiles;
my @boxids = (0);
my %filetofile;
&P4CGI::p4call(\@filelog,"filelog \"$FSPC\"") ;
&P4CGI::bail("No data for file \"$FSPC\"") if @filelog == 0;
my $log;
my $idx;
my $boxid = 1;
my $col = 1;
$filecol{$FSPC} = $col;
$col++;
my $lastlog;
for ($log = shift @filelog; defined $log; $log = shift @filelog)
{
$_ = &P4CGI::fixSpecChar($log) ;
if (/^\.\.\. \#(\d+) \S+ (\d+) (\S+) on (\S+) by (\S*)@(\S*) (\S*)\s*'(.*)'/ )
{
$filemaxrev{$FSPC} = $1 unless defined $filemaxrev{$FSPC};
if ($COMPACT eq "yes" && defined $lastlog)
{
# trash the last $idx info
undef $filerev{$idx};
undef $filename{$idx};
undef $fileuser{$idx};
undef $filechange{$idx};
undef $fileaction{$idx};
undef $fileboxid{$idx};
undef $filefromfile{$idx};
undef $filefromfile2{$idx};
undef $filefromaction{$idx};
pop(@boxids);
$boxid--;
}
$lastlog = $_;
$idx = $FSPC . "\#" . $1;
$filerev{$idx} = $1;
$filename{$idx} = $FSPC;
$fileuser{$idx} = $5;
$filechange{$idx} = $2;
$fileaction{$idx} = $3;
$fileboxid{$idx} = $boxid;
push(@boxids, $idx);
$boxid++;
}
elsif (/^\.\.\. \.\.\. (copy|merge|delete|branch|edit) from ([^#]+)\#(\d+),\#(\d+)$/)
{
undef $lastlog;
&P4CGI::bail("no file?!?") unless defined $idx;
$filefromfile{$idx} = $2 . "\#" . $4;
$filefromfile2{$idx} = $2 . "\#" . $3;
$filefromaction{$idx} = $1;
$otherfiles{$2} = 1;
}
elsif (/^\.\.\. \.\.\. (copy|merge|delete|branch|edit) from ([^#]+)\#(\d+)$/)
{
undef $lastlog;
&P4CGI::bail("no file?!?") unless defined $idx;
$filefromfile{$idx} = $2 . "\#" . $3;
$filefromaction{$idx} = $1;
$otherfiles{$2} = 1;
}
elsif (/^\.\.\. \.\.\. (add|copy|merge|delete|branch|edit) into ([^#]+)\#(\d+)$/)
{
undef $lastlog;
&P4CGI::bail("no file?!?") unless defined $idx;
$filetofile{$idx} = 1;
$otherfiles{$2} = 1;
}
}
if ($COMPACT eq "yes" && defined $lastlog)
{
# trash the last $idx info
undef $filerev{$idx};
undef $filename{$idx};
undef $fileuser{$idx};
undef $filechange{$idx};
undef $fileaction{$idx};
undef $fileboxid{$idx};
undef $filefromfile{$idx};
undef $filefromfile2{$idx};
undef $filefromaction{$idx};
pop(@boxids);
$boxid--;
}
if (defined $filemaxrev{$FSPC})
{
my $rev;
for ($rev = 1; $rev < $filemaxrev{$FSPC}; $rev++)
{
last if (defined $filename{$FSPC . "\#" . $rev});
}
$fileminrev{$FSPC} = $rev;
}
my $file;
my @otherfiles = keys(%otherfiles);
sub isotherfile
{
my $infile = $_[0];
return 1 if ($infile eq $FSPC);
foreach (@otherfiles)
{
return 1 if ($infile eq $_);
}
return 0;
}
undef $lastlog;
foreach $file (@otherfiles)
{
&P4CGI::p4call(\@filelog,"filelog \"$file\"") ;
next if @filelog == 0;
$filecol{$file} = $col;
$col++;
undef $idx;
foreach $log (@filelog)
{
$_ = &P4CGI::fixSpecChar($log) ;
if (/^\.\.\. \#(\d+) \S+ (\d+) (\S+) on (\S+) by (\S*)@(\S*) (\S*)\s*'(.*)'/ )
{
$filemaxrev{$file} = $1 unless defined $filemaxrev{$file};
if ($COMPACT eq "yes" && defined $lastlog)
{
# trash the last $idx info
undef $filerev{$idx};
undef $filename{$idx};
undef $fileuser{$idx};
undef $filechange{$idx};
undef $fileaction{$idx};
undef $fileboxid{$idx};
undef $filefromfile{$idx};
undef $filefromfile2{$idx};
undef $filefromaction{$idx};
pop(@boxids);
$boxid--;
}
$lastlog = $_;
$idx = $file . "\#" . $1;
$filerev{$idx} = $1;
$filename{$idx} = $file;
$fileuser{$idx} = $5;
$filechange{$idx} = $2;
$fileaction{$idx} = $3;
$fileboxid{$idx} = $boxid;
push(@boxids, $idx);
$boxid++;
}
elsif (/^\.\.\. \.\.\. (copy|merge|delete|branch|edit) from ([^#]+)\#(\d+),\#(\d+)/)
{
if (isotherfile($2))
{
undef $lastlog;
&P4CGI::bail("no file?!?") unless defined $idx;
$filefromfile{$idx} = $2 . "\#" . $4;
$filefromfile2{$idx} = $2 . "\#" . $3;
$filefromaction{$idx} = $1;
}
}
elsif (/^\.\.\. \.\.\. (copy|merge|delete|branch|edit) from ([^#]+)\#(\d+)/)
{
if (isotherfile($2))
{
undef $lastlog;
&P4CGI::bail("no file?!?") unless defined $idx;
$filefromfile{$idx} = $2 . "\#" . $3;
$filefromaction{$idx} = $1;
}
}
elsif (/^\.\.\. \.\.\. (add|copy|merge|delete|branch|edit) into ([^#]+)\#(\d+)$/)
{
if (isotherfile($2))
{
undef $lastlog;
&P4CGI::bail("no file?!?") unless defined $idx;
$filetofile{$idx} = 1;
}
}
}
if ($COMPACT eq "yes" && defined $lastlog)
{
# trash the last $idx info
undef $filerev{$idx};
undef $filename{$idx};
undef $fileuser{$idx};
undef $filechange{$idx};
undef $fileaction{$idx};
undef $fileboxid{$idx};
undef $filefromfile{$idx};
undef $filefromfile2{$idx};
undef $filefromaction{$idx};
pop(@boxids);
$boxid--;
}
# determine minrev
if (defined $filemaxrev{$file})
{
my $rev;
for ($rev = 1; $rev < $filemaxrev{$file}; $rev++)
{
last if (defined $filename{$file . "\#" . $rev});
}
$fileminrev{$file} = $rev;
}
}
# Now that we have the history of the main file, and any close files that are one branch away,
# we need to figure out where the arrows are...
my @arrows;
my $i;
for ($i = 1; defined $boxids[$i]; $i++)
{
$idx = $boxids[$i];
if (defined $filefromfile2{$idx} &&
defined $filefromfile{$idx})
{
my $file = $filefromfile{$idx};
my $file2 = $filefromfile2{$idx};
my $action = $filefromaction{$idx};
my $from = $fileboxid{$file} if defined $action;
my $from2 = $fileboxid{$file2} if defined $from;
if (defined $from2)
{
push(@arrows, "$action $from2,$from->$i");
}
elsif (defined $from)
{
push(@arrows, "$action $from->$i");
}
next;
}
if (defined $filefromfile{$idx})
{
my $file = $filefromfile{$idx};
my $action = $filefromaction{$idx};
my $from = $fileboxid{$file} if defined $action;
push(@arrows, "$action $from->$i") if defined $from;
next;
}
}
my @revarrows;
for ($i = 1; defined $boxids[$i]; $i++)
{
$idx = $boxids[$i];
my $rev = $filerev{$idx} + 1;
my $nextrev = $rev;
$file = $filename{$idx};
while ($rev <= $filemaxrev{$file})
{
my $filespec = $file . "\#" . $rev;
if (defined $fileboxid{$filespec})
{
my $to = $fileboxid{$filespec};
if (defined $to)
{
if ($rev == $nextrev)
{
push(@revarrows, "$i->$to");
}
else
{
push(@revarrows, "dot $i->$to");
}
}
last;
}
$rev += 1;
}
}
# determine height of each box based on change
my @changes = sort { $a <=> $b } values %filechange;
my $last = 0;
my $height = 1;
my %changetoheight;
foreach (@changes)
{
next if ($_ == $last);
$last = $_;
$changetoheight{$last} = $height;
$height++;
}
unless (defined $FONT)
{
if ($col < 8) # arbitrary cutoff
{
$FONT = gdMediumBoldFont;
}
elsif ($col < 12) # arbitrary cutoff
{
$FONT = gdSmallFont;
}
else
{
$FONT = gdTinyFont;
}
}
# THESE SHOULD BE EVEN NUMBERS!
my $BOXHEIGHT = $FONT->height * 2 + 6;
my $BOXWIDTH = $FONT->width * 10; # for clXXXXXX with two spaces
my $BOXVSPACE = $FONT->height * 2;
my $BOXHSPACE = $BOXWIDTH / 2;
# returns the centerpoint of the box
sub boxtoxy
{
my $box = $_[0];
my $idx = $boxids[$box];
my $h = $changetoheight{$filechange{$idx}};
my $c = $filecol{$filename{$idx}};
my $x = (($BOXHSPACE + $BOXWIDTH) * $c) - ($BOXWIDTH / 2);
my $y = (($BOXVSPACE + $BOXHEIGHT) * $h) - ($BOXHEIGHT / 2);
return ($x, $y);
}
sub boxrect
{
my ($x, $y) = boxtoxy($_[0]);
$x -= $BOXWIDTH / 2;
$y -= $BOXHEIGHT / 2;
my $x1 = $x + $BOXWIDTH;
my $y1 = $y + $BOXHEIGHT;
return ($x, $y, $x1, $y1);
}
sub nwcorner
{
my ($x, $y) = boxtoxy($_[0]);
$x -= $BOXWIDTH / 2;
$y -= $BOXHEIGHT / 2;
return ($x, $y);
}
sub necorner
{
my ($x, $y) = boxtoxy($_[0]);
$x += $BOXWIDTH / 2;
$y -= $BOXHEIGHT / 2;
return ($x, $y);
}
sub swcorner
{
my ($x, $y) = boxtoxy($_[0]);
$x -= $BOXWIDTH / 2;
$y += $BOXHEIGHT / 2;
return ($x, $y);
}
sub secorner
{
my ($x, $y) = boxtoxy($_[0]);
$x += $BOXWIDTH / 2;
$y += $BOXHEIGHT / 2;
return ($x, $y);
}
sub centertop
{
my ($x, $y) = boxtoxy($_[0]);
$y -= $BOXHEIGHT / 2;
return ($x, $y);
}
sub centerbottom
{
my ($x, $y) = boxtoxy($_[0]);
$y += $BOXHEIGHT / 2;
return ($x, $y);
}
sub centerright
{
my ($x, $y) = boxtoxy($_[0]);
$x += $BOXWIDTH / 2;
return ($x, $y);
}
sub centerleft
{
my ($x, $y) = boxtoxy($_[0]);
$x -= $BOXWIDTH / 2;
return ($x, $y);
}
sub imagesize
{
my ($x, $y);
# $col and $height are one more than the number of columns/height
$x = ($BOXWIDTH + $BOXHSPACE) * $col - $BOXWIDTH;
$y = ($BOXHEIGHT + $BOXVSPACE) * $height - $BOXHEIGHT;
return ($x, $y);
}
# not sure where I got this from... by I didn't write it... P4DB?/p4pr?
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);
}
#create image or do the HTML page
my ($x, $y);
my $image;
my $white;
my $blue;
my $green;
my $black;
my $red;
if ($TYPE eq "html")
{
# start the HTML page
my @legendList;
push @legendList,
"Click on the changelist (cln) to view the changelist description.",
"Click on the file revision (\#n) to view the file.",
"A box with a red X indicates the file was deleted.",
"The title over each column represents the branch name. Click on the title to view the graph from the point of view of that file.",
"Green arrows indicate a revision change. Click on a green arrow to view the diffs between revisions. A dashed green arrow indicates hidden revisions.",
"Solid red arrows indicate a branch.",
"Dashed red arrows indicate a merge.";
if ($COMPACT eq "no")
{
push @legendList, &P4CGI::ahref("-url", "branchGraph.cgi",
"FSPC=$FSPC",
"COMPACT=yes",
"Compact") . " -- hide revisions that do not branch/merge";
}
else
{
push @legendList, &P4CGI::ahref("-url", "branchGraph.cgi",
"FSPC=$FSPC",
"COMPACT=no",
"Expand") . " -- show all revisions";
}
my $legend = &P4CGI::ul_list(@legendList);
print "",&P4CGI::start_page("Branch Relationships
$FSPC", $legend);
print "\n";
print "\n", &P4CGI::end_page() ;
}
else
{
print "Content-type: image/png\n\n";
binmode STDOUT;
print $image->png();
}
## tada