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