#!/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 (<font color=\"blue\">\#<i>n</i></font>) and changelist (<font color=\"blue\">cl<i>n</i></font>) of a file. Click on a box to view the changelist description. A box with a red <font color=\"red\">X</font> indicates the file was deleted.",
				 "The <b>title</b> over each column represents the branch name. Click on the <b>title</b> to view the graph from the point of view of that file.",
				 "<font color=\"\#007F00\">Solid green arrows indicate a revision change. Click on a green arrow to view the diffs between revisions.</font>",
				 "<font color=\"red\">Solid red arrows indicate a branch.</font>",
				 "<font color=\"red\">Dashed red arrows indicate a merge.</font>");

    print "",&P4CGI::start_page("Branch Relationships<br>$FSPC", $legend);

    print "<img src=\"branchGraph.cgi?FSPC=$FSPC&TYPE=branches.png\" usemap=\"\#branch\">\n";
    print "<map name=\"branch\">\n";
}
else
{
    ($x, $y) = imagesize();
    my $minx = (length($FSPC) * $FONT->width) + ($BOXHSPACE * 2);
    if ($x < $minx)
    {
	$x = $minx;
    }
    $image = GD::Image->new($x, $y) || die;
    my $gray = $image->colorAllocate(0xF0, 0xF0, 0xF0);
    $image->fill(1, 1, $gray);
    $white = $image->colorAllocate(255, 255, 255); 
    $blue = $image->colorAllocate(0, 0, 255);
    $green = $image->colorAllocate(0, 127, 0);
    $black = $image->colorAllocate(0, 0, 0);
    $red = $image->colorAllocate(255, 0, 0);
}

# draw the rev arrows
foreach (@revarrows)
{
    if (/(\d+)-&gt;(\d+)/)
    {
	my ($from, $to) = ($1, $2);
	my ($x1, $y1) = centerbottom($from);
	my ($x2, $y2) = centertop($to);
	if ($TYPE eq "html")
	{
	    $idx = $boxids[$to];
	    $x1 -= $FONT->width;
	    $x2 += $FONT->width;
	    print "<area shape=\"rect\" coords=\"$x1, $y1, $x2, $y2\" href=\"fileDiffView.cgi?FSPC=$filename{$idx}&REV=$filerev{$idx}&ACT=$fileaction{$idx}\">\n";
	}
	else
	{
	    $image->line($x1, $y1, $x2, $y2, $green);
	    my $h = $FONT->width;
	    my $poly = new GD::Polygon;
	    $poly->addPt($x2, $y2);
	    $poly->addPt($x2 - $h, $y2 - $h*2);
	    $poly->addPt($x2 + $h, $y2 - $h*2);
	    $image->filledPolygon($poly, $green);
	}
    }
}

# draw the arrows
if ($TYPE ne "html")
{
    foreach (@arrows)
    {
	my ($from, $to);
	my ($x1, $y1);
	my ($x2, $y2);
	if (/(add|branch) (\d+)-&gt;(\d+)/)
	{
	    ($from, $to) = ($2, $3);
	    ($x1, $y1) = boxtoxy($from);
	    ($x2, $y2) = boxtoxy($to);
	    if ($x1 < $x2)
	    {
		($x1, $y1) = centerright($from);
		($x2, $y2) = nwcorner($to);
	    }
	    else
	    {
		($x1, $y1) = centerleft($from);
		($x2, $y2) = necorner($to);
	    }
	    #($x2, $y2) = centertop($to);
	    $image->line($x1, $y1, $x2, $y2, $red);

	}
	elsif (/(\S+) (\d+)-&gt;(\d+)/)
	{
	    ($from, $to) = ($2, $3);
	    ($x1, $y1) = boxtoxy($from);
	    ($x2, $y2) = boxtoxy($to);
	    if ($x1 < $x2)
	    {
		($x1, $y1) = centerright($from);
		($x2, $y2) = centerleft($to);
	    }
	    else
	    {
		($x1, $y1) = centerleft($from);
		($x2, $y2) = centerright($to);
	    }
	    $image->dashedLine($x1, $y1, $x2, $y2, $red);
	}
	if (defined $from)
	{
	    my $h = $FONT->width;
	    my $poly = new GD::Polygon;
	    my $angle = atan2 ($y2 - $y1, $x2 - $x1) - pi() / 2;

	    $poly->addPt(0, 0);
	    my $c = cos($angle);
	    my $s = sin($angle);
	    $x1 = $c * (-$h) - $s * (-$h * 2);
	    $y1 = $s * (-$h) + $c * (-$h * 2);
	    $poly->addPt($x1, $y1);
	    $x1 = $c * $h - $s * (-$h * 2);
	    $y1 = $s * $h + $c * (-$h * 2);
	    $poly->addPt($x1, $y1);

	    $poly->offset($x2, $y2);
	    
	    $image->filledPolygon($poly, $red);
	    
	}
    }
}
# draw the boxes & text

for ($i = 1; defined $boxids[$i]; $i++)
{
    my ($x1, $y1, $x2, $y2) = boxrect($i);
    $idx = $boxids[$i];
    if ($TYPE eq "html")
    {
	print "<area shape=\"rect\" coords=\"$x1, $y1, $x2, $y2\" href=\"changeView.cgi?CH=$filechange{$idx}\">\n";
    }
    else
    {
	$image->rectangle($x1 +1, $y1 +1, $x2 + 1, $y2 +1, $black);
	$image->rectangle($x1 +2, $y1 +2, $x2 + 2, $y2 +2, $black);
	$image->filledRectangle($x1, $y1, $x2, $y2, $white);
	$image->rectangle($x1, $y1, $x2, $y2, $black);
	my $rev = "\#" . $filerev{$idx};
	my $halflen = (length($rev) * $FONT->width) / 2;
	my ($x, $y) = boxtoxy($i);
	$image->string($FONT, $x - $halflen, $y1 + 2, $rev, $blue);
	my $change = "cl" . $filechange{$idx};
	$halflen = (length($change) * $FONT->width) / 2;
	$image->string($FONT, $x - $halflen, $y1 + $FONT->height + 4, $change, $blue);

	# cross out deleted files
	if ($fileaction{$idx} eq "delete")
	{
	    $image->line($x1, $y1, $x2, $y2, $red);
	    $image->line($x1, $y2, $x2, $y1, $red);
	}
    }
    if ($filerev{$idx} == 1)
    {
	# display branch name
	my $name;
	if ($FSPC eq $filename{$idx})
	{
	    $name = $FSPC;
	    # display centered above the box
	    my $halflen = (length($name) * $FONT->width) / 2;
	    my ($x, $y) = boxtoxy($i);
	    $y = $y1 - ($FONT->height + 2);
	    $x -= $x1;
	    if ($TYPE eq "html")
	    {
		$y2 = $y + $FONT->height;
		$x2 = $x + length ($name) * $FONT->width;
		print "<area shape=\"rect\" coords=\"$x, $y, $x2, $y2\" href=\"branchGraph.cgi?FSPC=$name\" alt=\"$name\">\n";
	    }
	    else
	    {
		$image->string($FONT, $x, $y, $name, $black);
	    }
	}
	else
	{
	    $name = find_branch_part($FSPC, $filename{$idx});
	    # display centered above the box
	    my $halflen = (length($name) * $FONT->width) / 2;
	    my ($x, $y) = boxtoxy($i);
	    $y = $y1 - ($FONT->height + 2);
	    $x -= $halflen;
	    if ($TYPE eq "html")
	    {
		$y2 = $y + $FONT->height;
		$x2 = $x + $halflen * 2;
		print "<area shape=\"rect\" coords=\"$x, $y, $x2, $y2\" href=\"branchGraph.cgi?FSPC=$filename{$idx}\" alt=\"$filename{$idx}\">\n";
	    }
	    else
	    {
		$image->string($FONT, $x,$y, $name, $black);
	    }

	}
    }
}

# draw the arrows
if ($TYPE eq "html")
{
    print "</map>\n", &P4CGI::end_page() ;
}
else
{
    print "Content-type: image/png\n\n";
    binmode STDOUT;
    
    print $image->png();
}

## tada