-#! /usr/bin/perl
-# -*-Perl-*-
-#
-#ident "@(#)cvs/contrib:$Name: $:$Id: commit_prep,v 1.1 2006/05/09 01:06:37 bdemsky Exp $"
-
-# first thing: delegate to cvs_acls for access controls.
-system "$CVSROOT/CVSROOT/cvs_acls" == 0
- or exit 1; # bad access controls!
-
-#
-# 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
-$DIFF_FILE = "/tmp/#cvs.diff"; # 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\\$\""; # emacs-fontify gets confused by the "
-
-$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";
-
-$BadCR = "
-%s - contains a CR (^M, ascii 13) character, which is not a valid
- line ending on this platform. Either tag this as a binary
- file or remove the bogus CR characters, and 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 append_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) = @_;
-
- open(FILE, "<$filename") || return(0);
-
- @all_lines = ();
- $idpos = -1;
- $newidpos = -1;
- for ($i = 0; <FILE>; $i++) {
- chomp;
- push(@all_lines, $_);
- if ($_ =~ /$IDstring/) {
- $idpos = $i;
- }
- if ($_ =~ /$NewId/) {
- $newidpos = $i;
- }
- if ($_ =~ /\015/ && $cvsflags{$filename} !~ /-kb/) {
- print STDERR sprintf($BadCR, $filename);
- return(1);
- }
- }
-
- 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 script.
-#
-$record_directory = 0;
-
-# Keep track of diffs for later use by the log_accumulate script.
-#
-$track_diffs = 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;
- } elsif ($arg eq '-u') {
- $track_diffs = 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, $verdate, $flags)=split('/', substr($_, 1));
- $cvsversion{$filename} = $version;
- $cvsflags{$filename} = $flags;
-}
-close(ENTRIES);
-
-# 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);
- }
-}
-
-# Create a diff for each file name passed in.
-if ($track_diffs != 0) {
- @diff_txt = ();
- foreach $arg (@files) {
-# open(STATUS, "-|") ||
-# exec 'cvs', '-nQq', 'diff', '-u', $arg;
- open(STATUS, "-|") || # redirect stderr, too.
- exec 'csh', '-c', "cvs -nQq diff -u $arg |& cat";
- while (<STATUS>) {
- chop;
- push(@diff_txt, $_);
- }
- close(STATUS);
- }
- &append_line("$DIFF_FILE.$id", join("\n", @diff_txt));
-}
-
-# 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);