#!/bin/sh
# Not every host installs perl at the same location, handle many locations:
PATH=/usr/xtensa/stools-5.0/bin:/usr/bin:/usr/local/bin:$PATH
exec perl -x -S $0 ${1+"$@"}
exit $?
#!perl -w
#line 8
# p4view -- View complete branching graph of a file
# Copyright (c) 2000-2005, Tensilica Inc.
# All rights reserved.
#
# Redistribution and use, with or without modification, are permitted provided
# that the following conditions are met:
#
# - Redistributions must retain the above copyright notice, this list of
# conditions, and the following disclaimer.
#
# - Modified software must be plainly marked as such, so as not to be
# misrepresented as being the original software.
#
# - Neither the names of the copyright holders or their contributors, nor
# any of their trademarks, may be used to endorse or promote products or
# services derived from this software without specific prior written
# permission.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
# See `p4view -h` for usage info.
#
# History:
# 2005-APR-12 1.4 marc Update copyright/license notice.
# 2004-MAY-07 1.3 marc ...
# 2001-SEP-17 1.2 marc Add -p option to set path to specific p4 client
# 2001-APR-02 1.1 marc Add a bit more help info (output format legends)
# 2000-JUN-19 1.0 marc Initial version
$progvers = "1.4";
$progname = "p4view";
$p4prog = "p4";
my $scriptdir = $0;
$scriptdir =~ s|[/\\][^/\\]+$||; # strip script name, leaving only dirname
push @INC, $scriptdir;
require p4lib;
p4getinfo();
# Get arguments:
$showall = 0;
$v1 = $v2 = 0;
$v2 = $v1; # just to keep perl -w quiet
$noedits = 0;
@args = ();
while( defined($_ = shift) ) {
if( /^-v$/ ) { # show skipped files
$verbose = 1;
next;
}
if( /^-(v[1-2])$/ ) { # show various info
${$1} = 1;
next;
}
if( /^-a$/ ) { # show all (offshoot) files
$showall = 1;
next;
}
if( /^-p$/ ) { # set p4 client path
$p4prog = shift;
next;
}
if( /^-ne$/ ) { # skip display of edit-only revs
$noedits = 1;
next;
}
# if( /^-c$/ ) { # specify changenum
# if( !defined($_ = shift) ) {
# print STDERR "$progname: missing changelist number/name after -c\n";
# usage();
# exit 1;
# }
# $revertchg = "-c $_ ";
# next;
# }
if( /^-(h|help|\-h|\-help|\?)$/i ) {
usage();
exit 0;
}
if( /^-/ ) {
print STDERR "$progname: unrecognized option '$_'\n";
usage();
exit 1;
}
push(@args, $_);
}
# Execute listing:
if( @args == 0 ) {
usage();
exit 1;
}
foreach (@args) {
p4view($_);
}
exit 0; # done!
sub usage {
print <<"__END__";
p4view v$progvers -- view branching graph of a Perforce file.
Usage: p4view [-a] [-v] <filepath> [...]
where:
-a show all files (include files branched from but not to <filepath>)
-ne skip display of edit-only revisions
-v display comments beyond first line (for actual changes only)
-v1 display filelog parsing...
-v2 display reordering optimization...
Horizontal (integration) lines legend:
====== copied: file copied from another (exactly as-is)
'''''' ignored: nothing copied at all (contents of source file ignored)
++++++ merged: merging occurred with contents from other/source file
------ deleted: propagation of file deletion
/.../ integration from right to left
\\...\\ integration from left to right
Vertical (revision history) lines legend:
' before 1st rev
| between revs
. after last/head rev (if not deleted)
(blank) after file deleted (can be between revs if re-added or -branched)
__END__
} #'
# Return "cost" index that reflects the amount of branching cross-overs
# displayed for a given ordering of the file branches.
# This is used by p4view() to minimize cross-overs (makes displays
# easier to read).
#
sub branch_order_cost {
my($ordref,$matref) = @_;
my @order = @$ordref;
#my @matrix = @$matref;
my $cost = 0;
foreach my $i (0 .. $#order) {
my $ordi = $order[$i];
foreach my $j (0 .. $#order) {
my $ordj = $order[$j];
my $dist = abs($ordj - $ordi);
my $entry = $matref->[$i][$j];
$cost += $dist * ($dist + 3) * $entry if defined($entry);
#print "Matrix($i,$j) = $entry .\n" if defined($entry);
}
}
$cost;
}
# Return "cost" index that reflects the amount of branching cross-overs
# displayed for a given ordering of the file branches.
# This is used by p4view() to minimize cross-overs (makes displays
# easier to read).
#
sub branch_order_cost2 {
my($ordref,$matref,$matray) = @_;
my @order = @$ordref;
#my @matrix = @$matref;
my $cost = 0;
foreach my $i (0 .. $#order) {
foreach my $j (0 .. $#order) {
my $dist = abs($j - $i);
my $entry = $matref->[$order[$i]][$order[$j]];
$cost += $dist * ($dist + 3) * $entry if defined($entry);
#print "Matrix($i,$j) = $entry .\n" if defined($entry);
}
}
# my $cost2 = 0;
# foreach my $triplet (@$matray) {
# x
# }
$cost;
}
# Reorder a shuffled list of numbers (0..$#order)
# so that element with value $ordn takes on the value $ord,
# and every number between $ordn and $ord is shifted accordingly.
#
sub reorder {
my($ordn,$ord,@order) = @_;
return @order if $ordn == $ord;
if( $ordn < $ord ) {
return map { $_ == $ordn ? $ord : ($_ > $ordn && $_ <= $ord) ? $_ - 1 : $_ } @order;
} else {
return map { $_ == $ordn ? $ord : ($_ >= $ord && $_ < $ordn) ? $_ + 1 : $_ } @order;
}
}
# Display branching graph for the given file.
#
sub p4view {
my ($args) = @_;
my %filebranches = ();
my @allrevs = ();
# First convert to full path.
# p4 filelog has an apparent bug in that it can't handle
# client pathnames for deleted files or files not in client etc.
#
# my($wherearg) = p4cmdout("where ".p4passpath($args));
# my($depotarg) = split(" //",$wherearg);
my($mapped,$depotarg) = p4where($args);
die "$progname: can't map path '$args'\nStopped" unless $mapped;
# Get filelog of requested file:
#
my @revs = p4filelog($depotarg,0);
$args = $nextpath = shift(@revs); # use full depot path
my @branches = ($args);
# Get filelogs of all files referenced, until none more found
# (ie. until we get a complete graph of files that reference each other):
#
my $n = 1;
while(1) {
$filebranches{$nextpath} = \@revs;
push(@allrevs,@revs);
# Add newly referenced branches:
foreach my $r (@revs) {
my($depotpath, $nn,$revnum,$revchg,$revact,$revdate,$revuser,$revclient,$revtype, $revcomment, $revpaths) = @$r;
foreach my $p (@$revpaths) {
my($from,$baction,$bpath,$brevall,$brevlo,$brevhi) = @$p;
if(!exists($filebranches{$bpath}) and ($showall or $from)) {
push(@branches,$bpath);
$filebranches{$bpath} = 0;
}
}
}
# Get next path for which to get a filelog:
last if $n > $#branches;
$nextpath = $branches[$n++];
@revs = p4filelog($nextpath,scalar @allrevs);
$nextpath = shift(@revs); # use full depot path
}
# Sort branches so as to minimize cross-over branching:
#
# Precompute connectivity matrix:
my %name2index = map { $branches[$_] => $_ } (0 .. $#branches);
my @matrix = ([] x scalar(@branches));
my @totals;
foreach my $r (@allrevs) {
my($depotpath, $nn,$revnum,$revchg,$revact,$revdate,$revuser,$revclient,$revtype, $revcomment, $revpaths) = @$r;
my $revindex = $name2index{$depotpath};
foreach my $p (@$revpaths) {
my($from,$baction,$bpath,$brevall,$brevlo,$brevhi) = @$p;
next unless exists($name2index{$bpath});
my $bindex = $name2index{$bpath};
$matrix[$revindex][$bindex]++;
#$matrix[$bindex][$revindex]++;
$totals[$revindex]++;
$totals[$bindex]++;
}
}
# Matrix is usually sparse, so turn into array of pair,cost:
my @matray = ();
foreach my $i (1 .. $#branches) {
foreach my $j (0 .. $i - 1) {
my $n = 0;
$n += $matrix[$i][$j] if defined($matrix[$i][$j]);
$n += $matrix[$j][$i] if defined($matrix[$j][$i]);
push @matray, [$i, $j, $n] if $n;
}
}
# Choose an initial ordering (this is mostly heuristics!):
#
# Insertion order sort:
my @sort_totals = map { [$_, $totals[$_]] } (0 .. $#branches);
my @sort_order = ();
foreach my $n (0 .. $#branches) {
@sort_totals = sort { $a->[1] <=> $b->[1] } @sort_totals;
my $b1 = $sort_totals[0][0];
foreach my $i (1 .. $#branches - $n) {
my $b2 = $sort_totals[$i][0];
$sort_totals[$i][1] -= $matrix[$b2][$b1] if defined($matrix[$b2][$b1]);
$sort_totals[$i][1] -= $matrix[$b1][$b2] if defined($matrix[$b2][$b1]);
}
push @sort_order, $b1;
print "$b1 ==> ".$sort_totals[0][1].".\n";
$sort_totals[0][1] = 999999999;
}
# Insert into initial ordering per the insertion sort order:
my @brindices = ();
foreach my $n (0 .. $#branches) {
# Try each possible insertion point, choose the least cost one:
my $mincost = 999999999;
my @minidx;
foreach my $i (0 .. $n) {
my @newidx = @brindices;
splice(@newidx, $i, 0, $sort_order[$#branches - $n]);
my $cost = branch_order_cost2(\@newidx, \@matrix, \@matray);
if ($cost < $mincost) {
$mincost = $cost;
@minidx = @newidx;
}
}
@brindices = @minidx;
}
my $heurcost = branch_order_cost2(\@brindices, \@matrix, \@matray);
print "Cost $heurcost with initial sort heuristic ...\n" if $v2;
# :
my @order = (0 .. $#branches); # start with order encountered
my @brind = @brindices;
my $mincost = branch_order_cost(\@order, \@matrix);
my $mincost2 = branch_order_cost2(\@brind, \@matrix, \@matray);
print "Cost $mincost initially ...\n" if $v2;
print "Cost $mincost2 initially ...\n" if $v2;
# Now try to minimize the cost of this ordering:
my $gotbetter = 1;
while( $gotbetter ) {
$gotbetter = 0;
# Try moving each branch (move last one first):
#
foreach my $bni (0 .. $#branches) {
my $bn = $#branches - $bni;
my $brn = $brind[$bn];
my @newbrind = @brind;
splice(@newbrind, $bn, 1);
# Try all positions (except the current one):
#
foreach my $ordi (0 .. $#branches) {
my $ord = $#branches - $ordi;
next if $ord == $order[$bn]; # speed optimization
#my @neworder = reorder($order[$bn],$ord,@order);
my @neworder = reorder($bn,$ord,@order);
my @newbrind2 = @newbrind;
splice(@newbrind2, (($ord > $bn) ? $ord-1 : $ord), 0, $brn);
my $cost = branch_order_cost(\@neworder, \@matrix);
my $cost2 = branch_order_cost2(\@newbrind2, \@matrix, \@matray);
if( $cost2 < $mincost ) {
$mincost = $cost2;
@order = @neworder;
@brind = @newbrind2;
$gotbetter = 1;
print "Cost $cost for ".join(',',@neworder)," ($bn to $ord)\n" if $v2;
print "COST $cost2 for ".join(',',@newbrind2)," ($bn to $ord)\n" if $v2;
} else {
#print " or $cost for ".join(',',@neworder)," ($bn to $ord)\n" if $v2;
}
}
#last if $gotbetter; # (tries to move latter branches, but not very effective, and slow)
} #each branch
}
# Generate hash to convert path to position (0..$#branches):
my %order = map { $branches[$_] => $order[$_] } (0 .. $#branches);
# Inverse order to get branch from position, instead of position from branch:
my @rorder = ();
foreach my $i (@order) {$rorder[$order[$i]] = $i;}
# Display files (typically branches of a file):
#
$n = @branches;
print "Total of $n branches for $args:\n";
(my $subpath = $args) =~ s%^//depot/(main|(rel|dev|user)/[^/]+)/%%;
my $i = 0;
my %bmap = ();
my $bmax = 0;
print " ";
foreach my $k (map {$branches[$_]} @rorder) {
$_ = $k;
s%^//depot/(main|(rel|dev|user)/[^/]+)/\Q$subpath\E$%$1%;
s%^rel/(\d)_%$1.% or s%^dev/([^0-9])%$1%;
s%(\d)_(\d)%$1.$2%g;
$bmap{$k} = $_;
$bmax = length($_) if length($_) > $bmax;
#print " ";
#print "| " x $i, ($k eq $args ? "X" : "+"), "------" x ($n - $i);
print "$_\n";
print " ";
print " | " x $i;
print "", ($k eq $args ? "\\|/" : " | "), " ";
$i++;
}
print "\n";
# Sort all revs by change number (or by order encountered if same change number):
#
@allrevs = sort {sprintf("%09u%07u",${$a}[3],${$a}[1]) <=> sprintf("%09u%07u",${$b}[3],${$b}[1])} @allrevs;
# Display each revision's history:
#
my @lastrev;
my $curline = " ' " x ($#branches+1);
$curline .= "";
foreach my $r (@allrevs) {
my($depotpath, $nn,$revnum,$revchg,$revact,$revdate,$revuser,$revclient,$revtype, $revcomment, $revpaths,$froms,$bouts, $head) = @$r;
my $ord = $order{$depotpath};
# Display from branches:
foreach my $p (@$froms) {
my($from,$baction,$bpath,$brevall,$brevlo,$brevhi) = @$p;
my $pord = $order{$bpath};
if($pord == $ord) {
warn "$progname: $baction on self! ($brevall)";
next;
}
my $dir = ($pord < $ord) ? 1 : -1;
my $slant = ($pord < $ord) ? '\\' : '/';
my $pline = $curline;
my $dash = '='; # default, for copy/branch
$dash = '=' if $baction =~ /^copy|branch/;
$dash = '-' if $baction =~ /^delete/;
$dash = '+' if $baction =~ /^merge/;
$dash = '\'' if $baction =~ /^ignore/;
for(my $i = $pord * 6 + 2 + $dir; $i != $ord * 6 + 2; $i += $dir) {
substr($pline,$i,1) = $dash;
}
substr($pline,$pord*6+2+$dir,1) = $slant;
substr($pline,$ord*6+2-$dir,1) = $slant;
printf "%s ($baction $brevall)\n", $pline;
}
# Skip edit-only revs if so requested:
# !!! skips $lastrev[] update (but no yet used so is okay).
next if $noedits and (scalar @$froms) == 0 and (scalar @$bouts) == 0 and $revact eq "edit" and !$head;
# Display rev line:
my $revline = $curline;
substr($revline,$ord*6,6) = sprintf(" #%-4d", $revnum);
substr($curline,$ord*6+2,1) = ($revact eq "delete") ? ' ' : $head ? '.' : '|';
printf "%s%-9s%8s %s ", $revline, $revact, "@".$revchg, $revdate;
my $com1 = "";
my $com2 = "";
my $comlimit = "";
if( 1 ) {
my $c = $revcomment;
$c =~ s/\n\s*\n/\n/g;
$c =~ s/\t/ /g;
$c =~ s/\n/\n$curline </g;
if( ($revact =~ /integrate|branch/) or !$verbose ) { # don't need much info for these usually
$c =~ s/\n.*/ [...]/s;
$comlimit = ".50";
}
$com1 = " <$c";
$com2 = ">";
}
printf "%${comlimit}s$com2\n", $revuser."@".$revclient.$com1;
$lastrev[$ord] = $r;
#printf "%".$bmax."s #%-4d $revact\n", $bmap{$depotpath}, $revnum;
}
print "(".(scalar @allrevs)." revs total)\n";
}