#!/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;
}