p4syncit.pl #1

  • //
  • guest/
  • hb_nguyen/
  • utils/
  • p4syncit.pl
  • View
  • Commits
  • Open Download .zip Download (28 KB)
#!/usr/local/bin/perl

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

#
# Copyright (c) 2000, Sandy Currier ([email protected])
# 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 = "p4syncit.pl";	# this command name
$P4 = "p4 $Platform{'p4glue'}";	# the p4 command to execute
$vb = ">>>";
$err = "***";
$printonly = 0;
$verbose = 1;
$maxlevel = 128;
$sync = "sync";			# whether to sync or flush
$Error{'Errors'} = $Error{'Warnings'} = 0;

#
# local variables
%ClientInfo = ();		# the client object
@UserNumbers = ();		# the list of UserNumbers
$norollup = 0;			# weird switch
$filespec = "//...";
$plevel = 1;

#
# now parse any args
# the usage message (for -h or on error)
$help = "$ThisCmd [change# ...] [-norollup] [-plevel <num>]
Function:
    $ThisCmd assumes that a client has be sync'ed to some time consistant
    slice of the respository (like a change number or a timerule).

    From the sync'ed changenumber, if no changes are supplied, a list of
    available changes not yet sync'ed will be offered for selection.

    Once a list of changes has been supplied, $ThisCmd will datamine
    perforce to determine if any other changes need to be rolled up to
    have a properly sync'ed client (if the -norollup switch is not set).

    If there are such changes, the user will be prompted whether or not
    to proceed.  

    $ThisCmd will then rollup the changes (unless -norollup has been
    specified) and sync those files.

    In all cases, the latest version of any given file across all incoming
    changes, even if catalogued by multiple changes, will be used.

Args:
    changelist ...   One or more comma separated changelist
                     numbers.  $ThisCmd will flag an error if the
                     changelist does not exist between the
                     baseline and the head.
                      
Switches/Options:
    -h               Prints this help message
    -n               Print only - do not perform the sync
    -plevel <num>    Sets the prompt level.  (def=$plevel)
                        0 = no prompting whatsoever
                        1 = some prompting
                        2 = lots of prompting
    -norollup        If specified, will not roll up dependent
                     changes (effectively pulling in only parts
                     the dependent changes)
    -filespec        Will limit the inspection to a given depot
                     syntax file spec.  (def=$filespec)
";

#
# 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] =~ /^-norollup/i) {
	    $norollup = 1;
	    $i++;
	}
	elsif ($ARGV[$i] =~ /^-n/i) {
	    $printonly = 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);
	}
	elsif ($ARGV[$1] =~ /^[0-9]+$/) {
	    # swallow files or a changeset
	    push(@UserNumbers, $ARGV[$i]);
	    $i++; $param++;
	}
	else {
	    &DieHelp("Only numbers are valid change arguments -  \"$ARGV[$i]\"\n", $help);
	}
    }
}

#
# 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:
#  verify that the client is time-consistant
#  list the changes that are not in the baseline: p4 changes //...$maxchange,#head
#  if @Changes is specified
#    check: fail if not valid
#  else
#    print changes; read input; loop, or fail, or continue
#
# algorithm continued below
#    

#
# determine the max change
{
    my($output);
    my($script) = "$P4 changes -s submitted -m1 \"$filespec#have\"";
    &PrintMessage("Running: $script") if ($verbose);
    $output = `$script`; # ignore errors
    ($maxchange = $output) =~ s/^Change ([0-9]+) .*$/$1/;
    &mychomp(\$maxchange);
    if ($maxchange eq "" or $maxchange == 0) {
	&PrintError("$err No valid max change\n$output");
	exit 1;
    }
}

#
# verify that the client is time consistant
{
    my($count, $minchange, $list);
    #
    # get the output of the p4 files command...
    # Note: the -C switch returns files mapped to the client, which
    # usually includes deleted files.  The -H will not return deleted files - this
    # is what is needed since it is better to ignore deleted files here
    my($script) = "$P4 fstat -s -H \"$filespec\@$maxchange\"";
    # the perforce screw - only change/time does the right thing here
    #$script = "$P4 fstat -s -C $filespec\#have,#head";
    &PrintMessage("Running: $script") if ($verbose);
    if (!open(OUTPUT, "$script|")) {
	&PrintError("Could not execute '$script'\n$!");
	exit 1;
    }
    else {
	my($depotFile, $headRev, $haveRev);
	while (<OUTPUT>) {
	    &mychomp(\$_);
	    # parse a line and hash it
	    if (/^\.\.\. depotFile (.+)$/) {
		$depotFile = $1;
	    }
	    elsif (/^\.\.\. headRev (.+)$/) {
		$headRev = $1;
	    }
	    elsif (/^\.\.\. haveRev (.+)$/) {
		$haveRev = $1;
	    }
	    elsif ($_ eq "") {
		# end of file - process it
		if ($headRev != $haveRev) {
		    # not cross consistant
		    my($out) = sprintf "(have=%3d, \@$maxchange=%3d) $depotFile", $haveRev, $headRev;
		    &PrintError($out);
		    $havefiles{$depotFile} = $haveRev;
		    $headfiles{$depotFile} = $headRev;
		    $count++;
		}
		$depotFile = $headRev = $haveRev = "";
	    }
	}
	close(OUTPUT);
    }

    #
    # now loop over files to find smallest change
#    $minchange = $maxchange;
    foreach my $file (sort(keys(%havefiles))) {
	&GetFileLog(\%FileLogs, $file);	# returns it in %FileLog (cached)
# this gives the last change in a file, not the real maximum time consistance
# change in the filespec...
#	$minchange = &min($minchange, $FileLogs{$file}{'revmap'}{$havefiles{$file}});
	my($i);
	for ($i=$havefiles{$file}+1; $i<=$headfiles{$file}; $i++) {
	    $missingchanges{$FileLogs{$file}{'revmap'}{$i}} = 1;
	}
    }

    #
    # here is a list of the incomplete changes
    foreach my $chg (sort sortbynumber (keys(%missingchanges))) {
	$list = "$list,$chg";
    }
    $list =~ s|^,||;
    $minchange = $list;
    $minchange =~ s|(^[0-9]+).*$|$1|;
    $minchange-- if ($minchange > 0);

    #
    # possibly the end
    if ($count) {
	&PrintMessage("Summary: found $count inconsistant file(s)") if ($verbose);
	&PrintMessage("            maxchange: $maxchange") if ($verbose);
	&PrintMessage("max consistant change: $minchange") if ($verbose);
	&PrintMessage("   incomplete changes: $list") if ($verbose and $list);
	&PrintError("Erroring and exiting due to the above errors...");
	exit(1);
    }
}


#
# retrieve the changes that can be specified
{
    my($tmp);
    my($script) = "$P4 changes -s submitted \"$filespec\@$maxchange,#head\"";
    &PrintRaw("Retrieving missing changes...");
    @MIAChanges = &ExecuteP4Cmd($script);
    &mychomp(\@MIAChanges);
    &TheEnd() if ($?);
    # the above will always return the head change
    pop @MIAChanges;
    $tmp = scalar(@MIAChanges);
    &PrintRaw(" found $tmp missing change(s)\n");
    unless ($tmp) {
	&PrintRaw("\n");
	&PrintNote("All changes are already in the baseline - exiting");
	&TheEnd();
    }
    # cache just the numbers in a hash
    foreach my $chg (@MIAChanges) {
	my($number) = $chg;
	$number =~ s|^Change ([0-9]+) .*$|$1|;
	$MIANumbers{$number} = $chg;
    }
}

#
# if changes are specified, check
if (scalar(@UserNumbers)) {
    my($tmp) = &CheckChanges(\@UserNumbers, 1);
    if ($tmp) {
	my($list) = join(',', (sort sortbynumber (keys(%MIANumbers))));
	&PrintError("Here is a list of acceptable changes:\n$list");
	&TheEnd();
    }
}
else {
    # prompt for changes
    my($tmp, $list);
    $list = join(',', (sort sortbynumber (keys(%MIANumbers))));
    &PrintMessage("Here is a list of acceptable changes to select from:\n$list");
  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;
    }
    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
#  %MIANumbers       - {$chg}                        = the full single-line change description
#  %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)
#  %BaseLineRevs     - {$file}                       = $revision (for the baseline version)
#
# 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 ($norollup) {
		&PrintRaw("No rollup has been specified - continue and ignore possible\n");
		&PrintRaw("incomplete changes? [y] ");
	    }
	    else {
		&PrintRaw("Continue? (q to quit, y to proceed, changenumber to describe) [y] ");
	    }
	    $ans = <STDIN>;
	    &mychomp(\$ans);
	    &PrintRaw("\n");
	}
	if ($ans =~ /^q/) {
	    &TheEnd();
	}
	elsif ($norollup 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, sync (preview) files beyond the baseline
&SyncFiles(\%UserFileRevs);


#
# the end
&TheEnd();

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

# will sync a bunch of explcit files wrapping as much as possible into
# a single sync command
sub SyncFiles {
    my($filerev) = @_;
    my($stringlimit) = 255;
    my($string, $cmd);
    if ($printonly) {
	$cmd = "$P4 $sync -n";
    }
    else {
	$cmd = "$P4 $sync";
    }
    foreach my $file (sort(keys(%{$filerev}))) {
	my($filename) = "$file\#$$filerev{$file}";
	if (length("$cmd \"$filename\"") + 1 > $stringlimit) {
	    &PrintError("Command line exceeds command line length limit\n$cmd \"$filename\"");
	    &TheEnd();
	}
	if (length("$cmd $string \"$filename\"") + 1 > $stringlimit) {
	    # too big, run command now
	    my($script) = "$cmd $string";
	    &ExecuteP4Cmd($script, $verbose, 1);
	    # start string over
	    $string = "\"$filename\"";
	}
	else {
	    # add this filename since it fits
	    $string = "$string \"$filename\"";
	}
    }
    # see if there is any string left
    if ($string) {
	my($script) = "$cmd $string";
	&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 revision at the baseline if not defined yet
		&GetBaseLineRev(\%BaseLineRevs, $maxchange, $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 GetBaseLineRev {
    my($hashref, $maxchange, $file) = @_;
    my($script, @output, $tmp, $rev);
    if (!exists($$hashref{$file})) {
	$script = "$P4 -s files \"$file\@$maxchange\"";
	@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 (!exists($MIANumbers{$chg})) {
	    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;
}
# Change User Description Committed
#1 2338 HB Nguyen Integ from other guest
//guest/sandy_currier/utils/p4syncit.pl
#3 912 sandy_currier these versions should all be xtext only
#2 911 sandy_currier beta versions that may actually hobble along...
#1 548 sandy_currier updating various versions of these scripts