#
# We're having a lot of files added to the wrong directories,
# accidently, because the files are named things like:
#		//depot/DiReCtOrYnAMe/file1
#		//depot/DirectoryName/file2
#		//depot/DIRECTORYNAME/file3
#		//depot/directoryname/file4
# This script will do the following:
#	1. Return "success" (exit code 0) if the change has
#	   no adds/branches in the changelist;
#	2. Otherwise, it gets the list of *all* directories
#	   from "p4 files //..." and looks for any files that
#	   are being added to a directory that already exists,
#	   but is of a different case. (That's an error.)

#
# Unix usage:
#	perl /whatever/CheckC.pl %changelist% %serverport% %client%
# NT usage:
#       c:/perl/bin/perl  c:/whatever/checkc.pl %changelist% %serverport% %client%
# (Note that the name of this script might need to be an "8.3" filename,
# depending on the version of Perl you're running.)
#
# Example 'triggers' section:
#    Triggers:
#	exCheckC  //...   "c:/perl/bin/perl c:/whatever/checkc.pl %changelist% %serverport% %client%"
#
# Tested on Platforms:   FreeBSD, NT (as program, not service).
#
# Known bugs:
#	1. Perforce triggers have problems [at the moment] running when the
#	   Perforce server is running as an NT server.
#

# set $UseDirs to 1 to use p4 dirs ..., set to 0 to use p4 files ...
#
# p4 dirs ... is much faster but support@perforce.com tells me it only works by
# accident on 99.1 and still then doesn't produce reliable output.  I left this
# is just in case it ever works at some point.
#
$UseDirs = 0;

# set to 1 to save dir list and just read delta file list since last time
$CacheDirs = 1;

# set to '/dev/nul' for unix(?), 'nul' for NT
$nulDevice='nul';

bail('Invalid option combination, $UseDirs can not be used with $CacheDirs') if ( $UseDirs && $CacheDirs );

$ChangeNum = $ARGV[0];
$ServerPort = $ARGV[1];
$ClientName = $ARGV[2];
$p4 = "p4 -p $ServerPort -c $ClientName";

$MaxErrs = 10;
$OptimizeErrorOutput = "yes";

Fatal("Changelist $ChangeNum (1st arg) needs to be numeric!\n") unless ($ChangeNum =~ /^\d+$/);
Fatal("\%serverport\% (2nd arg) wasn't specified.\n") if ($ServerPort eq "");
Fatal("\%clientname\% (3rd arg) wasn't specified.\n") if ($ClientName eq "");

@OpenedList = `$p4 opened`;	# cannot use 'p4 describe -s changenum', so we
				# get a list of open files this way...
chomp(@OpenedList);
foreach (@OpenedList) {
	next unless /^\/\/([^\/]+)\/(.*)#1 - .*\s$ChangeNum\s.*/;
	push(@FilesToAdd, "//$1/$2");		# create list of files being added
	$DepotsToCheck{$1}++;			# and what 'depot they're from...
}

if ($#FilesToAdd == -1) {
	Inform("No changes add/branch files - nothing to do!\n");
	exit(0);
}
#---------------------------------------------------------------------------
# Everything to this point needed to be very inexpensive. (Most cases
# should hit the "exit(0);" two lines up, minimizing the overhead for
# more typical submissions.)
#
# If we've reached this point, there are files being added/branched, and
# we need to construct a "current directory list" of directories in the
# depots....
#---------------------------------------------------------------------------
#
# We use 'p4 files //depot/...' (for each depot) to get the directory list.
# It's necessary to use 'p4 files' instead of 'p4 dirs' since '...' doesn't
# work for 'p4 dirs'.
#
foreach $d (sort keys %DepotsToCheck) {
	$depotlist .= " //$d/...";
}

$changeNum = 0;
&ReadDirList( "dirlist", \$changeNum, \@DirList ) if ( $CacheDirs );
$nextChange = $changeNum+1;

if ( $UseDirs ) {
    @AllFilesList = `$p4 dirs $depotlist`;
}
else {
    @AllFilesList = `$p4 files $depotlist\@$nextChange, 2> $nulDevice`;
}

foreach $dirname (@DirList) {			# for each directory
	$DepotDirProcessed{$dirname}++;
}

chomp(@AllFilesList);
foreach $f (@AllFilesList) {			# for each file....
	my($dirname,$change) = ($f,$f =~ m/.*#\d+ - \S+ change (\d+)/);
	$changeNum = $change if ( $change > $changeNum );	# remember last change.
	$dirname =~ s/\/[^\/]+#.*// if ( !$UseDirs );		# pry out the directory name
	next if ($dirname eq "");							# error running p4 - assume no new changes
	next if ($DepotDirProcessed{$dirname}++);	# skip duplicate directories...
	push(@DirList, $dirname);		# make the list of all depot directories
}

foreach $d (sort keys %DepotsToCheck) {
	next if ($DepotDirProcessed{"//$d"}++);		# skip duplicate depot entries
	push(@DirList, "//$d");		# dirs/files don't show "root" depot entries - add by hand
}

&SaveDirList( "dirlist", $changeNum, \@DirList ) if ( $CacheDirs );

foreach $d (@DirList) {		# make associative array of their lower-case counterparts
	my($tmp) = $d;
	$tmp =~ tr/A-Z/a-z/;
	$LowerCaseDirectoryName{$tmp} = "$d";
}

#----------------------------
# Now we're ready to look at the new files and see whether they belong
# in poorly-named directories. (Compare the lower-cased name of the destination
# directory against the lower-cased name of the depot directories, and if
# we find a match, make sure that the non-mapped directory names match up.)
#----------------------------
$nerrs = 0;
foreach $f (@FilesToAdd) {
	my($dirname, $lcdirname) = ($f,);
	$dirname =~ s/\/[^\/]+$//;
	($lcdirname = $dirname) =~ tr/A-Z/a-z/;

# must determine what part of the path is already in the depot and only verify that part
	my($oldDirPart, $oldlcDirPart) = ($dirname,$lcdirname);

	if ( !defined($LowerCaseDirectoryName{$oldlcDirPart} ) )
	{
		# The full path is not in the depot, loop slicing off the tail dir until
		# we find the part of the path that is in the depot.
		do {
			$oldDirPart =~ s/\/[^\/]+$//;
			# At least the //depot part should match - this prevents looping forever
			Fatal("*** Oh I'm so confused - no portion of $f is an existing path\n" ) if ( !($oldlcDirPart =~ s/\/[^\/]+$//) );
		} while( !defined($LowerCaseDirectoryName{$oldlcDirPart} ) );

		# To ensure no mixed case in submit itself, add this full path to the lc 
		# hash for later files in the submit plus it makes this faster.
		$LowerCaseDirectoryName{$lcdirname} = $dirname;
	}
	next if ($OptimizeErrorOutput eq "yes" && $Seen{"$lcdirname"} > 0);
	$Seen{"$lcdirname"}++;

	if ($LowerCaseDirectoryName{"$oldlcDirPart"} ne $oldDirPart) {
		#
		# print to STDOUT that there was an error. (On Unix, it doesn't
		# matter; on NT, only STDOUT is copied back to the user.)
		#
		Warn("$f is being added has different case than " . $LowerCaseDirectoryName{"$oldlcDirPart"} . "\n");
		$nerrs++;
	}
        if ($nerrs >= $MaxErrs) {   
                Fatal("*** Only first $MaxErrs errors shown\n");
                last;
        }
}

if ($nerrs > 0) {
	Fatal("Errors found, submission refused\n");	# Note, this prints to STDOUT. See above.
}
exit(0);

###############################################################################
# Note that all messages (warning/fatal/info) go to STDOUT, not STDERR. Trigger
# output to standard output is sent to the user; standard error isn't.
###############################################################################
sub TellUser {
	my($str, $msgtype) = @_;
	print "$str";
	print "\n" unless ($str =~ /\n$/);
	exit(1) if ($msgtype eq fatal);
}

sub Warn {
	TellUser(@_, warning);
}
sub Fatal {
	TellUser(@_, fatal);
}

sub Inform {
	TellUser(@_, inform);
}

sub SaveDirList
{
	my($d, $fn, $c, $dlr) = ("",shift,shift,shift);

	open( DIRS, "> $fn" );
	print DIRS "$c\n";
	foreach $d (@$dlr)
	{
		print DIRS "$d\n";
	}
	close DIRS;
}

sub ReadDirList
{
	my ($d, $fn, $cr, $dlr);
	$fn = shift;
	$cr = shift;
	$dlr = shift;
	open( DIRS, "< $fn" ) || return;
	$$cr = <DIRS>;
	chomp $$cr;
	while( $d = <DIRS> ) {
		chomp $d;
		push(@$dlr, $d);
	}
	close DIRS;
}