# # $Id: //guest/paul_goffin/triggers/Binary.pl#1 $ # # Example trigger to enforce a rule "files of suffix .x need to be checked # in as type Z". (For example, ".gif" files must always be "binary" and ".sh" # files should always be "text".) # # 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: # exampleB //.../*.gif "perl whatever/Binary.pl %changelist% %serverport% %client%" # exampleB //.../*.bmp "perl whatever/Binary.pl %changelist% %serverport% %client%" # exampleB //.../*.sh "perl whatever/Binary.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. # # # Based on the example from Jeff Bowles # Fixed problem with latest 99.2 server "Host:" option # for clients. Also improved way to get list of files in # change being submitted. # #-------- enter the suffixes for the pairs, here ----------------------------------- #$filetype{"sh"} = ".*text"; # x.sh is text # $errmsg{"sh"} = "filetype of .sh files should be text/xtext/ktext"; #$filetype{"gif"} = ".*binary"; # x.gif is binary # $errmsg{"gif"} = "filetype of .gif files should be binary"; $filetype{"pdf"} = ".*binary"; # *.pdf is binary $errmsg{"pdf"}= "filetype of .pdf files must be binary"; #----------------------------------------------------------------------------------- $ChangeNum = $ARGV[0]; $ServerPort = $ARGV[1]; $ClientName = $ARGV[2]; 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 ""); $mainP4env = "-p $ServerPort -u SUPERUSER -P SUPERUSERPASSWD"; $p4 = "p4 $mainP4env"; $nerrs = 0; $MaxErrs = 10; $OptimizeErrorOutput = "yes"; # Need to find the "Host" of the client if any. # Get the client description and search it for the "Host:" field @Client = `$p4 client -o $ClientName`; foreach (@Client) { chomp ($_); if ($_) { my @fields = split; if (($fields[0]) && ($fields[0] eq "Host:")) { if ($fields[1]) { $p4 = "p4 $mainP4env -H $fields[1] -c $ClientName"; } else { $p4 = "p4 $mainP4env -c $ClientName"; } last; } if (($fields[0]) && ($fields[0] eq "Description:")) { # No host field present - backward compatibility $p4 = "p4 $mainP4env -c ClientName"; last; } } } #print "\nMy P4 = $p4\n"; @OpenedList = `$p4 opened -c $ChangeNum`; # cannot use 'p4 describe -s changenum', so we # get a list of open files this way... # # Algorithm used: # Pry out the suffix/type for each file being submitted, and pass it to "CheckType". # It'll pass back "-1" for each bad file type. # chomp(@OpenedList); foreach (@OpenedList) { my($tmp); next unless /^(\/\/.*)#[0-9]* - .*\s$ChangeNum\s\((\S+)\).*/; if (CheckType($1, $2, %filetype) < 0) { $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); sub CheckType { my($fname, $filetype, %filetypes) = @_; my($suffix) = $1 if ($fname =~ /^.*\.([^\.]+)$/); if ($1 ne "" && defined($filetypes{$suffix}) && $filetype !~ /^$filetypes{$suffix}/ ) { Warn("$fname: $errmsg{$suffix}.\n"); return (-1); } return 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); }
# | Change | User | Description | Committed | |
---|---|---|---|---|---|
#1 | 373 | paul_goffin |
Updated example trigger to cope with the Host: option in client specs. |