#!/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";
}