#!/usr/local/bin/perl

#
# $Id: //depot/scm/scripts/p4syncit.pl#6 $
#

#
# 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.
#

# first, see if unix or NT or what...
# need a recent version of perl on NT to have win32 module/config stuff
BEGIN: {
    require 5.004;
    unless ($Platform{'os'}) {
	unless ($Platform{'os'} = $^O) {
	    require Config;
	    $Platform{'os'} = $Config::Config{'osname'};
	    $Platform{'os'} = $Config::Config{'osname'}; # compiler warning
	}
    }
    # bottom layer OS specific variables/constants
    if ($Platform{'os'} =~ /cygwin/i) {
	# ugh - a cygwin perl
	$Platform{'os'} = "unix";
	$Platform{'pd'} = '/';
	$Platform{'p4glue'} = "-d `cygpath -aw \${PWD}`";
    }
    elsif ($Platform{'os'}=~/Win/i) {
	#########################
	# win32
	#########################
	if (exists($ENV{'BASH'}) or $ENV{'OSTYPE'} eq "cygwin") {
	    # ugh - a windows perl running in a cygwin environment
	    die "Window's perl not supported under cygwin environment - use [/cc]/usr/local/bin/perl instead\n";
	} else {
	    $Platform{'os'} = "win32";
	    $Platform{'pd'} = '\\';
	}
    } else {
	#########################
	# unix
	#########################
	$Platform{'os'} = "unix";
	$Platform{'pd'} = '/';
    }
}

#
# Unbuffer STDERR and STDOUT
select(STDERR);
$| = 1;			# Make STDERR be unbuffered.
select(STDOUT);
$| = 1;			# STDOUT too so, they can mix.

#
# set up some globals
# Note: assume that the PATH EV is going to be used to find p4
$ThisCmd = "p4mergeit.pl";	# this command name
$P4 = "p4 $Platform{'p4glue'}";	# the p4 command to execute
$vb = ">>>";
$err = "***";
$printonly = 0;
$verbose = 2;
$maxlevel = 128;
$Error{'Errors'} = $Error{'Warnings'} = 0;

#
# local variables
%ClientInfo = ();		# the client object
$rollup = 0;			# weird switch
$plevel = 1;
$i_arg = "";
$d_arg = "";

#
# now parse any args
# the usage message (for -h or on error)
$help = "$ThisCmd <filespec options to p4 integ> [options]
Function:
    $ThisCmd assumes that a client has be sync'ed

    Will execute the specified 'p4 integ ...' command with the -n
    switch set.  Will then parse the output and create a list of changes
    that can be selected.  The default action is to NOT rollup the changes.
    This is the Perforce default selective merge model.

    If the -rollup switch is specified, then dependent changes are rolled
    up.  That is, if you select change 123 and that change includes 120,
    and that change includes 115, then all 3 changes will be selected
    when 123 is selected.  This is model is similar to ClearCase's UCM
    model or Paul Smith's Bay Networks model.

    Care should be taken at all times.

Args:
    <filespec options to p4 integ>
                     Filespec args passed to 'p4 integ' - can be any
                     supported syntax
                      
Switches/Options:
    -h               Prints this help message
    -n               Print only - do not perform the sync
                     In this case, will list changes and files to be
                     integrated.
    -plevel <num>    Sets the prompt level.  (def=$plevel)
                        0 = no prompting whatsoever
                        1 = some prompting
                        2 = lots of prompting
    -rollup          If specified, will roll up dependent changes,
                     effectively pulling in only parts the dependent
                     changes.
    -i               Invoke 'p4 integ' commands with the -i switch
    -d               Invoke 'p4 integ' commands with the -d switch
";

#
# parse command line
{
    my($i);
    my($param) = 0;
    while($i <= $#ARGV) {
	# scan for a help switch
	if ($ARGV[$i] =~ /^-h/i) {
	    &DieHelp("", $help);
	}
	# scan for switches
	elsif ($ARGV[$i] =~ /^-rollup/i) {
	    $rollup = 1;
	    $i++;
	}
	elsif ($ARGV[$i] =~ /^-n/i) {
	    $printonly = 1;
	    $i++;
	}
	elsif ($ARGV[$i] =~ /^-i/i) {
	    $i_arg = "-i";
	    $i++;
	}
	elsif ($ARGV[$i] =~ /^-d/i) {
	    $d_arg = "-d";
	    $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;
	}
	else {
	    # swallow files or a changeset
	    $p4Args = $ARGV[$i];
	    $i++; $param++;
	}
    }
}

#
# make sure that a valid client is selected
{
    my($client_string) = "Client name: ";
    my($root_string) = "Client root: ";
    my($cwd_string) = "Current directory: ";
    my(@tmp, @info);
    @info = &ExecuteP4Cmd("$P4 info", $verbose);
    &TheEnd() if ($?);
    &mychomp(\@info);
    # now get client name
    @tmp = grep(/^$client_string/,@info); # grep out the client name
    $ClientInfo{'clientname'} = &other2unix($tmp[0]);	# transfer to a scalar
    $ClientInfo{'clientname'} =~ s/^$client_string//; # ditch the uninteresting part
    if ($ClientInfo{'clientname'} eq "") {	# check things
	die "$ThisCmd - something wrong - no client name found from p4 info output";
    }
    &PrintMessage("Client name: $ClientInfo{'clientname'}");
    # get the client root
    @tmp = grep(/^$root_string/,@info); # grep out the client name
    $ClientInfo{'clientroot'} = &other2unix($tmp[0]);	# transfer to a scalar
    $ClientInfo{'clientroot'} =~ s/^$root_string//; # ditch the uninteresting part
    if ($ClientInfo{'clientroot'} eq "") {	# check things
	die "$ThisCmd - something wrong - no client name found from p4 info output";
    }
    &PrintMessage("Client root: $ClientInfo{'clientroot'}");
    # get the ClientInfo{'cwd'}
    @tmp = grep(/^$cwd_string/,@info); # grep out the client name
    $ClientInfo{'cwd'} = &other2unix($tmp[0]);	# transfer to a scalar
    $ClientInfo{'cwd'} =~ s/^$cwd_string//; # ditch the uninteresting part
    if ($ClientInfo{'cwd'} eq "") {	# check things
	die "$ThisCmd - something wrong - no cwd found from p4 info output";
    }
    &PrintMessage("cwd        : $ClientInfo{'cwd'}");
}

#
# algorithm:
#    list all revisions of all files that need to be integrated
#    get the list of changes from this list, noting if any are incomplete
#    continued with p4syncit.pl algorithm below (except merging instead
#    of syncing)

#
# retrieve the files and revisions that need merging
{
    my($tmp, @null);
    my($script) = "$P4 integ $i_arg $d_arg -n $p4Args";
    &PrintRaw("$vb Retrieving files that need integrating...");
    @filestobeintegrated = &ExecuteP4Cmd($script);
    &mychomp(\@filestobeintegrated);
    &TheEnd() if ($?);
    $tmp = scalar(@filestobeintegrated);
    &PrintRaw(" found $tmp file(s) to be integrated\n");
    if ($verbose > 1) {
	foreach my $chg (@filestobeintegrated) {
	    &PrintRaw("$chg\n");
	}
    }
    unless ($tmp) {
	&PrintRaw("\n");
	&PrintNote("All files have already been integrated - exiting");
	&TheEnd();
    }
    # cache just the numbers in a hash
    foreach my $thing (@filestobeintegrated) {
	my($file, $name, $target);
	if ($thing =~ /^([^\#]+)\#\d+ - integrate from (\/\/.+)$/o or # normal integrate
	    $thing =~ /^([^\#]+)\#\d+ - branch.sync from (\/\/.+)$/o or # initial branch of an element
	    $thing =~ /^([^\#]+)\#\d+ - sync.integrate from (\/\/.+)$/o) { # the baseless merge crap
	    $target = $1;
	    $name = $file = $2;
	    $name =~ s|\#.*$||;	# remove range
	    $targets{$name} = $target;
	    if (!$name) {
		print "help -$thing\n";
	    }
	    if ($file =~ /\#(\d+),\#(\d+)$/o) {
		my($i);
		$revranges{$name}{'what'} = "$1,$2";
		$revranges{$name}{'range'} = 1;
		for ($i=$1; $i<=$2; $i++) {
		    push @{$revranges{$name}{'vals'}}, $i;
		}
	    } else {
		$file =~ /\#(\d+)$/o;
		$revranges{$name}{'what'} = $1;
		$revranges{$name}{'max'} = 1;
		push @{$revranges{$name}{'vals'}}, $1;
	    }
	} else {
	    &PrintError("Internal error - could not parse output line\n$thing");
	}	
    }

    #
    # with the source files and their revision ranges, determine the changes
    &PrintRaw("$vb Generating changes that need integrating...");
    foreach my $file (sort(keys(%revranges))) {
	&GetFileLog(\%FileLogs, $file);
	foreach my $rev (@{$revranges{$file}{'vals'}}) {
	    my($change) = $FileLogs{$file}{'revmap'}{$rev};
	    push @MIAChanges, $change;
	}
    }
    # unique sort this list...
    if (!scalar(@MIAChanges)) {
	&PrintRaw(" found nothing to integrate\n");
	&TheEnd();
    }
    @MIAChanges = &MergeArrays(\@MIAChanges, \@null);
    $tmp = scalar(@MIAChanges);
    &PrintRaw(" found $tmp change(s) to be integrated\n");
}

#
# the loop over changes block
{
    # prompt for changes
    my($tmp, $list, @output, %users);
    @tmp = sort sortbynumber (@MIAChanges);
    $list = join(',', @tmp);
    @MIAChanges = @tmp; 
    @output = &ExecuteP4Cmd("$P4 changes -s submitted \@$MIAChanges[0],\@$MIAChanges[$#MIAChanges]");
    &mychomp(\@output);
    &PrintMessage("Here is a list of acceptable changes to select from:\n$list");
    foreach my $chg (@output) {
	# print the short change into
	if ($chg =~ /^Change $tmp[$#tmp] /) {
	    # a match
	    pop @tmp;
	    $chg =~ s|\s*$||; # remove trailing spaces
	    $chg =~ /\d\d by (\S+)\s/;
	    $users{$1} = 1;
	    &PrintRaw("$chg\n");
	}
    }
    &PrintMessage("Users:");
    foreach (sort(keys(%users))) {
	&PrintRaw("$_\n");
    }
    
  loop:
    &PrintRaw("\nPlease enter a comma seperated list of change numbers\n");
    &PrintRaw("(q to quit; p#### to print) ");
    $list = <STDIN>;
    &mychomp(\$list);
    &PrintRaw("\n");
    if ($list =~ /^q/) {
	&TheEnd();
    }
    elsif ($list =~ /^[0-9,\s]+$/) {
	# close enough - take it
	$list =~ s|,| |g;
	@UserNumbers = split('\s+', $list);
	$tmp = &CheckChanges(\@UserNumbers, 1);
	goto loop if ($tmp);
    }
    elsif ($list =~ /^p([0-9]+)$/) {
	my($tmp, @tmp);
	$tmp[0] = $1;
	$tmp = &CheckChanges(\@tmp, 1);
	goto loop if ($tmp);
	&GetDescription(\%Descriptions, $tmp[0]);
	foreach my $line (@{$Descriptions{'raw'}{$tmp[0]}}) {
	    &PrintMessage($line);
	}
	goto loop;
    }
    elsif ($list =~ /^p/) {
	my($output);
	# print out the one line changes
	foreach (@MIAChanges) {
	    my($output) = &ExecuteP4Cmd("$P4 changes -s submitted \@$_,\@$_");
	    &PrintRaw($output);
	    $output =~ s|\s*$||; # remove trailing spaces
	    $output =~ /\d\d by (\S+)\s/;
	    $users{$1} = 1;
	}
	# now print users
	$output = "";
	foreach (sort(keys(%users))) {
	    $output = "$output,$_";
	}
	$output =~ s|^,||;
	print "$output\n";
	goto loop;
    }
    else {
	&PrintNote("Invalid input - try just entering change numbers separated by comma's");
	goto loop;
    }
    # at this point, have a valis list of changes
}

#
# algorithm:
#
# 1) first, call &UpdateUserFileInfo which will
#    - get the change description for all supplied changes (cached)
#    - for each file in the change, get the filelog info and baseline version (cached)
#    - generate the %UserFileRevs and %UserFileRevsDups hash
# 2) loop over the files being updated
#    - record all changes for any revision (per file) being sucked in (smartly)
# 3) if anything is incoming, query
# 4) if yes, add those changes to list and goto step 1)
#    Note: this will loop until no more new changes are being sucked in
#

#
# the following hashes are defined above:
#  @MIAChanges       - ordered list of changes after the baseline (fully/partially not in)
#  @UserNumbers      - ordered list of selected changes to add/sync to baseline
#  %UserFileRevs     - {$file}                       = $revision (selected/latest past baseline)
#  %UserFileRevsDups - {$file}{$revision}            = $chg (the missing change)
#  %Descriptions     - {$chg}{$file}                 = $revision (revision in the changelist)
#
# the following hashes are defined below:
#  %FileLogs         - {$file}{$revision}            = $chg (the change for that revision)
#
# do it once, then maybe again, then maybe again...

&UpdateUserFileInfo();

{
    my($filerevcount);
    my(%missingchanges, %allmissingchanges);
    my($list, $changecount, $level, $ans);
    $level = 0;
  transitive_loop:
    $filerevcount = 0;
    $level++;
    if ($level > $maxlevel) {
	&PrintError("Recursion level exceeded max ($maxlevel).  Set it (-maxlevel) higher.");
	&TheEnd();
    }
    # loop over all missing changes that need to be pulled in
    foreach my $file (sort(keys(%UserFileRevs))) {
	&PrintMessage("Inspecting $file");
	# can determine the changes that are missing
	my($i);
	for ($i=$BaseLineRevs{$file}+1; $i<$UserFileRevs{$file}; $i++) {
	    # if here, then this $i rev is being skipped for $file
	    # set the value to the change number
	    # Note: important to skip those eclipsed changes that have already been covered
	    if (!exists($UserFileRevsDups{$file}{$i})) {
		# print if not in %UserFileRevsDups
		if ($i == 1) {
		    &PrintNote("    Overlap on change $FileLogs{$file}{'revmap'}{$i} - new file (add) via rev $i");
		} else {
		    &PrintNote("    OverLap on change $FileLogs{$file}{'revmap'}{$i} - new file (edit) via rev $i");
		}
		$missingchanges{$FileLogs{$file}{'revmap'}{$i}} = 1;
		$allmissingchanges{$FileLogs{$file}{'revmap'}{$i}} = 1;
		$filerevcount++;
	    }
	}
    }
    # now print and so something
    $list = join(',', sort sortbynumber (keys(%missingchanges)));
    $changecount = scalar(keys(%missingchanges));
    if ($changecount) {
	my($ans);
	&PrintMessage("Overlapping change summary for all files:\n    $list\n");
      loop2:

	# if rollup, walk the list and add all dependencies
	if ($plevel >= 2) {
	    &PrintRaw("Found $filerevcount file and $changecount change overlap(s)!\n");
	    if ($rollup) {
		&PrintRaw("Continue? (q to quit, y to proceed, changenumber to describe) [y] ");
	    }
	    else {
		&PrintRaw("No rollup has been specified - continue and ignore possible\n");
		&PrintRaw("incomplete changes? [y] ");
	    }
	    $ans = <STDIN>;
	    &mychomp(\$ans);
	    &PrintRaw("\n");
	}
	if ($ans =~ /^q/) {
	    &TheEnd();
	}
	elsif (!$rollup and ($ans eq "" or $ans =~ /^y/i)) {
	    # continue on anyway
	}
	elsif ($ans eq "" or $ans =~ /^y/i) {
	    # continue
	    # now pull in all the dependent changes by adjusting:
	    #  1) @UserNumbers - so to record all incoming changes
	    foreach my $foo (keys(%missingchanges)) {
		push @UserNumbers, $foo;
	    }
	    # sort it
	    @UserNumbers = &SortNumerically(@UserNumbers);
	    #  2) %UserFileRevs and %UserFileRevsDups with the additional changes
	    &UpdateUserFileInfo();
	    #  3) undef %missingchanges so to be able to loop again
	    undef %missingchanges;
	    # 4) do it until done
	    goto transitive_loop;
	}
	elsif ($ans =~ /^([0-9]+)$/ or $ans =~ /^p([0-9]+)$/) {
	    my($tmp, @tmp);
	    $tmp[0] = $1;
	    $tmp = &CheckChanges(\@tmp, 1);
	    goto loop2 if ($tmp);
	    &GetDescription(\%Descriptions, $tmp[0]);
	    foreach my $line (@{$Descriptions{'raw'}{$tmp[0]}}) {
		&PrintMessage($line);
	    }
	    goto loop2;
	}
	else {
	    goto loop2;
	}
    }
    else {
	if ($plevel >= 1) {
	    my($ans);
	  loop3:
	    $list = join(',', sort sortbynumber (keys(%allmissingchanges)));
	    $changecount = scalar(keys(%allmissingchanges));
	    if ($changecount) {
		&PrintMessage("Overlapping change summary for all files:\n    $list\n");
		&PrintRaw("Continue? (q to quit, y to proceed, p#### to print) [y] ");
	    }
	    else {
		&PrintRaw("\nFound no overlapping changes - proceed? [y] ");
	    }
	    $ans = <STDIN>;
	    &mychomp(\$ans);
	    &PrintRaw("\n");
	    if ($ans =~ /^q/) {
		&TheEnd();
	    }
	    elsif ($ans eq "" or $ans =~ /^y/i) {
		# continue on anyway
	    }
	    elsif ($ans =~ /^[0-9]+$/) {
		my($tmp, @tmp);
		$tmp[0] = $ans;
		$tmp = &CheckChanges(\@tmp, 1);
		goto loop3 if ($tmp);
		&GetDescription(\%Descriptions, $ans);
		foreach my $line (@{$Descriptions{'raw'}{$ans}}) {
		    &PrintMessage($line);
		}
		goto loop3;
	    }
	    else {
		&TheEnd();
	    }
	}
	else {
	    &PrintMessage("Found no more overlapping changes - proceeding");
	}
    }
}

#
# now, merge (preview) files beyond the baseline
&MergeFiles(\%UserFileRevs, \%targets);


#
# the end
&TheEnd();

#
# subroutines (these should come from an include file, but not
# enough time now to set it up)
#

# will merge files
sub MergeFiles {
    my($filerev, $targets) = @_;
    my($string, $cmd);
    if ($printonly) {
	$cmd = "$P4 integ $i_arg $d_arg -n";
    }
    else {
	$cmd = "$P4 integ $i_arg $d_arg";
    }
    foreach my $file (sort(keys(%{$filerev}))) {
	my($src) = "$file\#$$filerev{$file}";
	my($dest) = $$targets{$file};
	my($script) = "$cmd \"$src\" \"$dest\"";
	&ExecuteP4Cmd($script, $verbose, 1);
    }
}

# will loop over all changes and make sure that all descriptions have been filled in
# returns 1 if there were new files, 0 otherwise
sub UpdateUserFileInfo {
    my($new) = 0;
    # reverse the list - guarantees a simple graph
    foreach my $chg (reverse(sort sortbynumber (@UserNumbers))) {
	my($tmp) = &GetDescription(\%Descriptions, $chg);
	if ($tmp) {		# only if new
	    $new++;
	    foreach my $file (sort(keys(%{$Descriptions{$chg}}))) {
		# if this file is the first revision to be hit, record; otherwise, note
		if (!exists($UserFileRevs{$file})) {
		    $UserFileRevs{$file} = $Descriptions{$chg}{$file};
		}
		else {
		    # duplicate - warn
		    &PrintNote("Note: ignoring rev $Descriptions{$chg}{$file} during \@$chg for $file\#$UserFileRevs{$file}") if ($verbose > 1);
		    # but, need to record this for later
		    $UserFileRevsDups{$file}{$Descriptions{$chg}{$file}} = $chg;
		}
		# get the filelog output
		&GetFileLog(\%FileLogs, $file);	# returns it in %FileLog (cached)
		# get the list of already integrated changes
		&GetIntegratedRevs(\%BaseLineRevs, $file); # returns it in %BaseLineRevs (cached)
	    }
	}
    }
    return($new);
}

# returns 1 if new, 0 if existing
sub GetDescription {
    my($hashref, $chg) = @_;
    my($script);
    if (!exists($$hashref{$chg}{'file'})) {
	$script = "$P4 describe -s $chg";
	@{$$hashref{'raw'}{$chg}} = &ExecuteP4Cmd("$script");
	&mychomp(\@{$$hashref{'raw'}{$chg}});
	# see if @output contains a files
	foreach my $line (@{$$hashref{'raw'}{$chg}}) {
	    # if not a valid file line, punt and go to next one
	    next unless ($line =~ /^\.\.\. \/\//);
	    $line =~ s|^\.\.\. ||; # remove beginning text
	    my($file, $revision, $action) = &SplitFilename3($line);
	    $$hashref{$chg}{$file} = $revision;
	}
	return(1);
    }
    return(0);
}

# returns 1 if new, 0 if existing
sub GetIntegratedRevs {
    my($hashref, $file) = @_;
    my($script, @output, $tmp, $rev);
    if (!exists($$hashref{$file})) {
	$script = "$P4 integrated \"$file\"";
	@output = &ExecuteP4Cmd($script);
	&mychomp(\@output);
	if ($output[0] =~ /^error: /i) {
	    # file is being added later
	    $$hashref{$file} = 0;
	}
	else {
	    ($tmp, $rev) = split(/\#/, $output[0], 2);
	    $rev =~ s|^([0-9]+).*$|$1|;
	    $$hashref{$file} = $rev;
	}
	return(1);
    }
    return(0);
}

# returns 1 if new, 0 if existing
sub GetFileLog {
    my($hashref, $file) = @_;
    my($script) = "$P4 filelog \"$file\"";
    if (!exists($$hashref{$file}{'raw'})) {
	@{$$hashref{$file}{'raw'}} = &ExecuteP4Cmd($script);
	&mychomp(\@{$$hashref{$file}{'raw'}});
	# hash it
	foreach my $line (@{$$hashref{$file}{'raw'}}) {
	    next unless ($line =~ /^\.\.\. \#/o);
	    $line =~ /^\.\.\. \#([0-9]+) change ([0-9]+) /o;
	    $$hashref{$file}{'revmap'}{$1} = $2;
	}
	return(1);
    }
    return(0);
}

sub CheckChanges {
    my($arrayref, $error_p) = @_;
    my(@badchanges);
    foreach my $chg (@{$arrayref}) {
	if (!grep(/^$chg$/, @MIAChanges)) {
	    push @badchanges, $chg;
	}
    }
    if (scalar(@badchanges)) {
	my($list) = join(',', (sort sortbynumber (@badchanges)));
	&PrintError("The following specified changes cannot be added:\n$list") if ($error_p);
	return(1);
    }
    return(0);
}

# will convert a random OS delimited pathname to a perl pathname
sub other2unix {
    my($filename) = @_;
    my($pattern) = $Platform{'pd'};
    $pattern =~ s/(\W)/\\$1/g;	# escape wildchars
    $filename =~ s|$pattern|/|g;
    return("/") if ($filename =~ /^\/+$/); # if just /+, return just /
    if ($filename =~ /^\/\//) {
	# add them back in later
	$filename =~ s|/+|/|g;	# remove doubles
	$filename = "/$filename";
    }
    else {
	$filename =~ s|/+|/|g;	# remove doubles
    }
    # remove trailing
    $filename =~ s|/+$||;
    return($filename);
}

sub DieHelp {
    my($str, $help) = @_;
    print STDOUT "$err $str\nUsage: $help";
    exit(2);
}

#
# 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 running: $script\n" if ($verbose);
    }
    else {
	print STDOUT "$vb running: $script\n" if ($verbose);
    }
    if (!$Platform{'nt'} and $Platform{'os'} eq "win32") {
	@output = `$script`;
    }
    else {
	@output = `$script 2>&1`;
    }
    if ($stream_p) {
	if ($print_output) {
	    foreach my $line (@output) {
		print $stream_p $line;
	    }
	}
    } else {
	if ($print_output) {
	    foreach my $line (@output) {
		print STDOUT $line;
	    }
	}
    }
    if (!$no_error_check and $?) {
	# now what - just keep going
	&PrintError("$ThisCmd - something happened with '$script'\n$?", $stream_p);
    }
    return(@output);
}

# 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);
}

# should not be called by a server
sub TheEnd {
    my($tmp);
    print STDOUT "$err exiting with $Error{'Errors'} Error(s) & $Error{'Warnings'} Warning(s)\n";
    # 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{'Warnings'} << 16;
    $tmp |= $Error{'Errors'};
    # explicitly set $! to the explicit value
    # see the documentation on die
    exit($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;
    # store error away
    push(@{$Error{'ErrorSummary'}}, $text);
    # add a \n
    $text = "$text\n";
    # print and log (maybe)
    if ($stream_p) {
	print $stream_p "$text";
    }
    else {
	print STDOUT "$text";
    }
    return($tmp);
}

# will increment $Error{'Warnings'} and append $err to every line
sub PrintWarning {
    my($text, $stream_p) = @_;
    my($tmp);
    # first, increment warning count
    $Error{'Warnings'}++;
    # prepend with the correct prefix
    $text =~ s/^(.*)$/$err $1/gm;
    # store error away
    push(@{$Error{'WarningSummary'}}, $text);
    # add a \n
    $text = "$text\n";
    # print and log (maybe)
    if ($stream_p) {
	print $stream_p "$text";
    }
    else {
	print STDOUT "$text";
    }
    return($tmp);
}

# will append $vb to every line
sub PrintMessage {
    my($text, $stream_p) = @_;
    my($tmp);
    # prepend with the correct prefix
    $text =~ s/^(.*)$/$vb $1/gm;
    # add a \n
    $text = "$text\n";
    # print and log (maybe)
    if ($verbose) {
	if ($stream_p) {
	    print $stream_p "$text";
	}
	else {
	    print STDOUT "$text";
	}
    }
    return($tmp);
}

# will append $err to every line (but not set or increment any error variables)
sub PrintNote {
    my($text, $stream_p) = @_;
    my($tmp);
    # 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 STDOUT "$text";
    }
    return($tmp);
}

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

sub SortNumerically {
    my(@array) = @_;
    return(sort sortbynumber @array);
}

sub sortbynumber {
    my($tmpa) = $a;
    my($tmpb) = $b;
    $tmpa <=> $tmpb;
}

sub min {
    my($a, $b) = @_;
    return($a) if ($a <= $b);
    return($b);
}

# something to chew windows and unix trailings off
sub mychomp{
    my($ptr) = @_;
    if (ref($ptr) eq "ARRAY") {
	foreach my $s (@$ptr) {
	    $s =~ s|[\n\r]*$||;
	}
    }
    elsif (ref($ptr) eq "SCALAR") {
	$$ptr =~ s|[\n\r]*$||;
    }
    else {
	die "internal error - unknown reference to mychomp\n";
    }
    return;
}

# uniquely merge two lists (comma separated) and order the result
# Note: typeofsort can be nil, "patchname"
sub MergeArrays {
    my($aref, $bref, $typeofsort) = @_;
    my(@foo, %out);
    return("") if (scalar(@{$aref}) == 0 && scalar(@{$bref}) == 0); # even if one list is nil, sort the other...
    if (scalar(@{$aref})) {
	foreach $foo (@{$aref}) {
	    $out{$foo} = 1;
	}
    }
    if (scalar(@{$bref})) {
	foreach $foo (@{$bref}) {
	    $out{$foo} = 1;
	}
    }
    # select a type of sort
    if ($typeofsort eq "number") { # a number sort
	@foo = sort sortbynumber (keys(%out));
    }
    else {			# a normal sort
	@foo = sort(keys(%out));
    }
    return(@foo);
}    

sub HandleSystemErrors {
    if ($? & 127) {
	# signal - stop
	&PrintError("Aborting on user interrupt\n$?");
	exit(1);
    }
    if ($? & 128) {
	# dumped core
	&PrintError("Error: dumped core - aborting\n$!");
	exit(-1);
    }
    if ($? >> 8) {
	# normal build error
	return(1);
    }
    return(0);
}