eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
  & eval 'exec perl -S $0 $argv:q'
  if 0;
#  THE PRECEEDING STUFF EXECS perl via $PATH
#
# $Id: //guest/sandy_currier/utils/p4vtree.pl#2 $
#

#
# Copyright (c) 2000, Sandy Currier (sandy@releng.com)
# Distributed under the GNU GENERAL PUBLIC LICENSE:
#
#      This program is free software; you can redistribute it and/or modify
#      it under the terms of the GNU General Public License as published by
#      the Free Software Foundation; either version 1, or (at your option)
#      any later version.
#
#      This program is distributed in the hope that it will be useful,
#      but WITHOUT ANY WARRANTY; without even the implied warranty of
#      MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#      GNU General Public License for more details.
#
#      You should have received a copy of the GNU General Public License
#      along with this program; if not, write to the Free Software Foundation,
#      Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
#

#
# Unbuffer STDERR and STDOUT
select(STDERR);
$| = 1;			# Make STDERR be unbuffered.
select(STDOUT);
$| = 1;			# STDOUT too

#
# set up some globals
$ThisCmd = "p4vtree"; # this command name

#
# local variables
$filespecs = "";
$P4 = "p4";
$verbose = 1;
$columns = 80;
# p4 variables passed in...
$filelogswitches = "";
$m = "";

#
# now parse any args
# the usage message (for -h or on error)
$help = "$ThisCmd filespecs
Function:
    $ThisCmd will add label information to a p4 filelog
    command output.  It does it the slow way, so depending
    on the label database, it may take a while.

Args:
    filespecs       A list pf valid filespecs
                      
Switches/Options:
    -h              Prints this help message
    -columns <#>    Will limit the output to # columns
                    (def = $columns)
    -verbose <#>    A verbose level (def = $verbose)
";

#
# parse command line
{
    my($i) = 0;
    while($i <= $#ARGV) {
	# scan for a help switch
	if ($ARGV[$i] =~ /^-h/i) {
	    &DieHelp("", $help);
	}
	# scan for switches
	elsif ($ARGV[$i] =~ /^-n/i) {
	    $printonly = 1;
	    $i++;
	}
	elsif ($ARGV[$i] =~ /^-i/i) {
	    $filelogswitches = "$filelogswitches -i";
	    $i++;
	}
	elsif ($ARGV[$i] =~ /^-l/i) {
	    $filelogswitches = "$filelogswitches -l";
	    $i++;
	}
	elsif ($ARGV[$i] =~ /^-debug/i) {
	    $debug = 1;
	    $i++;
	}
	# scan for variable definitions (-variable value)
	elsif ($ARGV[$i] =~ /^-\w+/ and defined($ARGV[$i+1]) and $ARGV[$i+1] !~ /^-[^-]/) {
	    # NOTE: nt has a difficult time with '=' on a command line...
	    # process any variable value switches
	    my($var) = $ARGV[$i];
	    $var =~ s/^-//;
	    my($value) = $ARGV[$i+1];
	    if (defined $$var) {
		$$var = $value;
	    }
	    else {
		&DieHelp("Unknown parameter '$var'\n", $help);
	    }
	    $i=$i+2;
	}
	# catch unsupported switches
	elsif ($ARGV[$i] =~ /^-/) {
	    &DieHelp("Unsupported switch \"$ARGV[$i]\"\n", $help);
	}
	else {
	    push @filespecs, $ARGV[$i];
	    $i++;
	}
    }
}

#
# fold in $m if defined
if ($m) {
    $filelogswitches = "$filelogswitches -m $m";
}

#
# if debugging, re-arrange variables
if ($debug) {
    $verbose = 2;
}

#
# get a list of labels
{
    my @tmp;
    @tmp = &ExecuteP4Cmd("$P4 labels");
    # if an error is returned, just keep going...
    chomp(@tmp);
    foreach my $label (@tmp) {
	my($content) = $label;
	$label =~ s|^Label (.+) \d\d\d\d/\d\d/\d\d \'.*$|$1|o;
#	push @Labels, $label;
	$Labels{$label} = $content;
    }
}

#
# for each label, create a local hash of the files
{
    my($printhack);
    foreach my $label (keys(%Labels)) {
	foreach my $fs (@filespecs) {
	    my(@output);
	    &PrintRaw(".") if ($verbose);
	    $printhack++;
	    if ($filelogswitches =~ /-i/) {
		# if -i is specified, have no idea what may have been integrated into...
		@output = &ExecuteP4Cmd("$P4 files //...\@$label");
	    }
	    else {
		# if no -i, just use this name
		@output = &ExecuteP4Cmd("$P4 files $fs\@$label");
	    }
	    next if (grep(/ - file\(s\) not in label\.$/, @output));
	    chomp(@{$Files{$label}} = @output);
	}
    }
    &PrintRaw("\n") if ($printhack and $verbose);
}

#
# run the p4 filelog command and collect output (let filelog expand wildcards)
{
    my(@filelog, $currentFile, $currentRev, $printhack);
    my($filespecs);
    foreach my $fs (@filespecs) {
	$filespecs = "\"$fs\"";
    }
    @filelog= &ExecuteP4Cmd("$P4 filelog $filelogswitches $filespecs");
    # if an error - just keep on going
    chomp(@filelog);

    # print it
    foreach my $line (@filelog) {
	my($foo);
	if ($line =~ /^\/\//) {
	    $currentFile = $line;
	    $foo = $line;
	    $foo = substr($foo, 0, $columns) if ($columns > 8);
	    &PrintRaw("$foo\n");
	}
	elsif ($line =~ /^\.\.\. \#(\d+) /) {
	    $currentRev = $1;
	    $foo = $line;
	    $foo = substr($foo, 0, $columns) if ($columns > 8);
	    &PrintRaw("$foo\n");
	    # add label stuff here
	    foreach my $label (sort(keys(%Labels))) {
		my($safestring) = quotemeta("$currentFile#$currentRev");
		if (grep(/^$safestring - /, @{$Files{$label}})) {
		    my($foo) = $Labels{$label};
		    $foo = substr($foo, 0, $columns - 8) if ($columns > 8);
		    &PrintRaw("... ... $foo\n");
		}
	    }
	}
	else {
	    my($foo) = $line;
	    $foo = substr($foo, 0, $columns) if ($columns > 8);
	    &PrintRaw("$foo\n");
	}
    }
}

#
# the end
&TheEnd();

#
# Subroutines
#

sub DieHelp {
    my($str, $help) = @_;
    print STDERR "$err $str\nUsage: $help";
    $Error{'Errors'}++;
    &TheEnd();
}

# should not be called by a server
sub TheEnd {
    my($tmp);
    # exit with the number of errors in the bottom 16 bits
    # and the number of warnings in the top
    # Note: make sure that if things shift off, that error is at least still set
    $tmp |= $Error{'Errors'};
    # explicitly set $! to the explicit value
    # see the documentation on die
    exit($tmp);
}

#
# Note: this will actually execute any command...
# returns the action of the revision of the specified file#revision
sub ExecuteP4Cmd {
    my($script, $verbose, $print_output, $no_error_check, $stream_p) = @_;
    my(@output);
    if ($stream_p) {
	print $stream_p "$vb\n$vb running: $script\n$vb\n" if ($verbose);
    }
    else {
	print STDOUT "$vb\n$vb running: $script\n$vb\n" if ($verbose);
    }
    if (!$Platform{'nt'} and $Platform{'os'} eq "win32") {
	@output = `$script` unless ($printonly);
    }
    else {
	@output = `$script 2>&1` unless ($printonly);
    }
    if ($stream_p) {
	print $stream_p "@output" if ($print_output);
    } else {
	print STDOUT "@output" if ($print_output);
    }
    if (!$no_error_check and $?) {
	# now what - just keep going
	&PrintError("$ThisCmd - something happened with '$script'\n$?", $stream_p);
    }
    return(@output);
}

sub PrintRaw {
    my($text, $stream_p) = @_;
    my($tmp);
    # print and log (maybe)
    if ($stream_p) {
	print $stream_p "$text";
    }
    else {
	print STDOUT "$text";
    }
    $LogOutput = "$LogOutput$text" if (defined($LogOutput));
    return($tmp);
}

sub PrintError {
    my($text, $stream_p) = @_;
    my($tmp);
    # first, increment error count
    $Error{'Errors'}++;
    # make sure $? is set
    $? = 1;
    # prepend with the correct prefix
    $text =~ s/^(.*)$/$err $1/gm;
    # add a \n
    $text = "$text\n";
    # print and log (maybe)
    if ($stream_p) {
	print $stream_p "$text";
    }
    else {
	print STDERR "$text";
    }
    $LogOutput = "$LogOutput$text" if (defined($LogOutput));
    return($tmp);
}

# can handle, somewhat, either # or @...
# Note: the output of a 'p4 change ...' will not be of the form
# ... //depot/main/scm/tests/bar#4 edit
# ... //depot/main/scm/tests/xxx#1 add
# ... //depot/main/scm/tests/zzz#1 add
#
# the output of s 'p4 files ...' will be something like
# //depot/main/scm/tests/foo#4 - edit change 1833 (text)
# try to handle both here...
sub SplitFilename3 {
    my($thing) = @_;
    my($f, $tmp, $r, $a, $d, $junk);
    if ($thing =~ /\#/){
	($f, $tmp) = split('#', $thing);
	$d = "\#";
    }
    elsif ($thing =~ /\@/) {
	($f, $tmp) = split('@', $thing);
	$d = "\@";
    }
    else {
	# hoping that the thing passed in is really a file...
	$f = $thing;
    }
    return($f, $r, $a, $d) unless ($tmp); # if empty $tmp, just return now
    if ($tmp =~ / - /) {
	($r, $a) = split(/ - /, $tmp); # split on the first ' - ' (here's hoping again)
    }
    else {
	# if no ' - ', split on first space...
	($r, $a) = split(/ /, $tmp);
    }
    ($a, $junk) = split(' ', $a); # just use first word
    return($f, $r, $a, $d);
}