Annotation of CVSROOT/commit_prep.pl, Revision 1.1
1.1 ! maekawa 1: #!/usr/bin/perl -w
! 2: #
! 3: # $OpenXM$
! 4: #
! 5: # Most parts obtained from FreeBSD.org and modified for OpenXM
! 6: #
! 7:
! 8: require 5.003; # to be sure. log_accum needs perl5
! 9:
! 10: ############################################################
! 11: #
! 12: # Configurable options
! 13: #
! 14: ############################################################
! 15: #
! 16: # Check each file (except dot files) for an RCS "OpenXM" keyword.
! 17: #
! 18: $check_id = 0;
! 19:
! 20: #
! 21: # Record the directory for later use by the log_accumulate stript.
! 22: #
! 23: $record_directory = 1;
! 24:
! 25: ############################################################
! 26: #
! 27: # Constants
! 28: #
! 29: ############################################################
! 30: $LAST_FILE = "/tmp/#cvs.files.lastdir";
! 31: $ENTRIES = "CVS/Entries";
! 32:
! 33: $NoId = "
! 34: %s - Does not contain a line with the keyword \"\$OpenXM:\".\n";
! 35:
! 36: # Protect string from substitution by RCS.
! 37: $NoName = "
! 38: %s - The ID line should contain only \"\$\OpenXM\$\" for a newly created file.\n";
! 39:
! 40: $BadId = "%s - The \$\OpenXM\$ is mangled.\n";
! 41:
! 42: $BadName = "
! 43: %s - The pathname '%s'
! 44: in the \$\OpenXM\$ line does not match the actual filename.\n";
! 45:
! 46: $BadVersion = "
! 47: %s - GRRR!! You spammed your copy of the file
! 48: which was based upon version %s, with a different version based
! 49: upon %s. Please move your '%s' out of the way,
! 50: perform an update to get the current version, and then
! 51: CAREFULLY merge your changes into that file.\n";
! 52:
! 53: ############################################################
! 54: #
! 55: # Subroutines
! 56: #
! 57: ############################################################
! 58:
! 59: sub write_line {
! 60: local($filename, $line) = @_;
! 61: open(FILE, ">$filename") || die("Cannot open $filename, stopped");
! 62: print(FILE $line, "\n");
! 63: close(FILE);
! 64: }
! 65:
! 66: sub check_version {
! 67: local($id, $rname, $version, $bareid);
! 68: local($filename, $directory, $hastag, $cvsversion) = @_;
! 69:
! 70: if (! -f $filename) {
! 71: return(0); # not present - either removed or let cvs deal with it.
! 72: }
! 73: open(FILE, $filename) || die("Cannot open $filename, stopped");
! 74: # requiring the header within the first 'n' lines isn't useful.
! 75: while (1) {
! 76: $pos = -1;
! 77: last if eof(FILE);
! 78: $line = <FILE>;
! 79: $pos = index($line, "\$\OpenXM");
! 80: last if ($pos >= 0);
! 81: }
! 82:
! 83: if ($pos == -1) {
! 84: printf($NoId, $filename);
! 85: return(1);
! 86: }
! 87: $bareid = (index($line, "\$\OpenXM: \$") >= 0 ||
! 88: index($line, "\$\OpenXM\$") >= 0);
! 89: if (!$bareid && $line !~ /\$\OpenXM: .* \$/) {
! 90: printf($BadId, $filename);
! 91: return(1);
! 92: }
! 93: # Ignore version mismatches (MFC spamming etc) on branches.
! 94: if ($hastag) {
! 95: return (0);
! 96: }
! 97: ($id, $rname, $version) = split(' ', substr($line, $pos));
! 98: if ($cvsversion{$filename} == 0) {
! 99: if (!$bareid) {
! 100: printf($NoName, $filename);
! 101: return(1);
! 102: }
! 103: return(0);
! 104: }
! 105: if ($bareid) {
! 106: return (0);
! 107: }
! 108: if ($cvsversion{$filename} ne $version) {
! 109: printf($BadVersion, $filename, $cvsversion{$filename},
! 110: $version, $filename);
! 111: return(1);
! 112: }
! 113: return(0);
! 114: }
! 115:
! 116: #############################################################
! 117: #
! 118: # Main Body
! 119: #
! 120: ############################################################
! 121:
! 122: $id = getpgrp();
! 123: #print("ARGV - ", join(":", @ARGV), "\n");
! 124: #print("id - ", id, "\n");
! 125:
! 126: #
! 127: # Suck in the Entries file
! 128: #
! 129: open(ENTRIES, $ENTRIES) || die("Cannot open $ENTRIES.\n");
! 130: while (<ENTRIES>) {
! 131: chop;
! 132: next if (/^D/);
! 133: local($filename, $version, $stamp, $opt, $tag) = split('/', substr($_, 1));
! 134: $cvsversion{$filename} = $version;
! 135: $cvstag{$filename} = $tag;
! 136: $stamp = $opt; #silence -w
! 137: }
! 138: close(ENTRIES);
! 139:
! 140: $directory = $ARGV[0];
! 141: shift @ARGV;
! 142:
! 143: $cvsroot=$ENV{'CVSROOT'} || "/home/ncvs";
! 144: $directory =~ s,^$cvsroot[/]+,,;
! 145:
! 146: if ($directory =~ /^OpenXM/) {
! 147: $check_id = 1;
! 148: }
! 149: if ($check_id != 0 && $ENV{'CVSFUBAR'}) {
! 150: $check_id = 0;
! 151: print "CVS VERSION CHECK BYPASSED!\n";
! 152: system("ps -xww | mail -s 'version check override used' cvs");
! 153: }
! 154: #
! 155: # Now check each file name passed in, except for dot files. Dot files
! 156: # are considered to be administrative files by this script.
! 157: #
! 158: if ($check_id != 0) {
! 159: $failed = 0;
! 160: foreach $arg (@ARGV) {
! 161: local($hastag) = ($cvstag{$arg} ne '');
! 162: next if (index($arg, ".") == 0);
! 163: $failed += &check_version($arg, $directory, $hastag, $cvsversion);
! 164: }
! 165: if ($failed) {
! 166: print "\n";
! 167: unlink("$LAST_FILE.$id");
! 168: exit(1);
! 169: }
! 170: }
! 171:
! 172: #
! 173: # Record this directory as the last one checked. This will be used
! 174: # by the log_accumulate script to determine when it is processing
! 175: # the final directory of a multi-directory commit.
! 176: #
! 177: if ($record_directory != 0) {
! 178: &write_line("$LAST_FILE.$id", $directory);
! 179: }
! 180: exit(0);
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>