#!/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"; } 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 (/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 "\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 "\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; print "\n"; $y1 += $BOXHEIGHT / 2; $y2 += $BOXHEIGHT / 2; print "\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 = "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} == $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 "\"$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 "\"$filename{$idx}\"\n"; } else { $image->string($FONT, $x,$y, $name, $black); } } } } # draw the arrows if ($TYPE eq "html") { print "\n", &P4CGI::end_page() ; } else { print "Content-type: image/png\n\n"; binmode STDOUT; print $image->png(); } ## tada