#!/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 ; my $dp=&P4CGI::CURR_DEPOT_NO() ; # # Get parameter(s) # my $FSPC = &P4CGI::cgi()->param("FSPC"); &P4CGI::bail("No file specified") unless defined $FSPC ; $FSPC = &P4CGI::htmlEncode($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::htmlEncode($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::htmlEncode($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 { if(defined $a and defined $b) { $a <=> $b ; } else { 0 ; } } values %filechange; my $last = 0; my $height = 1; my %changetoheight; foreach (@changes) { next if ( ! defined $_) or ($_ == $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; my @legendList; if ($TYPE eq "html") { # start the HTML page push @legendList, "Click on the changelist (<font color=\"blue\">cl<i>n</i></font>) to view the changelist description.", "Click on the file revision (<font color=\"blue\">\#<i>n</i></font>) to view the file.", "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.<br>Click on the <b>title</b> to view the graph from the point of view of that file.", "<font color=\"\#007F00\">Green arrows indicate a revision change.<br> Click on a green arrow to view the diffs between revisions. A dashed green arrow indicates hidden revisions.</font>", "<font color=\"red\">Solid red arrows indicate a branch.</font>", "<font color=\"red\">Dashed red arrows indicate a merge.</font>"; my @options ; if ($COMPACT eq "no") { push @options, &P4CGI::buttonCell("branchGraph.cgi", "Hide revisions that do not branch/merge", "FSPC=$FSPC", "COMPACT=yes", "Compact graph") ; } else { push @options, &P4CGI::buttonCell("branchGraph.cgi", "Show all revisions", "FSPC=$FSPC", "COMPACT=no", "Expand graph") ; } my $title = "Branch graph for $FSPC" ; print &P4CGI::start_page($title, @options); print &P4CGI::start_framedTable($title) ; print "<img class=\"BranchGraph\" src=\"branchGraph.cgi?DP=$dp;FSPC=$FSPC;COMPACT=$COMPACT;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 $bg = $image->colorAllocate(0xf0, 0xf0, 0xf0); $white = $image->colorAllocate(0xff, 0xff, 0xff); $blue = $image->colorAllocate(0x00, 0x00, 0xff); $green = $image->colorAllocate(0x00, 0x80, 0x00); $black = $image->colorAllocate(0x00, 0x00, 0x00); $red = $image->colorAllocate(0xff, 0x00, 0x00); $image->transparent($bg) ; $image->fill(1, 1, $bg); } # draw the rev arrows foreach (@revarrows) { if (/dot (\d+)->(\d+)/) { my ($from, $to) = ($1, $2); my ($x1, $y1) = centerbottom($from); my ($x2, $y2) = centertop($to); if ($TYPE eq "html") { $idx = $boxids[$from]; my $idx2 = $boxids[$to]; $x1 -= $FONT->width; $x2 += $FONT->width; print "<area class=\"Area\" title=\"View Diff\" shape=\"rect\" coords=\"$x1, $y1, $x2, $y2\" href=\"fileDiffView.cgi?DP=$dp;FSPC=$filename{$idx};REV=$filerev{$idx};ACT=$fileaction{$idx};FSPC2=$filename{$idx2};REV2=$filerev{$idx2}\">\n"; } else { $image->dashedLine($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); } } elsif (/(\d+)->(\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 class=\"Area\" title=\"View Diff\" shape=\"rect\" coords=\"$x1, $y1, $x2, $y2\" href=\"fileDiffView.cgi?DP=$dp;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 ($from2, $from, $to); my ($x1, $y1); my ($x2, $y2); my ($x3, $y3); if (/(add|branch) (\d+)->(\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 (/(add|branch) (\d+),(\d+)->(\d+)/) { ($from2, $from, $to) = ($2, $3, $4); ($x1, $y1) = boxtoxy($from); ($x2, $y2) = boxtoxy($to); if ($x1 < $x2) { ($x1, $y1) = centerright($from); ($x2, $y2) = nwcorner($to); ($x3, $y3) = centerright($from2); } else { ($x1, $y1) = centerleft($from); ($x2, $y2) = necorner($to); ($x3, $y3) = centerleft($from2); } #($x2, $y2) = centertop($to); $image->line($x1, $y1, $x2, $y2, $red); if ($from2 != $from && $filerev{$boxids[$from2]} != 1) { $image->line($x3, $y3, ($x1 + $x2)/2, ($y1 + $y2)/2, $red); } } elsif (/(\S+) (\d+)->(\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); } elsif (/(\S+) (\d+),(\d+)->(\d+)/) { ($from2, $from, $to) = ($2, $3, $4); ($x1, $y1) = boxtoxy($from); ($x2, $y2) = boxtoxy($to); if ($x1 < $x2) { ($x1, $y1) = centerright($from); ($x2, $y2) = centerleft($to); ($x3, $y3) = centerright($from2); } else { ($x1, $y1) = centerleft($from); ($x2, $y2) = centerright($to); ($x3, $y3) = centerleft($from2); } $image->dashedLine($x1, $y1, $x2, $y2, $red); if ($from2 != $from) { my $xc = ($x1 + $x2) / 2; my $yc = ($y1 + $y2) / 2; $image->dashedLine($x3, $y3, $xc, $yc, $red); $image->filledRectangle($xc-2, $yc-2, $xc+2, $yc+2, $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") { $y2 -= $BOXHEIGHT / 2; my ($f,$r) = split('\#',$idx) ; print "<area class=\"Area\" title=\"View File $idx\" shape=\"rect\" coords=\"$x1, $y1, $x2, $y2\" href=\"fileViewer.cgi?DP=$dp;FSPC=$f;REV=$r\">\n"; $y1 += $BOXHEIGHT / 2; $y2 += $BOXHEIGHT / 2; print "<area class=\"Area\" title=\"View Change $filechange{$idx}\" shape=\"rect\" coords=\"$x1, $y1, $x2, $y2\" href=\"changeView.cgi?DP=$dp;CH=$filechange{$idx}\">\n"; $y1 -= $BOXHEIGHT / 2; } 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 = "ch" . $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} == $fileminrev{$filename{$idx}}) { # 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 class=\"Area\" title=\"View Graph for $name\" shape=\"rect\" coords=\"$x, $y, $x2, $y2\" href=\"branchGraph.cgi?DP=$dp;FSPC=$name;COMPACT=$COMPACT\" 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 class=\"Area\" title=\"View Graph for $filename{$idx}\" shape=\"rect\" title=\"View file $filename{$idx}\" coords=\"$x, $y, $x2, $y2\" href=\"branchGraph.cgi?DP=$dp;FSPC=$filename{$idx};COMPACT=$COMPACT\" alt=\"$filename{$idx}\">\n"; } else { $image->string($FONT, $x,$y, $name, $black); } } } } # draw the arrows if ($TYPE eq "html") { print "</map>\n", &P4CGI::end_framedTable(), "<br>", &P4CGI::framedTable("Legend",&P4CGI::ul_list(@legendList)), &P4CGI::end_page() ; } else { print "Content-type: image/png\n\n"; binmode STDOUT; print $image->png(); } ## tada