137 lines
3.6 KiB
Perl
Executable file
137 lines
3.6 KiB
Perl
Executable file
#! /usr/bin/perl -w
|
|
#
|
|
# $FreeBSD: logcheck,v 1.24 2001/12/24 15:00:18 joe Exp $
|
|
#
|
|
# This hack is to sanitise the results of what the user may have
|
|
# "done" while editing the commit log message.. :-) Peter Wemm.
|
|
#
|
|
# Note: this uses an enhancement to cvs's verifymsg functionality.
|
|
# Normally, the check is advisory only, the FreeBSD version reads
|
|
# back the file after the verifymsg file so that this script can
|
|
# make changes.
|
|
#
|
|
|
|
use strict;
|
|
use lib $ENV{CVSROOT};
|
|
use CVSROOT::cfg;
|
|
|
|
|
|
#############################################################
|
|
#
|
|
# Main Body
|
|
#
|
|
############################################################
|
|
|
|
my $filename = shift;
|
|
die "Usage: logcheck filename\n" unless $filename;
|
|
|
|
|
|
|
|
|
|
# Read the log file in, stripping 'CVS:' lines and removing trailing
|
|
# white spaces.
|
|
open IN, "< $filename" or
|
|
die "logcheck: Cannot open for reading: $filename: $!\n";
|
|
my @log_in = map { s/^(.*?)\s*$/$1/; $1 } grep { !/^CVS:/ } <IN>;
|
|
close IN;
|
|
|
|
# Remove duplicate blank lines.
|
|
my $i = 0;
|
|
while ($i < scalar(@log_in) - 1) {
|
|
if ($log_in[$i] eq "" && $log_in[$i + 1] eq "") {
|
|
splice(@log_in, $i, 1);
|
|
next;
|
|
}
|
|
++$i;
|
|
}
|
|
|
|
# Remove leading and trailing blank lines. (There will be at most
|
|
# one because of the duplicate removal above).
|
|
shift @log_in if $log_in[0] eq "";
|
|
pop @log_in if $log_in[-1] eq "";
|
|
|
|
# Scan through the commit message looking for templated headers
|
|
# as defined in the configuration file, and rcstemplate.
|
|
# Assume that these only exist in the last paragraph.
|
|
# Filter out blank entries, and type check if necessary.
|
|
my $j = $#log_in; # The index of the last entry in the commit msg.
|
|
my $error = 0;
|
|
while ($j >= 0) {
|
|
my $logline = $log_in[$j];
|
|
|
|
--$j;
|
|
|
|
# Hitting a blank line means that we've seen all of the last paragraph.
|
|
last if $logline eq "";
|
|
|
|
unless ($logline =~ /^(.*?):\s*(.*)$/) {
|
|
### XXX
|
|
# We're here because we saw a line that didn't match
|
|
# a template header (no ':'). This could be a continuation
|
|
# line from the previous header, or the log message proper.
|
|
# We don't know, so run the risk of checking the last paragraph
|
|
# of the log message for headers.
|
|
next;
|
|
}
|
|
|
|
my $header = $1;
|
|
my $value = $2;
|
|
my $pattern = $cfg::TEMPLATE_HEADERS{$header};
|
|
|
|
# Ignore unrecognised headers.
|
|
unless (defined($pattern)) {
|
|
### print "Warning: unknown template header: $header\n";
|
|
next;
|
|
}
|
|
|
|
# Filter out the template header if it's blank.
|
|
if ($value eq "") {
|
|
splice(@log_in, $j + 1, 1);
|
|
next;
|
|
}
|
|
|
|
# Type check the header
|
|
unless ($value =~ /^$pattern$/) {
|
|
print "Error: $header: should match '$pattern'.\n";
|
|
++$error;
|
|
next;
|
|
}
|
|
}
|
|
|
|
|
|
# Make sure that there is some content in the log message.
|
|
# XXX Note that logcheck isn't evoked if the log message is
|
|
# completely empty. This is a bug in cvs.
|
|
my $log = "@log_in";
|
|
die "Log message contains no content!\n" if $log =~ /^\s*$/;
|
|
|
|
|
|
# Write the modified log file back out.
|
|
my $tmpfile = $filename . "tmp";
|
|
open OUT, "> $tmpfile" or
|
|
die "logcheck: Cannot open for writing: $tmpfile: $!\n";
|
|
print OUT map { "$_\n" } @log_in;
|
|
close OUT;
|
|
|
|
|
|
# Stop the commit if there was a problem with the template headers.
|
|
if ($error) {
|
|
print "There were $error errors in the template headers.\n";
|
|
print "Please fix the log message and commit again.\n";
|
|
print "A copy of your log message was saved in $tmpfile.\n";
|
|
exit 1;
|
|
}
|
|
|
|
|
|
|
|
# Nuke likely editor backups.
|
|
unlink "$filename.~";
|
|
unlink "$filename.bak";
|
|
|
|
|
|
# Overwrite the log message with our sanitised one. (See the comment
|
|
# block at the top of this script for an explaination of why.)
|
|
rename($tmpfile, $filename) or
|
|
die "logcheck: Could not rename $tmpfile to $filename: $!";
|
|
|
|
exit 0;
|