#!/usr/local/bin/perl
#
# $Id: //depot/scm/scripts/p4syncit.pl#7 $
#
#
# 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 = "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;
}