# # 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. #----------------------------------------------------------------------------------- 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 ""); # cannot use 'p4 describe -s changenum', so we get a list of open files # this way... @OpenedList = `$p4 opened -c $ChangeNum`; # # 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 /^(\/\/.*)#\d+ - .*\s$ChangeNum\s.*/; if (($tmp = IsInterestingFile($1, %listpairs)) ne "") { $FilesToChange{"$1"} = $tmp; $nfiles++; } } if ($nfiles == -1) { Inform("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) { Warn("*** 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); 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 ""; } ############################################################################### # 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); }
# | Change | User | Description | Committed | |
---|---|---|---|---|---|
#6 | 6237 | Matt Attaway | Update trigger entry examples to reflect modern Perforce syntax. | ||
#5 | 4569 | laurette | Pull in JAB's latest triggers changes. | ||
#4 | 3588 | Sam Stafford | Pull in JAB's latest triggers changes. | ||
#3 | 376 | james | push modifications to Jeff Bowles' sample scripts live | ||
#2 | 104 | Laura Wingerd |
Publish new trigger examples (change 103, change 102, change 101, change 100, change 99, change 91) |
||
#1 | 94 | Laura Wingerd |
Re-org "triggers" directory -- it's now part of the "Perforce Utilities" project. |
||
//public/perforce/triggers/Pairs.pl | |||||
#1 | 92 | Laura Wingerd | Publishing Jeff's trigger examples | ||
//guest/jeff_bowles/perforce-triggers/Pairs.pl | |||||
#2 | 91 | Jeff Bowles | Making sure that all output goes to <stdout> not <stderr> | ||
#1 | 81 | Jeff Bowles | adding some trigger examples.... |