#! /usr/bin/env perl
# branches.pl
########################################################################

########################################################################
# PERL PRAGMAS
#
use strict;
use warnings;
#
########################################################################

########################################################################
# PERL MODULES
#
use Getopt::Long;
use File::Basename;
#
########################################################################

########################################################################
# CONSTANTS
#
*COUNTER = \100000;
    our $COUNTER;
$| = 1;
*P4_ROOT_DEFAULT = \"//...";
    our $P4_ROOT_DEFAULT;
*P4_CMD_DEFAULT = \"p4";
    our $P4_CMD_DEFAULT;
#
########################################################################

########################################################################
# USAGE
our $USAGE =<<USAGE;
    @{[basename($0)]} [-u <p4User>] [-p <p4Port>] [-P <p4Pass>] 
        [-trunk <trunk>...] -cmd [<p4>] [<files...>]
    @{[basename($0)]} -h

    where:
	<p4User>: Perforce User ID. Default is to use current
	          environment.
	<p4Port>: Perforce port to use. Default is to use current
	          environment.
	<p4Pass>: Perforce password. Default is to use the current
	          user and active P4 Ticket.
	<trunk>:  Trunk branch of Source Tree. Multiple "trunks" are
	          permitted. To do this, use multiple "-trunk"
		  parameters. If "-trunk" is not specified, program
		  will attempt to derive the trunk branches.
	<files>:  The starting point in the Perforce Depot tree.
	          Default is "$P4_ROOT_DEFAULT".
	-help:    Prints out this message.
USAGE
#
########################################################################

########################################################################
# COMMAND LINE OPTIONS
#
my (@trunkList, $p4, $helpFlag, $p4User, $p4Port, $p4Passwd, $p4Root);
GetOptions(
    "trunk=s" => \@trunkList,
    "cmd=s"   => \$p4,
    "u=s"     => \$p4User,
    "p=s"     => \$p4Port,
    "P=s"     => \$p4Passwd,
    "help"    => \$helpFlag) or
    die "$USAGE\n";

$p4Root = shift;

if ($helpFlag) {
    print "$USAGE\n";
    exit 0;
}

$p4Root =       $P4_ROOT_DEFAULT   unless ($p4Root);
$p4     =       $P4_CMD_DEFAULT    unless ($p4);

$p4 .= " -u $p4User"   if ($p4User);
$p4 .= " -p $p4Port"   if ($p4Port);
$p4 .= " -P $p4Passwd" if ($p4Passwd);
#
########################################################################

########################################################################
# READ THROUGH INTEGRATION COMMAND
#
open (INTEGRATE, qq($p4 -ztag integrated "$p4Root"|)) or
    die qq(Can't run command "p4 integrated"\n);

my %branchHash;
my %intRecHash;
my $counter = 0;	#Clicks every $COUNTER times
while (<INTEGRATE>) {
    $counter++;
    if (($counter % $COUNTER) == 0) {
	print ".";
    }
    chomp;
    if(/^\.\.\./) {
	/^\.\.\.\s+([^ ]+)\s(.+)$/;  #... <field> <Value>
	$intRecHash{$1} = "$2";		# $intRec{<field>} = <Value>
    } else {
	if ($intRecHash{"how"} ne "branch from") {
	    undef %intRecHash;
	    next;
	}
	my $change = $intRecHash{"change"};
	#
	# Python Programmers: Eat your heart out!
	#
	# We are going to mash together the strings $fromFile and
	# toFile with an XOR operation. The matching characters
	# will be x00 bytes.
	#
	# I then match against /^(\x00*)/, and $1 will be the matching
	# part of the prefix. Taking the length of this will give
	# me the number of characters which match which I can then
	# remove from the strings. Next, I do the same for the suffix
	# by using the "reverse" function. The end result is the non-
	# matching portion of the strings, or the names of the
	# branches.

	($intRecHash{"fromFile"} ^ $intRecHash{"toFile"}) =~ /^(\x00*)/;
	my $prefixLen = length($1);
	(reverse($intRecHash{"fromFile"}) ^ reverse($intRecHash{"toFile"}))
	    =~ /^(\0*)/;
	my $suffixLen = length($1);

	# Okay, it isn't all skiddles and beer at this point. We've
	# got a problem if $fromBranch is "//Foo/BAR-3.4/" and $toBranch
	# is "//Foo/BAR-3.5/". The match is too good because the
	# actual match would be "//Foo/BAR-3." and we would believe
	# that the from branch is "4" and to branch is "5".
	#
	# So, the above really returns the MAXIMUM possible prefix
	# (and suffix). What we need to do is backoff to the last
	# directory slash. That is, instead of the prefix being
	# "//Foo/BAR-3.", it would be "//Foo/". Fortunately, the
	# normal "greedy" behavior of regular expressions is very
	# helpful in this situation. We'll just match what was
	# returned above to the last directory slash, and that's
	# our prefix (and suffix).

	substr($intRecHash{"fromFile"}, 0, $prefixLen) =~ /^(.*\/)/;
	$prefixLen = length($1);

	substr(reverse($intRecHash{"fromFile"}), 0, $suffixLen) =~ /^(.*\/)/;
	$suffixLen = length($1);

	# Now, we have the actual prefix and suffix of the branch
	# names!
	
	my $fromBranch =
	    substr($intRecHash{"fromFile"}, $prefixLen, -$suffixLen);
	my $toBranch =
	    substr($intRecHash{"toFile"}, $prefixLen, -$suffixLen);

	# In some circumstances, there is no from and to branches.
	# Skip these problems.

	unless ($fromBranch and $toBranch) {
	    undef %intRecHash;
	    next;
	}

	# We need to prevent recursion. What I do is track the
	# changelist numbers. If I find a FOO_BRANCH->BAR_BRANCH
	# record, I check to see if I also have a BAR_BRANCH->FOO_BRANCH
	# record. If I do, I then see which one was done first via
	# changelist number. I then delete the one with the higher
	# changelist from my %branchHash. That way, I only have
	# the initial direction of the branch.

	# 
	# Skip if $fromBranch->$toBranch exists and has lower change #
	# 

	if (($branchHash{"$fromBranch"}->{"$toBranch"}) and
	    ($branchHash{"$fromBranch"}->{"$toBranch"} < $change)) {
	    undef %intRecHash;
	    next;
	}

	#
	# No $fromBranch->$toBranch. Is there a $toBranch->$fromBranch?
	#

	if ($branchHash{"$toBranch"}->{"$fromBranch"}) {

	#
	# There's a $toBranch->$fromBranch. Which came first?
	# The $toBranch->$fromBranch or the $fromBranch->$toBranch?
	#
	    if ($branchHash{"$toBranch"}->{"$fromBranch"} > $change) {

	#
	# $fromBranch->$toBranch is before $toBranch-$fromBranch
	# Delete $toBranch->$fromBranch Record and save the
	# $fromBranch->$toBranch record
	#
		delete($branchHash{"$toBranch"}->{$fromBranch});
		$branchHash{"$fromBranch"}->{"$toBranch"} = $change;
	    } else {

	#
	# $toBranch->$fromBranch came before $fromBranch->$toBranch.
	# Don't do anything
	#
		undef %intRecHash;
	    }
	} else {
	#
	# There is no $toBranch->$fromBranch record. Add the
	# $fromBranch->$toBranch record.
	# 
	    $branchHash{"$fromBranch"}->{"$toBranch"} = $change;
	    undef %intRecHash;
	}
    }
}
print "\n";
#
########################################################################

########################################################################
# FIND ALL "TRUNK" BRANCHES
#
# Trunk branches are branches that are only "From Branch" and never
# a "To Branch".
#

unless (@trunkList) {
    my %trunkBranchHash;
    foreach my $key (sort(keys(%branchHash))) {
	$trunkBranchHash{$key} = 1;
    }

#
# Prune the $trunkBranchHash
#
    foreach my $fromBranch (sort(keys(%branchHash))) {
	foreach my $toBranch (sort(keys(%{$branchHash{$fromBranch}}))) {
	    delete($trunkBranchHash{"$toBranch"})
		if (exists($trunkBranchHash{"$fromBranch"}));
	}
    }

#
# Convert to List
#

    @trunkList = (sort(keys(%trunkBranchHash)));
}

########################################################################
# NOW LIST ALL BRANCHES
#
foreach my $trunk (@trunkList) {
    printStruct($branchHash{"$trunk"}, "$trunk", 0);
}
#
########################################################################

########################################################################
# SUB PRINT STRUCT
#
sub printStruct {
    my $hashRef = shift;
    my $branchName = shift;
    my $level = shift;
    print "    " x $level . "$branchName\n";
    foreach my $key (sort(keys(%{$hashRef}))) {
	printStruct($branchHash{"$key"}, $key, $level+1);
    }
}
#
########################################################################