# # 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); }
# | Change | User | Description | Committed | |
---|---|---|---|---|---|
#1 | 95 | Laura Wingerd | Pull in new triggers stuff. | ||
//guest/perforce_software/triggers/CheckC.pl | |||||
#1 | 94 | Laura Wingerd |
Re-org "triggers" directory -- it's now part of the "Perforce Utilities" project. |
||
//public/perforce/triggers/CheckC.pl | |||||
#1 | 92 | Laura Wingerd | Publishing Jeff's trigger examples | ||
//guest/jeff_bowles/perforce-triggers/CheckC.pl | |||||
#2 | 91 | Jeff Bowles | Making sure that all output goes to <stdout> not <stderr> | ||
#1 | 81 | Jeff Bowles | adding some trigger examples.... |