1#! @PERL@ 2# -*-Perl-*- 3# 4# 5# Perl filter to handle pre-commit checking of files. This program 6# records the last directory where commits will be taking place for 7# use by the log_accum.pl script. For new files, it forces the 8# existence of a RCS "Id" keyword in the first ten lines of the file. 9# For existing files, it checks version number in the "Id" line to 10# prevent losing changes because an old version of a file was copied 11# into the direcory. 12# 13# Possible future enhancements: 14# 15# Check for cruft left by unresolved conflicts. Search for 16# "^<<<<<<<$", "^-------$", and "^>>>>>>>$". 17# 18# Look for a copyright and automagically update it to the 19# current year. [[ bad idea! -- woods ]] 20# 21# 22# Contributed by David Hampton <hampton@cisco.com> 23# 24# Hacked on lots by Greg A. Woods <woods@web.net> 25 26# 27# Configurable options 28# 29 30# Constants (remember to protect strings from RCS keyword substitution) 31# 32$LAST_FILE = "/tmp/#cvs.lastdir"; # must match name in log_accum.pl 33$ENTRIES = "CVS/Entries"; 34 35# Patterns to find $Log keywords in files 36# 37$LogString1 = "\\\$\\Log: .* \\\$"; 38$LogString2 = "\\\$\\Log\\\$"; 39$NoLog = "%s - contains an RCS \$Log keyword. It must not!\n"; 40 41# pattern to match an RCS Id keyword line with an existing ID 42# 43$IDstring = "\"@\\(#\\)[^:]*:.*\\\$\Id: .*\\\$\""; 44$NoId = " 45%s - Does not contain a properly formatted line with the keyword \"Id:\". 46 I.e. no lines match \"" . $IDstring . "\". 47 Please see the template files for an example.\n"; 48 49# pattern to match an RCS Id keyword line for a new file (i.e. un-expanded) 50# 51$NewId = "\"@(#)[^:]*:.*\\$\Id\\$\""; 52 53$NoName = " 54%s - The ID line should contain only \"@(#)module/path:\$Name\$:\$\Id\$\" 55 for a newly created file.\n"; 56 57$BadName = " 58%s - The file name '%s' in the ID line does not match 59 the actual filename.\n"; 60 61$BadVersion = " 62%s - How dare you!!! You replaced your copy of the file '%s', 63 which was based upon version %s, with an %s version based 64 upon %s. Please move your '%s' out of the way, perform an 65 update to get the current version, and them merge your changes 66 into that file, then try the commit again.\n"; 67 68# 69# Subroutines 70# 71 72sub write_line { 73 local($filename, $line) = @_; 74 open(FILE, ">$filename") || die("Cannot open $filename, stopped"); 75 print(FILE $line, "\n"); 76 close(FILE); 77} 78 79sub check_version { 80 local($i, $id, $rname, $version); 81 local($filename, $cvsversion) = @_; 82 83 open(FILE, "<$filename") || return(0); 84 85 @all_lines = (); 86 $idpos = -1; 87 $newidpos = -1; 88 for ($i = 0; <FILE>; $i++) { 89 chop; 90 push(@all_lines, $_); 91 if ($_ =~ /$IDstring/) { 92 $idpos = $i; 93 } 94 if ($_ =~ /$NewId/) { 95 $newidpos = $i; 96 } 97 } 98 99 if (grep(/$LogString1/, @all_lines) || grep(/$LogString2/, @all_lines)) { 100 print STDERR sprintf($NoLog, $filename); 101 return(1); 102 } 103 104 if ($debug != 0) { 105 print STDERR sprintf("file = %s, version = %d.\n", $filename, $cvsversion{$filename}); 106 } 107 108 if ($cvsversion{$filename} == 0) { 109 if ($newidpos != -1 && $all_lines[$newidpos] !~ /$NewId/) { 110 print STDERR sprintf($NoName, $filename); 111 return(1); 112 } 113 return(0); 114 } 115 116 if ($idpos == -1) { 117 print STDERR sprintf($NoId, $filename); 118 return(1); 119 } 120 121 $line = $all_lines[$idpos]; 122 $pos = index($line, "Id: "); 123 if ($debug != 0) { 124 print STDERR sprintf("%d in '%s'.\n", $pos, $line); 125 } 126 ($id, $rname, $version) = split(' ', substr($line, $pos)); 127 if ($rname ne "$filename,v") { 128 print STDERR sprintf($BadName, $filename, substr($rname, 0, length($rname)-2)); 129 return(1); 130 } 131 if ($cvsversion{$filename} < $version) { 132 print STDERR sprintf($BadVersion, $filename, $filename, $cvsversion{$filename}, 133 "newer", $version, $filename); 134 return(1); 135 } 136 if ($cvsversion{$filename} > $version) { 137 print STDERR sprintf($BadVersion, $filename, $filename, $cvsversion{$filename}, 138 "older", $version, $filename); 139 return(1); 140 } 141 return(0); 142} 143 144# 145# Main Body 146# 147 148$id = getpgrp(); # You *must* use a shell that does setpgrp()! 149 150# Check each file (except dot files) for an RCS "Id" keyword. 151# 152$check_id = 0; 153 154# Record the directory for later use by the log_accumulate stript. 155# 156$record_directory = 0; 157 158# parse command line arguments 159# 160while (@ARGV) { 161 $arg = shift @ARGV; 162 163 if ($arg eq '-d') { 164 $debug = 1; 165 print STDERR "Debug turned on...\n"; 166 } elsif ($arg eq '-c') { 167 $check_id = 1; 168 } elsif ($arg eq '-r') { 169 $record_directory = 1; 170 } else { 171 push(@files, $arg); 172 } 173} 174 175$directory = shift @files; 176 177if ($debug != 0) { 178 print STDERR "dir - ", $directory, "\n"; 179 print STDERR "files - ", join(":", @files), "\n"; 180 print STDERR "id - ", $id, "\n"; 181} 182 183# Suck in the CVS/Entries file 184# 185open(ENTRIES, $ENTRIES) || die("Cannot open $ENTRIES.\n"); 186while (<ENTRIES>) { 187 local($filename, $version) = split('/', substr($_, 1)); 188 $cvsversion{$filename} = $version; 189} 190 191# Now check each file name passed in, except for dot files. Dot files 192# are considered to be administrative files by this script. 193# 194if ($check_id != 0) { 195 $failed = 0; 196 foreach $arg (@files) { 197 if (index($arg, ".") == 0) { 198 next; 199 } 200 $failed += &check_version($arg); 201 } 202 if ($failed) { 203 print STDERR "\n"; 204 exit(1); 205 } 206} 207 208# Record this directory as the last one checked. This will be used 209# by the log_accumulate script to determine when it is processing 210# the final directory of a multi-directory commit. 211# 212if ($record_directory != 0) { 213 &write_line("$LAST_FILE.$id", $directory); 214} 215exit(0); 216