CheckC.pl #1

#
# 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.
#	2. If you submit the four files in the above example into a *new*
#	   directory, this script won't catch that case at the moment.
#

$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/...";
}
@AllFilesList = `$p4 files $depotlist`;
chomp(@AllFilesList);
foreach $f (@AllFilesList) {			# for each file....
	my($dirname) = $f;
	$dirname =~ s/\/[^\/]+#.*//;		# pry out the directory name
	next if ($DepotDirProcessed{$dirname}++);	# skip duplicate directories...
	push(@DirList, $dirname);		# make the list of all depot directories
}

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/;

	next unless defined($LowerCaseDirectoryName{$lcdirname});
	next if ($LowerCaseDirectoryName{$lcdirname} eq "");
	next if ($OptimizeErrorOutput eq "yes" && $Seen{"$lcdirname"} > 0);
	$Seen{"$lcdirname"}++;

	if ($LowerCaseDirectoryName{"$lcdirname"} ne $dirname) {
		#
		# 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 to a directory that has different case\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);
}