# # Example trigger to enforce a rule "submissions must have a job associated # with them." # # This script will do the following: # 1. Return "success" (exit code 0) if the change has # at least one "job" associated with it; # 2. Otherwise, reports an error. # # Unix usage: # perl /whatever/Jobs.pl %changelist% %serverport% # NT usage: # c:/perl/bin/perl c:/whatever/Jobs.pl %changelist% %serverport% # (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: # exJobs //... "c:/perl/bin/perl c:/whatever/Jobs.pl %changelist% %serverport%" # # Tested on Platforms: FreeBSD, NT (as program, not service). # # You might need to... # 1. You might need to run change the "$p4 = ......." line, below, to add a username # and password ('p4 -u hardcodedusername -P hardcodeduserpasswd -p $ServerPort') # if the default user it's connecting as isn't appropriate. $ChangeNum = $ARGV[0]; $ServerPort = $ARGV[1]; $p4 = "p4 -p $ServerPort"; $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 ""); @ChangeInfo = `$p4 describe -s $ChangeNum`; foreach $c (@ChangeInfo) { exit(0) if ($c =~ /Jobs fixed/); }; # # Note that errors are sent to because the NT server copies THAT to # the user's output. # if ($#ChangeInfo == -1) { Fatal("Cannot get 'p4 describe -s $ChangeNum' output. Refusing submission\n"); } else { Fatal("No job associated with change $ChangeNum - refusing submission\n"); } # end of 'main' segment ############################################################################### # 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); }