#!/usr/local/bin/perl
# NOTE: the best algorthm may be, is to list the files
# at the greatest change found in the baseline, then
# list the files via the base line, and diff the revisions
# 3 commands:
# a big 'p4 files //...@<baseline>'
# a small 'p4 changes -m1 //...@<baseline>'
# a big 'p4 files //...@maxchange'
# then just diff the hashes... (better if a fstat -C could be used...)
#
# $Id: //depot/scm/scripts/p4ics.pl#9 $
#
#
# 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.
#
#
# This script will import new, deleted, and edited changes
# from a disconnected p4 client.
#
# Another application is to import incoming changes from a 3rd
# party not using perforce.
#
#
# This is just a coded version of Technical Note #2
#
# 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'};
}
}
# 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}`";
# nasty thing here - caution advised
$/ = "\r\n";
}
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 globale
# Note: assume that the PATH EV is going to be used to find p4
$P4 = "p4 $Platform{'p4glue'}"; # the p4 command to execute
$ThisCmd = "p4ics.pl"; # this command name
$maxchange = ""; # the output of the p4 changes command
$filespec = ""; # the filespec arg
$client = "";
$vb = ">>>";
$err = "***";
$output = "";
$count = 0;
$verbose = 1;
#
# now parse any args
# the usage message (for -h or on error)
$help = "$ThisCmd [filespec] [client] [options...]
Function:
This command accepts a perforce client and filespec (WITHOUT a
revision range but with wildcards) and will return a list of
files that are inconsistant with the max changenumber found via
the filespec. Basically, this command wraps the
'p4 -c client changes -m1 arg1' and 'p4 -c client fstat -H arg1'
perforce commands and datamines the result.
Args:
filespec Optional filespec. Defaults to '//...'.
client Optional client name. Defaults to current client.
Switches/Options:
-h Prints this help message
";
# parse command line
{
my($i,$param);
while($i <= $#ARGV) {
# scan for a help switch
if ($ARGV[$i] =~ /^-h/i) {
&DieHelp("", $help);
}
# 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);
}
# snarf first arg
elsif ($param == 0) {
$filespec = $ARGV[$i];
$i++; $param++;
}
# snarf second arg
elsif ($param == 1) {
$client = $ARGV[$i];
$i++; $param++;
}
else {
&DieHelp("Extra args: @ARGV\n", $help);
}
}
}
#
# test arg1 - but just about anything could be valid...
if ($client) {
$P4 = "$P4 -c $client";
}
if ($filespec =~ /\#/ or $filespec =~ /\@/) {
&PrintError("filespec argument cannot have a revision specification.
$err Instead, sync your client to the state that you wish to test.");
exit(1);
}
#
# determine the max change
$script = "$P4 changes -s submitted -m1 \"$filespec#have\"";
&PrintMessage("Running: $script") if ($verbose);
$output = `$script`; # ignore errors
chomp($output);
#&mychomp(\$output);
($maxchange = $output) =~ s/^Change ([0-9]+) .*$/$1/;
if ($maxchange eq "" or $maxchange == 0) {
&PrintError("$err No valid max change\n$output");
exit 1;
}
#
# 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
$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>) {
chomp;
# &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)
$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|^,||;
$realminchange = $list;
$realminchange =~ s|(^[0-9]+).*$|$1|;
$realminchange-- if ($realminchange > 0);
#
# the end
&PrintMessage("Summary: found $count inconsistant file(s)") if ($verbose);
&PrintMessage(" maxchange: $maxchange") if ($verbose);
&PrintMessage("min consistant change: $minchange") if ($verbose > 1);
&PrintMessage("max consistant change: $realminchange") if ($verbose);
&PrintMessage(" incomplete changes: $list") if ($verbose and $list);
exit(0);
sub DieHelp {
my($str, $help) = @_;
print STDERR "$err $str\nUsage: $help";
exit(2);
}
sub min {
my($a, $b) = @_;
return($a) if ($a <= $b);
return($b);
}
sub sortbynumber {
my($tmpa) = $a;
my($tmpb) = $b;
$tmpa <=> $tmpb;
}
sub GetFileLog {
my($hashref, $file) = @_;
my($script) = "$P4 filelog \"$file\"";
if (!exists($$hashref{$file}{'raw'})) {
my(@output) = &ExecuteP4Cmd($script);
chomp(@output);
# &mychomp(\@output);
@{$$hashref{$file}{'raw'}} = @output;
# 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 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) {
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);
}
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 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);
}
# 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;
}