#
# Example trigger to enforce a rule "files of suffix .x/.y need to be checked
# in as pairs".
#
# This script will do the following:
# 1. Return "success" (exit code 0) if the change has no applicable files
# in the changelist;
# 2. Otherwise, it checks that the files you've given are
# being submitted with the other component in that pair, and
# if not, reports an error.
#
# Unix usage:
# perl /whatever/Pairs.pl %changelist% %serverport% %client%
# NT usage:
# c:/perl/bin/perl c:/whatever/Pairs.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:
# (Note: since this is applicable to only filenames with certain suffixes, you
# might want to restrict the trigger to run when those files are submitted.
# So, if this is looking at .cpp/.h/.txt/.html lines, you might want to have
# it run only on those files.)
# Triggers:
# exampleP //.../*.cpp "perl whatever/Pairs.pl %changelist% %serverport% %client%"
# exampleP //.../*.h "perl whatever/Pairs.pl %changelist% %serverport% %client%"
# exampleP //.../*.html "perl whatever/Pairs.pl %changelist% %serverport% %client%"
# exampleP //.../*.txt "perl whatever/Pairs.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.
#
$ChangeNum = $ARGV[0];
$ServerPort = $ARGV[1];
$ClientName = $ARGV[2];
$p4 = "p4 -p $ServerPort -c $ClientName";
$MaxErrs = 10;
$OptimizeErrorOutput = "yes";
#-------- enter the suffixes for the pairs, here -----------------------------------
$listpairs{"cpp"} = "h"; # x.cpp must have x.h checked in, and also vice versa.
$listpairs{"txt"} = "html"; # x.txt must have x.html checked in, and also vice versa.
#-----------------------------------------------------------------------------------
die "Changelist $ChangeNum (1st arg) needs to be numeric!\n" unless ($ChangeNum =~ /^\d+$/);
die "\%serverport\% (2nd arg) wasn't specified.\n" if ($ServerPort eq "");
die "\%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...
#
# Algorithm used:
# for each file in that's being submitted...
# 1. Figure out if it's "interesting" to this trigger, which is to say,
# that it ends with one of the suffixes listed in "listpairs".
# 2. If so, add it to the associative array "FilesToChange". The
# value of the array element is the name of the OTHER item in the
# pair. (So if "x.h" is being submitted, $FilesToChange{"x.h"} will
# map to "x.cpp".)
# After creating this array, then step through it making sure that each
# item mentioned as a value ("x.cpp") is also a valid index. That means
# that ``$FilesToChange{"x.cpp"} should exist''). If not, it's an error.
#
chomp(@OpenedList);
foreach (@OpenedList) {
my($tmp);
next unless /^(\/\/.*)#1 - .*\s$ChangeNum\s.*/;
if (($tmp = IsInterestingFile($1, %listpairs)) ne "") {
$FilesToChange{"$1"} = $tmp;
$nfiles++;
}
}
if ($nfiles == -1) {
print "No changes modify files that belong in a pair. (Exiting.)\n";
exit(0);
}
$nerrs = 0;
foreach $f (sort keys %FilesToChange) {
my($expected_pair) = $FilesToChange{"$f"};
if (!defined($FilesToChange{"$expected_pair"})) {
# errors are reported to STDOUT, since NT triggers don't copy STDERR to user.
print "$f was submitted, but $expected_pair wasn't - both should be submitted.\n";
$nerrs++;
}
if ($nerrs >= $MaxErrs) {
print "*** Only first $MaxErrs errors shown\n";
last;
}
}
if ($nerrs > 0) {
print "Errors found, submission refused\n"; # Note, this prints to STDOUT. See above.
exit(1);
}
exit(0);
sub IsInterestingFile {
my($fname, %listpairs) = @_;
foreach $l (keys %listpairs) {
my($suffix1, $suffix2) = ($l, $listpairs{$l});
return "$1.$suffix2"
if ($fname =~ /^(.*)\.$suffix1/);
return "$1.$suffix1"
if ($fname =~ /^(.*)\.$suffix2/);
}
return "";
}