#!/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 @filelog;
my %filerev;
my %filename;
my %fileuser;
my %filechange;
my %filefromfile;
my %fileboxid;
my %filecol;
my %fileaction;
my %filefromaction;
my %otherfiles;
my @boxids = (0);
&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++;
for ($log = shift @filelog; defined $log; $log = shift @filelog)
{
$_ = &P4CGI::fixSpecChar($log) ;
if (/^\.\.\. \#(\d+) \S+ (\d+) (\S+) on (\S+) by (\S*)@(\S*) (\S*)\s*'(.*)'/ )
{
$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+)$/)
{
&P4CGI::bail("no file?!?") unless defined $idx;
$filefromfile{$idx} = $2 . "\#" . $4;
$filefromaction{$idx} = $1;
$otherfiles{$2} = 1;
}
elsif (/^\.\.\. \.\.\. (copy|merge|delete|branch|edit) from ([^#]+)\#(\d+)$/)
{
&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+)$/)
{
&P4CGI::bail("no file?!?") unless defined $idx;
$otherfiles{$2} = 1;
}
}
my $file;
my @otherfiles = keys(%otherfiles);
for ($file = shift @otherfiles; defined $file; $file = shift @otherfiles)
{
&P4CGI::p4call(\@filelog,"filelog \"$file\"") ;
next if @filelog == 0;
$filecol{$file} = $col;
$col++;
undef $idx;
for ($log = shift @filelog; defined $log; $log = shift @filelog)
{
$_ = &P4CGI::fixSpecChar($log) ;
if (/^\.\.\. \#(\d+) \S+ (\d+) (\S+) on (\S+) by (\S*)@(\S*) (\S*)\s*'(.*)'/ )
{
$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+)/)
{
&P4CGI::bail("no file?!?") unless defined $idx;
$filefromfile{$idx} = $2 . "\#" . $4;
$filefromaction{$idx} = $1;
}
elsif (/^\.\.\. \.\.\. (copy|merge|delete|branch|edit) from ([^#]+)\#(\d+)/)
{
&P4CGI::bail("no file?!?") unless defined $idx;
$filefromfile{$idx} = $2 . "\#" . $3;
$filefromaction{$idx} = $1;
}
}
}
# 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 $filefromfile{$idx})
{
my $file = $filefromfile{$idx};
my $action = $filefromaction{$idx} if defined $file;
my $from = $fileboxid{$file} if defined $action;
push(@arrows, "$action $from->$i") if defined $from;
}
}
my @revarrows;
for ($i = 1; defined $boxids[$i]; $i++)
{
$idx = $boxids[$i];
my $rev = $filerev{$idx} + 1;
$file = $filename{$idx};
my $filespec = $file . "\#" . $rev;
if (defined $fileboxid{$filespec})
{
my $to = $fileboxid{$filespec};
push(@revarrows, "$i->$to") if defined $to;
}
}
# 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 $legend = &P4CGI::ul_list("Each box represents a revision (\#n) and changelist (cln) of a file. Click on a box to view the changelist description. 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.",
"Solid green arrows indicate a revision change. Click on a green arrow to view the diffs between revisions.",
"Solid red arrows indicate a branch.",
"Dashed red arrows indicate a merge.");
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