Renamed to *.in for some time now.
This commit is contained in:
wiz
parent
680c69437a
commit
bc095c7c0b
|
|
@ -1,152 +0,0 @@
|
|||
#! xPERL_PATHx
|
||||
|
||||
# Merge conflicted ChangeLogs
|
||||
# tromey Mon Aug 15 1994
|
||||
|
||||
# Usage is:
|
||||
#
|
||||
# cl-merge [-i] file ...
|
||||
#
|
||||
# With -i, it works in place (backups put in a ~ file). Otherwise the
|
||||
# merged ChangeLog is printed to stdout.
|
||||
|
||||
# Please report any bugs to me. I wrote this yesterday, so there are no
|
||||
# guarantees about its performance. I recommend checking its output
|
||||
# carefully. If you do send a bug report, please include the failing
|
||||
# ChangeLog, so I can include it in my test suite.
|
||||
#
|
||||
# Tom
|
||||
# ---
|
||||
# tromey@busco.lanl.gov Member, League for Programming Freedom
|
||||
# Sadism and farce are always inexplicably linked.
|
||||
# -- Alexander Theroux
|
||||
|
||||
|
||||
# Month->number mapping. Used for sorting.
|
||||
%months = ('Jan', 0,
|
||||
'Feb', 1,
|
||||
'Mar', 2,
|
||||
'Apr', 3,
|
||||
'May', 4,
|
||||
'Jun', 5,
|
||||
'Jul', 6,
|
||||
'Aug', 7,
|
||||
'Sep', 8,
|
||||
'Oct', 9,
|
||||
'Nov', 10,
|
||||
'Dec', 11);
|
||||
|
||||
# If '-i' is given, do it in-place.
|
||||
if ($ARGV[0] eq '-i') {
|
||||
shift (@ARGV);
|
||||
$^I = '~';
|
||||
}
|
||||
|
||||
$lastkey = '';
|
||||
$lastval = '';
|
||||
$conf = 0;
|
||||
%conflist = ();
|
||||
|
||||
$tjd = 0;
|
||||
|
||||
# Simple state machine. The states:
|
||||
#
|
||||
# 0 Not in conflict. Just copy input to output.
|
||||
# 1 Beginning an entry. Next non-blank line is key.
|
||||
# 2 In entry. Entry beginner transitions to state 1.
|
||||
while (<>) {
|
||||
if (/^<<<</ || /^====/) {
|
||||
# Start of a conflict.
|
||||
|
||||
# Copy last key into array.
|
||||
if ($lastkey ne '') {
|
||||
$conflist{$lastkey} = $lastval;
|
||||
|
||||
$lastkey = '';
|
||||
$lastval = '';
|
||||
}
|
||||
|
||||
$conf = 1;
|
||||
} elsif (/^>>>>/) {
|
||||
# End of conflict. Output.
|
||||
|
||||
# Copy last key into array.
|
||||
if ($lastkey ne '') {
|
||||
$conflist{$lastkey} = $lastval;
|
||||
|
||||
$lastkey = '';
|
||||
$lastval = '';
|
||||
}
|
||||
|
||||
foreach (reverse sort clcmp keys %conflist) {
|
||||
print STDERR "doing $_" if $tjd;
|
||||
print $_;
|
||||
print $conflist{$_};
|
||||
}
|
||||
|
||||
$lastkey = '';
|
||||
$lastval = '';
|
||||
$conf = 0;
|
||||
%conflist = ();
|
||||
} elsif ($conf == 1) {
|
||||
# Beginning an entry. Skip empty lines. Error if not a real
|
||||
# beginner.
|
||||
if (/^$/) {
|
||||
# Empty line; just skip at this point.
|
||||
} elsif (/^[MTWFS]/) {
|
||||
# Looks like the name of a day; assume opener and move to
|
||||
# "in entry" state.
|
||||
$lastkey = $_;
|
||||
$conf = 2;
|
||||
print STDERR "found $_" if $tjd;
|
||||
} else {
|
||||
die ("conflict crosses entry boundaries: $_");
|
||||
}
|
||||
} elsif ($conf == 2) {
|
||||
# In entry. Copy into variable until we see beginner line.
|
||||
if (/^[MTWFS]/) {
|
||||
# Entry beginner line.
|
||||
|
||||
# Copy last key into array.
|
||||
if ($lastkey ne '') {
|
||||
$conflist{$lastkey} = $lastval;
|
||||
|
||||
$lastkey = '';
|
||||
$lastval = '';
|
||||
}
|
||||
|
||||
$lastkey = $_;
|
||||
print STDERR "found $_" if $tjd;
|
||||
$lastval = '';
|
||||
} else {
|
||||
$lastval .= $_;
|
||||
}
|
||||
} else {
|
||||
# Just copy.
|
||||
print;
|
||||
}
|
||||
}
|
||||
|
||||
# Compare ChangeLog time strings like <=>.
|
||||
#
|
||||
# 0 1 2 3
|
||||
# Thu Aug 11 13:22:42 1994 Tom Tromey (tromey@creche.colorado.edu)
|
||||
# 0123456789012345678901234567890
|
||||
#
|
||||
sub clcmp {
|
||||
# First check year.
|
||||
$r = substr ($a, 20, 4) <=> substr ($b, 20, 4);
|
||||
|
||||
# Now check month.
|
||||
$r = $months{substr ($a, 4, 3)} <=> $months{substr ($b, 4, 3)} if !$r;
|
||||
|
||||
# Now check day.
|
||||
$r = substr ($a, 8, 2) <=> substr ($b, 8, 2) if !$r;
|
||||
|
||||
# Now check time (3 parts).
|
||||
$r = substr ($a, 11, 2) <=> substr ($b, 11, 2) if !$r;
|
||||
$r = substr ($a, 14, 2) <=> substr ($b, 14, 2) if !$r;
|
||||
$r = substr ($a, 17, 2) <=> substr ($b, 17, 2) if !$r;
|
||||
|
||||
$r;
|
||||
}
|
||||
|
|
@ -1,91 +0,0 @@
|
|||
#! xPERL_PATHx
|
||||
# -*-Perl-*-
|
||||
#
|
||||
# Contributed by David G. Grubbs <dgg@ksr.com>
|
||||
#
|
||||
# Clean up the history file. 10 Record types: MAR OFT WUCG
|
||||
#
|
||||
# WUCG records are thrown out.
|
||||
# MAR records are retained.
|
||||
# T records: retain only last tag with same combined tag/module.
|
||||
#
|
||||
# Two passes: Walk through the first time and remember the
|
||||
# 1. Last Tag record with same "tag" and "module" names.
|
||||
# 2. Last O record with unique user/module/directory, unless followed
|
||||
# by a matching F record.
|
||||
#
|
||||
|
||||
$r = $ENV{"CVSROOT"};
|
||||
$c = "$r/CVSROOT";
|
||||
$h = "$c/history";
|
||||
|
||||
eval "print STDERR \$die='Unknown parameter $1\n' if !defined \$$1; \$$1=\$';"
|
||||
while ($ARGV[0] =~ /^(\w+)=/ && shift(@ARGV));
|
||||
exit 255 if $die; # process any variable=value switches
|
||||
|
||||
%tags = ();
|
||||
%outs = ();
|
||||
|
||||
#
|
||||
# Move history file to safe place and re-initialize a new one.
|
||||
#
|
||||
rename($h, "$h.bak");
|
||||
open(XX, ">$h");
|
||||
close(XX);
|
||||
|
||||
#
|
||||
# Pass1 -- remember last tag and checkout.
|
||||
#
|
||||
open(HIST, "$h.bak");
|
||||
while (<HIST>) {
|
||||
next if /^[MARWUCG]/;
|
||||
|
||||
# Save whole line keyed by tag|module
|
||||
if (/^T/) {
|
||||
@tmp = split(/\|/, $_);
|
||||
$tags{$tmp[4] . '|' . $tmp[5]} = $_;
|
||||
}
|
||||
# Save whole line
|
||||
if (/^[OF]/) {
|
||||
@tmp = split(/\|/, $_);
|
||||
$outs{$tmp[1] . '|' . $tmp[2] . '|' . $tmp[5]} = $_;
|
||||
}
|
||||
}
|
||||
|
||||
#
|
||||
# Pass2 -- print out what we want to save.
|
||||
#
|
||||
open(SAVE, ">$h.work");
|
||||
open(HIST, "$h.bak");
|
||||
while (<HIST>) {
|
||||
next if /^[FWUCG]/;
|
||||
|
||||
# If whole line matches saved (i.e. "last") one, print it.
|
||||
if (/^T/) {
|
||||
@tmp = split(/\|/, $_);
|
||||
next if $tags{$tmp[4] . '|' . $tmp[5]} ne $_;
|
||||
}
|
||||
# Save whole line
|
||||
if (/^O/) {
|
||||
@tmp = split(/\|/, $_);
|
||||
next if $outs{$tmp[1] . '|' . $tmp[2] . '|' . $tmp[5]} ne $_;
|
||||
}
|
||||
|
||||
print SAVE $_;
|
||||
}
|
||||
|
||||
#
|
||||
# Put back the saved stuff
|
||||
#
|
||||
system "cat $h >> $h.work";
|
||||
|
||||
if (-s $h) {
|
||||
rename ($h, "$h.interim");
|
||||
print "history.interim has non-zero size.\n";
|
||||
} else {
|
||||
unlink($h);
|
||||
}
|
||||
|
||||
rename ("$h.work", $h);
|
||||
|
||||
exit(0);
|
||||
|
|
@ -1,215 +0,0 @@
|
|||
#! xPERL_PATHx
|
||||
# -*-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);
|
||||
|
|
@ -1,141 +0,0 @@
|
|||
#! xPERL_PATHx
|
||||
# -*-Perl-*-
|
||||
#
|
||||
# Access control lists for CVS. dgg@ksr.com (David G. Grubbs)
|
||||
#
|
||||
# CVS "commitinfo" for matching repository names, running the program it finds
|
||||
# on the same line. More information is available in the CVS man pages.
|
||||
#
|
||||
# ==== INSTALLATION:
|
||||
#
|
||||
# To use this program as I intended, do the following four things:
|
||||
#
|
||||
# 0. Install PERL. :-)
|
||||
#
|
||||
# 1. Put one line, as the *only* non-comment line, in your commitinfo file:
|
||||
#
|
||||
# DEFAULT /usr/local/bin/cvs_acls
|
||||
#
|
||||
# 2. Install this file as /usr/local/bin/cvs_acls and make it executable.
|
||||
#
|
||||
# 3. Create a file named $CVSROOT/CVSROOT/avail.
|
||||
#
|
||||
# ==== FORMAT OF THE avail FILE:
|
||||
#
|
||||
# The avail file determines whether you may commit files. It contains lines
|
||||
# read from top to bottom, keeping track of a single "bit". The "bit"
|
||||
# defaults to "on". It can be turned "off" by "unavail" lines and "on" by
|
||||
# "avail" lines. ==> Last one counts.
|
||||
#
|
||||
# Any line not beginning with "avail" or "unavail" is ignored.
|
||||
#
|
||||
# Lines beginning with "avail" or "unavail" are assumed to be '|'-separated
|
||||
# triples: (All spaces and tabs are ignored in a line.)
|
||||
#
|
||||
# {avail.*,unavail.*} [| user,user,... [| repos,repos,...]]
|
||||
#
|
||||
# 1. String starting with "avail" or "unavail".
|
||||
# 2. Optional, comma-separated list of usernames.
|
||||
# 3. Optional, comma-separated list of repository pathnames.
|
||||
# These are pathnames relative to $CVSROOT. They can be directories or
|
||||
# filenames. A directory name allows access to all files and
|
||||
# directories below it.
|
||||
#
|
||||
# Example: (Text from the ';;' rightward may not appear in the file.)
|
||||
#
|
||||
# unavail ;; Make whole repository unavailable.
|
||||
# avail|dgg ;; Except for user "dgg".
|
||||
# avail|fred, john|bin/ls ;; Except when "fred" or "john" commit to
|
||||
# ;; the module whose repository is "bin/ls"
|
||||
#
|
||||
# PROGRAM LOGIC:
|
||||
#
|
||||
# CVS passes to @ARGV an absolute directory pathname (the repository
|
||||
# appended to your $CVSROOT variable), followed by a list of filenames
|
||||
# within that directory.
|
||||
#
|
||||
# We walk through the avail file looking for a line that matches both
|
||||
# the username and repository.
|
||||
#
|
||||
# A username match is simply the user's name appearing in the second
|
||||
# column of the avail line in a space-or-comma separate list.
|
||||
#
|
||||
# A repository match is either:
|
||||
# - One element of the third column matches $ARGV[0], or some
|
||||
# parent directory of $ARGV[0].
|
||||
# - Otherwise *all* file arguments ($ARGV[1..$#ARGV]) must be
|
||||
# in the file list in one avail line.
|
||||
# - In other words, using directory names in the third column of
|
||||
# the avail file allows committing of any file (or group of
|
||||
# files in a single commit) in the tree below that directory.
|
||||
# - If individual file names are used in the third column of
|
||||
# the avail file, then files must be committed individually or
|
||||
# all files specified in a single commit must all appear in
|
||||
# third column of a single avail line.
|
||||
#
|
||||
|
||||
$debug = 0;
|
||||
$cvsroot = $ENV{'CVSROOT'};
|
||||
$availfile = $cvsroot . "/CVSROOT/avail";
|
||||
$myname = $ENV{"USER"} if !($myname = $ENV{"LOGNAME"});
|
||||
|
||||
eval "print STDERR \$die='Unknown parameter $1\n' if !defined \$$1; \$$1=\$';"
|
||||
while ($ARGV[0] =~ /^(\w+)=/ && shift(@ARGV));
|
||||
exit 255 if $die; # process any variable=value switches
|
||||
|
||||
die "Must set CVSROOT\n" if !$cvsroot;
|
||||
($repos = shift) =~ s:^$cvsroot/::;
|
||||
grep($_ = $repos . '/' . $_, @ARGV);
|
||||
|
||||
print "$$ Repos: $repos\n","$$ ==== ",join("\n$$ ==== ",@ARGV),"\n" if $debug;
|
||||
|
||||
$exit_val = 0; # Good Exit value
|
||||
|
||||
$universal_off = 0;
|
||||
open (AVAIL, $availfile) || exit(0); # It is ok for avail file not to exist
|
||||
while (<AVAIL>) {
|
||||
chop;
|
||||
next if /^\s*\#/;
|
||||
next if /^\s*$/;
|
||||
($flagstr, $u, $m) = split(/[\s,]*\|[\s,]*/, $_);
|
||||
|
||||
# Skip anything not starting with "avail" or "unavail" and complain.
|
||||
(print "Bad avail line: $_\n"), next
|
||||
if ($flagstr !~ /^avail/ && $flagstr !~ /^unavail/);
|
||||
|
||||
# Set which bit we are playing with. ('0' is OK == Available).
|
||||
$flag = (($& eq "avail") ? 0 : 1);
|
||||
|
||||
# If we find a "universal off" flag (i.e. a simple "unavail") remember it
|
||||
$universal_off = 1 if ($flag && !$u && !$m);
|
||||
|
||||
# $myname considered "in user list" if actually in list or is NULL
|
||||
$in_user = (!$u || grep ($_ eq $myname, split(/[\s,]+/,$u)));
|
||||
print "$$ \$myname($myname) in user list: $_\n" if $debug && $in_user;
|
||||
|
||||
# Module matches if it is a NULL module list in the avail line. If module
|
||||
# list is not null, we check every argument combination.
|
||||
if (!($in_repo = !$m)) {
|
||||
@tmp = split(/[\s,]+/,$m);
|
||||
for $j (@tmp) {
|
||||
# If the repos from avail is a parent(or equal) dir of $repos, OK
|
||||
$in_repo = 1, last if ($repos eq $j || $repos =~ /^$j\//);
|
||||
}
|
||||
if (!$in_repo) {
|
||||
$in_repo = 1;
|
||||
for $j (@ARGV) {
|
||||
last if !($in_repo = grep ($_ eq $j, @tmp));
|
||||
}
|
||||
}
|
||||
}
|
||||
print "$$ \$repos($repos) in repository list: $_\n" if $debug && $in_repo;
|
||||
|
||||
$exit_val = $flag if ($in_user && $in_repo);
|
||||
print "$$ ==== \$exit_val = $exit_val\n$$ ==== \$flag = $flag\n" if $debug;
|
||||
}
|
||||
close(AVAIL);
|
||||
print "$$ ==== \$exit_val = $exit_val\n" if $debug;
|
||||
print "**** Access denied: Insufficient Karma ($myname|$repos)\n" if $exit_val;
|
||||
print "**** Access allowed: Personal Karma exceeds Environmental Karma.\n"
|
||||
if $universal_off && !$exit_val;
|
||||
exit($exit_val);
|
||||
|
|
@ -1,182 +0,0 @@
|
|||
#! xPERL_PATHx
|
||||
# -*-Perl-*-
|
||||
#
|
||||
# XXX: FIXME: handle multiple '-f logfile' arguments
|
||||
#
|
||||
# XXX -- I HATE Perl! This *will* be re-written in shell/awk/sed soon!
|
||||
#
|
||||
|
||||
# Usage: log.pl [-u user] [[-m mailto] ...] [-s] -f logfile 'dirname file ...'
|
||||
#
|
||||
# -u user - $USER passed from loginfo
|
||||
# -m mailto - for each user to receive cvs log reports
|
||||
# (multiple -m's permitted)
|
||||
# -s - to prevent "cvs status -v" messages
|
||||
# -f logfile - for the logfile to append to (mandatory,
|
||||
# but only one logfile can be specified).
|
||||
|
||||
# here is what the output looks like:
|
||||
#
|
||||
# From: woods@kuma.domain.top
|
||||
# Subject: CVS update: testmodule
|
||||
#
|
||||
# Date: Wednesday November 23, 1994 @ 14:15
|
||||
# Author: woods
|
||||
#
|
||||
# Update of /local/src-CVS/testmodule
|
||||
# In directory kuma:/home/kuma/woods/work.d/testmodule
|
||||
#
|
||||
# Modified Files:
|
||||
# test3
|
||||
# Added Files:
|
||||
# test6
|
||||
# Removed Files:
|
||||
# test4
|
||||
# Log Message:
|
||||
# - wow, what a test
|
||||
#
|
||||
# (and for each file the "cvs status -v" output is appended unless -s is used)
|
||||
#
|
||||
# ==================================================================
|
||||
# File: test3 Status: Up-to-date
|
||||
#
|
||||
# Working revision: 1.41 Wed Nov 23 14:15:59 1994
|
||||
# Repository revision: 1.41 /local/src-CVS/cvs/testmodule/test3,v
|
||||
# Sticky Options: -ko
|
||||
#
|
||||
# Existing Tags:
|
||||
# local-v2 (revision: 1.7)
|
||||
# local-v1 (revision: 1.1.1.2)
|
||||
# CVS-1_4A2 (revision: 1.1.1.2)
|
||||
# local-v0 (revision: 1.2)
|
||||
# CVS-1_4A1 (revision: 1.1.1.1)
|
||||
# CVS (branch: 1.1.1)
|
||||
|
||||
$cvsroot = $ENV{'CVSROOT'};
|
||||
|
||||
# turn off setgid
|
||||
#
|
||||
$) = $(;
|
||||
|
||||
$dostatus = 1;
|
||||
|
||||
# parse command line arguments
|
||||
#
|
||||
while (@ARGV) {
|
||||
$arg = shift @ARGV;
|
||||
|
||||
if ($arg eq '-m') {
|
||||
$users = "$users " . shift @ARGV;
|
||||
} elsif ($arg eq '-u') {
|
||||
$login = shift @ARGV;
|
||||
} elsif ($arg eq '-f') {
|
||||
($logfile) && die "Too many '-f' args";
|
||||
$logfile = shift @ARGV;
|
||||
} elsif ($arg eq '-s') {
|
||||
$dostatus = 0;
|
||||
} else {
|
||||
($donefiles) && die "Too many arguments!\n";
|
||||
$donefiles = 1;
|
||||
@files = split(/ /, $arg);
|
||||
}
|
||||
}
|
||||
|
||||
# the first argument is the module location relative to $CVSROOT
|
||||
#
|
||||
$modulepath = shift @files;
|
||||
|
||||
$mailcmd = "| Mail -s 'CVS update: $modulepath'";
|
||||
|
||||
# Initialise some date and time arrays
|
||||
#
|
||||
@mos = (January,February,March,April,May,June,July,August,September,
|
||||
October,November,December);
|
||||
@days = (Sunday,Monday,Tuesday,Wednesday,Thursday,Friday,Saturday);
|
||||
|
||||
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime;
|
||||
$year += 1900;
|
||||
|
||||
# get a login name for the guy doing the commit....
|
||||
#
|
||||
if ($login eq '') {
|
||||
$login = getlogin || (getpwuid($<))[0] || "nobody";
|
||||
}
|
||||
|
||||
# open log file for appending
|
||||
#
|
||||
open(OUT, ">>" . $logfile) || die "Could not open(" . $logfile . "): $!\n";
|
||||
|
||||
# send mail, if there's anyone to send to!
|
||||
#
|
||||
if ($users) {
|
||||
$mailcmd = "$mailcmd $users";
|
||||
open(MAIL, $mailcmd) || die "Could not Exec($mailcmd): $!\n";
|
||||
}
|
||||
|
||||
# print out the log Header
|
||||
#
|
||||
print OUT "\n";
|
||||
print OUT "****************************************\n";
|
||||
print OUT "Date:\t$days[$wday] $mos[$mon] $mday, $year @ $hour:" . sprintf("%02d", $min) . "\n";
|
||||
print OUT "Author:\t$login\n\n";
|
||||
|
||||
if (MAIL) {
|
||||
print MAIL "\n";
|
||||
print MAIL "Date:\t$days[$wday] $mos[$mon] $mday, $year @ $hour:" . sprintf("%02d", $min) . "\n";
|
||||
print MAIL "Author:\t$login\n\n";
|
||||
}
|
||||
|
||||
# print the stuff from logmsg that comes in on stdin to the logfile
|
||||
#
|
||||
open(IN, "-");
|
||||
while (<IN>) {
|
||||
print OUT $_;
|
||||
if (MAIL) {
|
||||
print MAIL $_;
|
||||
}
|
||||
}
|
||||
close(IN);
|
||||
|
||||
print OUT "\n";
|
||||
|
||||
# after log information, do an 'cvs -Qq status -v' on each file in the arguments.
|
||||
#
|
||||
if ($dostatus != 0) {
|
||||
while (@files) {
|
||||
$file = shift @files;
|
||||
if ($file eq "-") {
|
||||
print OUT "[input file was '-']\n";
|
||||
if (MAIL) {
|
||||
print MAIL "[input file was '-']\n";
|
||||
}
|
||||
last;
|
||||
}
|
||||
$pid = open(RCS, "-|");
|
||||
if ( !defined $pid )
|
||||
{
|
||||
die "fork failed: $!";
|
||||
}
|
||||
if ($pid == 0)
|
||||
{
|
||||
exec 'cvs', '-nQq', 'status', '-v', $file;
|
||||
die "cvs exec failed: $!";
|
||||
}
|
||||
while (<RCS>) {
|
||||
print OUT;
|
||||
if (MAIL) {
|
||||
print MAIL;
|
||||
}
|
||||
}
|
||||
close(RCS);
|
||||
}
|
||||
}
|
||||
|
||||
close(OUT);
|
||||
die "Write to $logfile failed" if $?;
|
||||
|
||||
close(MAIL);
|
||||
die "Pipe to $mailcmd failed" if $?;
|
||||
|
||||
## must exit cleanly
|
||||
##
|
||||
exit 0;
|
||||
|
|
@ -1,576 +0,0 @@
|
|||
#! xPERL_PATHx
|
||||
# -*-Perl-*-
|
||||
#
|
||||
# Perl filter to handle the log messages from the checkin of files in
|
||||
# a directory. This script will group the lists of files by log
|
||||
# message, and mail a single consolidated log message at the end of
|
||||
# the commit.
|
||||
#
|
||||
# This file assumes a pre-commit checking program that leaves the
|
||||
# names of the first and last commit directories in a temporary file.
|
||||
#
|
||||
# Contributed by David Hampton <hampton@cisco.com>
|
||||
#
|
||||
# hacked greatly by Greg A. Woods <woods@planix.com>
|
||||
|
||||
# Usage: log_accum.pl [-d] [-s] [-w] [-M module] [-u user] [[-m mailto] ...] [[-R replyto] ...] [-f logfile]
|
||||
# -d - turn on debugging
|
||||
# -m mailto - send mail to "mailto" (multiple)
|
||||
# -R replyto - set the "Reply-To:" to "replyto" (multiple)
|
||||
# -M modulename - set module name to "modulename"
|
||||
# -f logfile - write commit messages to logfile too
|
||||
# -s - *don't* run "cvs status -v" for each file
|
||||
# -w - show working directory with log message
|
||||
# -u user - $USER passed from loginfo
|
||||
|
||||
#
|
||||
# Configurable options
|
||||
#
|
||||
|
||||
# set this to something that takes a whole message on stdin
|
||||
$MAILER = "/usr/lib/sendmail -t";
|
||||
|
||||
#
|
||||
# End user configurable options.
|
||||
#
|
||||
|
||||
# Constants (don't change these!)
|
||||
#
|
||||
$STATE_NONE = 0;
|
||||
$STATE_CHANGED = 1;
|
||||
$STATE_ADDED = 2;
|
||||
$STATE_REMOVED = 3;
|
||||
$STATE_LOG = 4;
|
||||
|
||||
$LAST_FILE = "/tmp/#cvs.lastdir";
|
||||
|
||||
$CHANGED_FILE = "/tmp/#cvs.files.changed";
|
||||
$ADDED_FILE = "/tmp/#cvs.files.added";
|
||||
$REMOVED_FILE = "/tmp/#cvs.files.removed";
|
||||
$LOG_FILE = "/tmp/#cvs.files.log";
|
||||
|
||||
$FILE_PREFIX = "#cvs.files";
|
||||
|
||||
#
|
||||
# Subroutines
|
||||
#
|
||||
|
||||
sub cleanup_tmpfiles {
|
||||
local($wd, @files);
|
||||
|
||||
$wd = `pwd`;
|
||||
chdir("/tmp") || die("Can't chdir('/tmp')\n");
|
||||
opendir(DIR, ".");
|
||||
push(@files, grep(/^$FILE_PREFIX\..*\.$id$/, readdir(DIR)));
|
||||
closedir(DIR);
|
||||
foreach (@files) {
|
||||
unlink $_;
|
||||
}
|
||||
unlink $LAST_FILE . "." . $id;
|
||||
|
||||
chdir($wd);
|
||||
}
|
||||
|
||||
sub write_logfile {
|
||||
local($filename, @lines) = @_;
|
||||
|
||||
open(FILE, ">$filename") || die("Cannot open log file $filename.\n");
|
||||
print FILE join("\n", @lines), "\n";
|
||||
close(FILE);
|
||||
}
|
||||
|
||||
sub append_to_logfile {
|
||||
local($filename, @lines) = @_;
|
||||
|
||||
open(FILE, ">$filename") || die("Cannot open log file $filename.\n");
|
||||
print FILE join("\n", @lines), "\n";
|
||||
close(FILE);
|
||||
}
|
||||
|
||||
sub format_names {
|
||||
local($dir, @files) = @_;
|
||||
local(@lines);
|
||||
|
||||
$format = "\t%-" . sprintf("%d", length($dir)) . "s%s ";
|
||||
|
||||
$lines[0] = sprintf($format, $dir, ":");
|
||||
|
||||
if ($debug) {
|
||||
print STDERR "format_names(): dir = ", $dir, "; files = ", join(":", @files), ".\n";
|
||||
}
|
||||
foreach $file (@files) {
|
||||
if (length($lines[$#lines]) + length($file) > 65) {
|
||||
$lines[++$#lines] = sprintf($format, " ", " ");
|
||||
}
|
||||
$lines[$#lines] .= $file . " ";
|
||||
}
|
||||
|
||||
@lines;
|
||||
}
|
||||
|
||||
sub format_lists {
|
||||
local(@lines) = @_;
|
||||
local(@text, @files, $lastdir);
|
||||
|
||||
if ($debug) {
|
||||
print STDERR "format_lists(): ", join(":", @lines), "\n";
|
||||
}
|
||||
@text = ();
|
||||
@files = ();
|
||||
$lastdir = shift @lines; # first thing is always a directory
|
||||
if ($lastdir !~ /.*\/$/) {
|
||||
die("Damn, $lastdir doesn't look like a directory!\n");
|
||||
}
|
||||
foreach $line (@lines) {
|
||||
if ($line =~ /.*\/$/) {
|
||||
push(@text, &format_names($lastdir, @files));
|
||||
$lastdir = $line;
|
||||
@files = ();
|
||||
} else {
|
||||
push(@files, $line);
|
||||
}
|
||||
}
|
||||
push(@text, &format_names($lastdir, @files));
|
||||
|
||||
@text;
|
||||
}
|
||||
|
||||
sub append_names_to_file {
|
||||
local($filename, $dir, @files) = @_;
|
||||
|
||||
if (@files) {
|
||||
open(FILE, ">>$filename") || die("Cannot open file $filename.\n");
|
||||
print FILE $dir, "\n";
|
||||
print FILE join("\n", @files), "\n";
|
||||
close(FILE);
|
||||
}
|
||||
}
|
||||
|
||||
sub read_line {
|
||||
local($line);
|
||||
local($filename) = @_;
|
||||
|
||||
open(FILE, "<$filename") || die("Cannot open file $filename.\n");
|
||||
$line = <FILE>;
|
||||
close(FILE);
|
||||
chop($line);
|
||||
$line;
|
||||
}
|
||||
|
||||
sub read_logfile {
|
||||
local(@text);
|
||||
local($filename, $leader) = @_;
|
||||
|
||||
open(FILE, "<$filename");
|
||||
while (<FILE>) {
|
||||
chop;
|
||||
push(@text, $leader.$_);
|
||||
}
|
||||
close(FILE);
|
||||
@text;
|
||||
}
|
||||
|
||||
sub build_header {
|
||||
local($header);
|
||||
local($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
|
||||
$header = sprintf("CVSROOT:\t%s\nModule name:\t%s\nRepository:\t%s\nChanges by:\t%s@%s\t%02d/%02d/%02d %02d:%02d:%02d",
|
||||
$cvsroot,
|
||||
$modulename,
|
||||
$dir,
|
||||
$login, $hostdomain,
|
||||
$year%100, $mon+1, $mday,
|
||||
$hour, $min, $sec);
|
||||
}
|
||||
|
||||
sub mail_notification {
|
||||
local(@text) = @_;
|
||||
|
||||
# if only we had strftime()... stuff stolen from perl's ctime.pl:
|
||||
local($[) = 0;
|
||||
|
||||
@DoW = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
|
||||
@MoY = ('Jan','Feb','Mar','Apr','May','Jun',
|
||||
'Jul','Aug','Sep','Oct','Nov','Dec');
|
||||
|
||||
# Determine what time zone is in effect.
|
||||
# Use GMT if TZ is defined as null, local time if TZ undefined.
|
||||
# There's no portable way to find the system default timezone.
|
||||
#
|
||||
$TZ = defined($ENV{'TZ'}) ? ( $ENV{'TZ'} ? $ENV{'TZ'} : 'GMT' ) : '';
|
||||
|
||||
# Hack to deal with 'PST8PDT' format of TZ
|
||||
# Note that this can't deal with all the esoteric forms, but it
|
||||
# does recognize the most common: [:]STDoff[DST[off][,rule]]
|
||||
#
|
||||
if ($TZ =~ /^([^:\d+\-,]{3,})([+-]?\d{1,2}(:\d{1,2}){0,2})([^\d+\-,]{3,})?/) {
|
||||
$TZ = $isdst ? $4 : $1;
|
||||
$tzoff = sprintf("%05d", -($2) * 100);
|
||||
}
|
||||
|
||||
# perl-4.036 doesn't have the $zone or $gmtoff...
|
||||
($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst, $zone, $gmtoff) =
|
||||
($TZ eq 'GMT') ? gmtime(time) : localtime(time);
|
||||
|
||||
$year += ($year < 70) ? 2000 : 1900;
|
||||
|
||||
if ($gmtoff != 0) {
|
||||
$tzoff = sprintf("%05d", ($gmtoff / 60) * 100);
|
||||
}
|
||||
if ($zone ne '') {
|
||||
$TZ = $zone;
|
||||
}
|
||||
|
||||
# ok, let's try....
|
||||
$rfc822date = sprintf("%s, %2d %s %4d %2d:%02d:%02d %s (%s)",
|
||||
$DoW[$wday], $mday, $MoY[$mon], $year,
|
||||
$hour, $min, $sec, $tzoff, $TZ);
|
||||
|
||||
open(MAIL, "| $MAILER");
|
||||
print MAIL "Date: " . $rfc822date . "\n";
|
||||
print MAIL "Subject: CVS Update: " . $modulename . "\n";
|
||||
print MAIL "To: " . $mailto . "\n";
|
||||
print MAIL "Reply-To: " . $replyto . "\n";
|
||||
print MAIL "\n";
|
||||
print MAIL join("\n", @text), "\n";
|
||||
close(MAIL);
|
||||
}
|
||||
|
||||
sub write_commitlog {
|
||||
local($logfile, @text) = @_;
|
||||
|
||||
open(FILE, ">>$logfile");
|
||||
print FILE join("\n", @text), "\n";
|
||||
close(FILE);
|
||||
}
|
||||
|
||||
#
|
||||
# Main Body
|
||||
#
|
||||
|
||||
# Initialize basic variables
|
||||
#
|
||||
$debug = 0;
|
||||
$id = getpgrp(); # note, you *must* use a shell which does setpgrp()
|
||||
$state = $STATE_NONE;
|
||||
chop($hostname = `hostname`);
|
||||
chop($domainname = `domainname`);
|
||||
if ($domainname !~ '^\..*') {
|
||||
$domainname = '.' . $domainname;
|
||||
}
|
||||
$hostdomain = $hostname . $domainname;
|
||||
$cvsroot = $ENV{'CVSROOT'};
|
||||
$do_status = 1; # moderately useful
|
||||
$show_wd = 0; # useless in client/server
|
||||
$modulename = "";
|
||||
|
||||
# parse command line arguments (file list is seen as one arg)
|
||||
#
|
||||
while (@ARGV) {
|
||||
$arg = shift @ARGV;
|
||||
|
||||
if ($arg eq '-d') {
|
||||
$debug = 1;
|
||||
print STDERR "Debug turned on...\n";
|
||||
} elsif ($arg eq '-m') {
|
||||
if ($mailto eq '') {
|
||||
$mailto = shift @ARGV;
|
||||
} else {
|
||||
$mailto = $mailto . ", " . shift @ARGV;
|
||||
}
|
||||
} elsif ($arg eq '-R') {
|
||||
if ($replyto eq '') {
|
||||
$replyto = shift @ARGV;
|
||||
} else {
|
||||
$replyto = $replyto . ", " . shift @ARGV;
|
||||
}
|
||||
} elsif ($arg eq '-M') {
|
||||
$modulename = shift @ARGV;
|
||||
} elsif ($arg eq '-u') {
|
||||
$login = shift @ARGV;
|
||||
} elsif ($arg eq '-s') {
|
||||
$do_status = 0;
|
||||
} elsif ($arg eq '-w') {
|
||||
$show_wd = 1;
|
||||
} elsif ($arg eq '-f') {
|
||||
($commitlog) && die("Too many '-f' args\n");
|
||||
$commitlog = shift @ARGV;
|
||||
} else {
|
||||
($donefiles) && die("Too many arguments! Check usage.\n");
|
||||
$donefiles = 1;
|
||||
@files = split(/ /, $arg);
|
||||
}
|
||||
}
|
||||
if ($login eq '') {
|
||||
$login = getlogin || (getpwuid($<))[0] || "nobody";
|
||||
}
|
||||
($mailto) || die("No mail recipient specified (use -m)\n");
|
||||
if ($replyto eq '') {
|
||||
$replyto = $login;
|
||||
}
|
||||
|
||||
# for now, the first "file" is the repository directory being committed,
|
||||
# relative to the $CVSROOT location
|
||||
#
|
||||
@path = split('/', $files[0]);
|
||||
|
||||
# XXX There are some ugly assumptions in here about module names and
|
||||
# XXX directories relative to the $CVSROOT location -- really should
|
||||
# XXX read $CVSROOT/CVSROOT/modules, but that's not so easy to do, since
|
||||
# XXX we have to parse it backwards.
|
||||
# XXX
|
||||
# XXX Fortunately it's relatively easy for the user to specify the
|
||||
# XXX module name as appropriate with a '-M' via the directory
|
||||
# XXX matching in loginfo.
|
||||
#
|
||||
if ($modulename eq "") {
|
||||
$modulename = $path[0]; # I.e. the module name == top-level dir
|
||||
}
|
||||
if ($#path == 0) {
|
||||
$dir = ".";
|
||||
} else {
|
||||
$dir = join('/', @path);
|
||||
}
|
||||
$dir = $dir . "/";
|
||||
|
||||
if ($debug) {
|
||||
print STDERR "module - ", $modulename, "\n";
|
||||
print STDERR "dir - ", $dir, "\n";
|
||||
print STDERR "path - ", join(":", @path), "\n";
|
||||
print STDERR "files - ", join(":", @files), "\n";
|
||||
print STDERR "id - ", $id, "\n";
|
||||
}
|
||||
|
||||
# Check for a new directory first. This appears with files set as follows:
|
||||
#
|
||||
# files[0] - "path/name/newdir"
|
||||
# files[1] - "-"
|
||||
# files[2] - "New"
|
||||
# files[3] - "directory"
|
||||
#
|
||||
if ($files[2] =~ /New/ && $files[3] =~ /directory/) {
|
||||
local(@text);
|
||||
|
||||
@text = ();
|
||||
push(@text, &build_header());
|
||||
push(@text, "");
|
||||
push(@text, $files[0]);
|
||||
push(@text, "");
|
||||
|
||||
while (<STDIN>) {
|
||||
chop; # Drop the newline
|
||||
push(@text, $_);
|
||||
}
|
||||
|
||||
&mail_notification($mailto, @text);
|
||||
|
||||
exit 0;
|
||||
}
|
||||
|
||||
# Check for an import command. This appears with files set as follows:
|
||||
#
|
||||
# files[0] - "path/name"
|
||||
# files[1] - "-"
|
||||
# files[2] - "Imported"
|
||||
# files[3] - "sources"
|
||||
#
|
||||
if ($files[2] =~ /Imported/ && $files[3] =~ /sources/) {
|
||||
local(@text);
|
||||
|
||||
@text = ();
|
||||
push(@text, &build_header());
|
||||
push(@text, "");
|
||||
push(@text, $files[0]);
|
||||
push(@text, "");
|
||||
|
||||
while (<STDIN>) {
|
||||
chop; # Drop the newline
|
||||
push(@text, $_);
|
||||
}
|
||||
|
||||
&mail_notification(@text);
|
||||
|
||||
exit 0;
|
||||
}
|
||||
|
||||
# Iterate over the body of the message collecting information.
|
||||
#
|
||||
while (<STDIN>) {
|
||||
chop; # Drop the newline
|
||||
|
||||
if (/^In directory/) {
|
||||
if ($show_wd) { # useless in client/server mode
|
||||
push(@log_lines, $_);
|
||||
push(@log_lines, "");
|
||||
}
|
||||
next;
|
||||
}
|
||||
|
||||
if (/^Modified Files/) { $state = $STATE_CHANGED; next; }
|
||||
if (/^Added Files/) { $state = $STATE_ADDED; next; }
|
||||
if (/^Removed Files/) { $state = $STATE_REMOVED; next; }
|
||||
if (/^Log Message/) { $state = $STATE_LOG; next; }
|
||||
|
||||
s/^[ \t\n]+//; # delete leading whitespace
|
||||
s/[ \t\n]+$//; # delete trailing whitespace
|
||||
|
||||
if ($state == $STATE_CHANGED) { push(@changed_files, split); }
|
||||
if ($state == $STATE_ADDED) { push(@added_files, split); }
|
||||
if ($state == $STATE_REMOVED) { push(@removed_files, split); }
|
||||
if ($state == $STATE_LOG) { push(@log_lines, $_); }
|
||||
}
|
||||
|
||||
# Strip leading and trailing blank lines from the log message. Also
|
||||
# compress multiple blank lines in the body of the message down to a
|
||||
# single blank line.
|
||||
#
|
||||
while ($#log_lines > -1) {
|
||||
last if ($log_lines[0] ne "");
|
||||
shift(@log_lines);
|
||||
}
|
||||
while ($#log_lines > -1) {
|
||||
last if ($log_lines[$#log_lines] ne "");
|
||||
pop(@log_lines);
|
||||
}
|
||||
for ($i = $#log_lines; $i > 0; $i--) {
|
||||
if (($log_lines[$i - 1] eq "") && ($log_lines[$i] eq "")) {
|
||||
splice(@log_lines, $i, 1);
|
||||
}
|
||||
}
|
||||
|
||||
if ($debug) {
|
||||
print STDERR "Searching for log file index...";
|
||||
}
|
||||
# Find an index to a log file that matches this log message
|
||||
#
|
||||
for ($i = 0; ; $i++) {
|
||||
local(@text);
|
||||
|
||||
last if (! -e "$LOG_FILE.$i.$id"); # the next available one
|
||||
@text = &read_logfile("$LOG_FILE.$i.$id", "");
|
||||
last if ($#text == -1); # nothing in this file, use it
|
||||
last if (join(" ", @log_lines) eq join(" ", @text)); # it's the same log message as another
|
||||
}
|
||||
if ($debug) {
|
||||
print STDERR " found log file at $i.$id, now writing tmp files.\n";
|
||||
}
|
||||
|
||||
# Spit out the information gathered in this pass.
|
||||
#
|
||||
&append_names_to_file("$CHANGED_FILE.$i.$id", $dir, @changed_files);
|
||||
&append_names_to_file("$ADDED_FILE.$i.$id", $dir, @added_files);
|
||||
&append_names_to_file("$REMOVED_FILE.$i.$id", $dir, @removed_files);
|
||||
&write_logfile("$LOG_FILE.$i.$id", @log_lines);
|
||||
|
||||
# Check whether this is the last directory. If not, quit.
|
||||
#
|
||||
if ($debug) {
|
||||
print STDERR "Checking current dir against last dir.\n";
|
||||
}
|
||||
$_ = &read_line("$LAST_FILE.$id");
|
||||
|
||||
if ($_ ne $cvsroot . "/" . $files[0]) {
|
||||
if ($debug) {
|
||||
print STDERR sprintf("Current directory %s is not last directory %s.\n", $cvsroot . "/" .$files[0], $_);
|
||||
}
|
||||
exit 0;
|
||||
}
|
||||
if ($debug) {
|
||||
print STDERR sprintf("Current directory %s is last directory %s -- all commits done.\n", $files[0], $_);
|
||||
}
|
||||
|
||||
#
|
||||
# End Of Commits!
|
||||
#
|
||||
|
||||
# This is it. The commits are all finished. Lump everything together
|
||||
# into a single message, fire a copy off to the mailing list, and drop
|
||||
# it on the end of the Changes file.
|
||||
#
|
||||
|
||||
#
|
||||
# Produce the final compilation of the log messages
|
||||
#
|
||||
@text = ();
|
||||
@status_txt = ();
|
||||
push(@text, &build_header());
|
||||
push(@text, "");
|
||||
|
||||
for ($i = 0; ; $i++) {
|
||||
last if (! -e "$LOG_FILE.$i.$id"); # we're done them all!
|
||||
@lines = &read_logfile("$CHANGED_FILE.$i.$id", "");
|
||||
if ($#lines >= 0) {
|
||||
push(@text, "Modified files:");
|
||||
push(@text, &format_lists(@lines));
|
||||
}
|
||||
@lines = &read_logfile("$ADDED_FILE.$i.$id", "");
|
||||
if ($#lines >= 0) {
|
||||
push(@text, "Added files:");
|
||||
push(@text, &format_lists(@lines));
|
||||
}
|
||||
@lines = &read_logfile("$REMOVED_FILE.$i.$id", "");
|
||||
if ($#lines >= 0) {
|
||||
push(@text, "Removed files:");
|
||||
push(@text, &format_lists(@lines));
|
||||
}
|
||||
if ($#text >= 0) {
|
||||
push(@text, "");
|
||||
}
|
||||
@lines = &read_logfile("$LOG_FILE.$i.$id", "\t");
|
||||
if ($#lines >= 0) {
|
||||
push(@text, "Log message:");
|
||||
push(@text, @lines);
|
||||
push(@text, "");
|
||||
}
|
||||
if ($do_status) {
|
||||
local(@changed_files);
|
||||
|
||||
@changed_files = ();
|
||||
push(@changed_files, &read_logfile("$CHANGED_FILE.$i.$id", ""));
|
||||
push(@changed_files, &read_logfile("$ADDED_FILE.$i.$id", ""));
|
||||
push(@changed_files, &read_logfile("$REMOVED_FILE.$i.$id", ""));
|
||||
|
||||
if ($debug) {
|
||||
print STDERR "main: pre-sort changed_files = ", join(":", @changed_files), ".\n";
|
||||
}
|
||||
sort(@changed_files);
|
||||
if ($debug) {
|
||||
print STDERR "main: post-sort changed_files = ", join(":", @changed_files), ".\n";
|
||||
}
|
||||
|
||||
foreach $dofile (@changed_files) {
|
||||
if ($dofile =~ /\/$/) {
|
||||
next; # ignore the silly "dir" entries
|
||||
}
|
||||
if ($debug) {
|
||||
print STDERR "main(): doing 'cvs -nQq status -v $dofile'\n";
|
||||
}
|
||||
open(STATUS, "-|") || exec 'cvs', '-nQq', 'status', '-v', $dofile;
|
||||
while (<STATUS>) {
|
||||
chop;
|
||||
push(@status_txt, $_);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Write to the commitlog file
|
||||
#
|
||||
if ($commitlog) {
|
||||
&write_commitlog($commitlog, @text);
|
||||
}
|
||||
|
||||
if ($#status_txt >= 0) {
|
||||
push(@text, @status_txt);
|
||||
}
|
||||
|
||||
# Mailout the notification.
|
||||
#
|
||||
&mail_notification(@text);
|
||||
|
||||
# cleanup
|
||||
#
|
||||
if (! $debug) {
|
||||
&cleanup_tmpfiles();
|
||||
}
|
||||
|
||||
exit 0;
|
||||
|
|
@ -1,85 +0,0 @@
|
|||
#! xPERL_PATHx
|
||||
# -*-Perl-*-
|
||||
#
|
||||
# From: clyne@niwot.scd.ucar.EDU (John Clyne)
|
||||
# Date: Fri, 28 Feb 92 09:54:21 MST
|
||||
#
|
||||
# BTW, i wrote a perl script that is similar to 'nfpipe' except that in
|
||||
# addition to logging to a file it provides a command line option for mailing
|
||||
# change notices to a group of users. Obviously you probably wouldn't want
|
||||
# to mail every change. But there may be certain directories that are commonly
|
||||
# accessed by a group of users who would benefit from an email notice.
|
||||
# Especially if they regularly beat on the same directory. Anyway if you
|
||||
# think anyone would be interested here it is.
|
||||
#
|
||||
# File: mfpipe
|
||||
#
|
||||
# Author: John Clyne
|
||||
# National Center for Atmospheric Research
|
||||
# PO 3000, Boulder, Colorado
|
||||
#
|
||||
# Date: Wed Feb 26 18:34:53 MST 1992
|
||||
#
|
||||
# Description: Tee standard input to mail a list of users and to
|
||||
# a file. Used by CVS logging.
|
||||
#
|
||||
# Usage: mfpipe [-f file] [user@host...]
|
||||
#
|
||||
# Environment: CVSROOT
|
||||
# Path to CVS root.
|
||||
#
|
||||
# Files:
|
||||
#
|
||||
#
|
||||
# Options: -f file
|
||||
# Capture output to 'file'
|
||||
#
|
||||
|
||||
$header = "Log Message:\n";
|
||||
|
||||
$mailcmd = "| mail -s 'CVS update notice'";
|
||||
$whoami = `whoami`;
|
||||
chop $whoami;
|
||||
$date = `date`;
|
||||
chop $date;
|
||||
|
||||
$cvsroot = $ENV{'CVSROOT'};
|
||||
|
||||
while (@ARGV) {
|
||||
$arg = shift @ARGV;
|
||||
|
||||
if ($arg eq '-f') {
|
||||
$file = shift @ARGV;
|
||||
}
|
||||
else {
|
||||
$users = "$users $arg";
|
||||
}
|
||||
}
|
||||
|
||||
if ($users) {
|
||||
$mailcmd = "$mailcmd $users";
|
||||
open(MAIL, $mailcmd) || die "Execing $mail: $!\n";
|
||||
}
|
||||
|
||||
if ($file) {
|
||||
$logfile = "$cvsroot/LOG/$file";
|
||||
open(FILE, ">> $logfile") || die "Opening $logfile: $!\n";
|
||||
}
|
||||
|
||||
print FILE "$whoami $date--------BEGIN LOG ENTRY-------------\n" if ($logfile);
|
||||
|
||||
while (<>) {
|
||||
print FILE $log if ($log && $logfile);
|
||||
|
||||
print FILE $_ if ($logfile);
|
||||
print MAIL $_ if ($users);
|
||||
|
||||
$log = "log: " if ($_ eq $header);
|
||||
}
|
||||
|
||||
close FILE;
|
||||
die "Write failed" if $?;
|
||||
close MAIL;
|
||||
die "Mail failed" if $?;
|
||||
|
||||
exit 0;
|
||||
|
|
@ -1,235 +0,0 @@
|
|||
#! xPERL_PATHx
|
||||
# -*-Perl-*-
|
||||
|
||||
# Author: John Rouillard (rouilj@cs.umb.edu)
|
||||
# Supported: Yeah right. (Well what do you expect for 2 hours work?)
|
||||
# Blame-to: rouilj@cs.umb.edu
|
||||
# Complaints to: Anybody except Brian Berliner, he's blameless for
|
||||
# this script.
|
||||
# Acknowlegements: The base code for this script has been acquired
|
||||
# from the log.pl script.
|
||||
|
||||
# rcslock.pl - A program to prevent commits when a file to be ckecked
|
||||
# in is locked in the repository.
|
||||
|
||||
# There are times when you need exclusive access to a file. This
|
||||
# often occurs when binaries are checked into the repository, since
|
||||
# cvs's (actually rcs's) text based merging mechanism won't work. This
|
||||
# script allows you to use the rcs lock mechanism (rcs -l) to make
|
||||
# sure that no changes to a repository are able to be committed if
|
||||
# those changes would result in a locked file being changed.
|
||||
|
||||
# WARNING:
|
||||
# This script will work only if locking is set to strict.
|
||||
#
|
||||
|
||||
# Setup:
|
||||
# Add the following line to the commitinfo file:
|
||||
|
||||
# ALL /local/location/for/script/lockcheck [options]
|
||||
|
||||
# Where ALL is replaced by any suitable regular expression.
|
||||
# Options are -v for verbose info, or -d for debugging info.
|
||||
# The %s will provide the repository directory name and the names of
|
||||
# all changed files.
|
||||
|
||||
# Use:
|
||||
# When a developer needs exclusive access to a version of a file, s/he
|
||||
# should use "rcs -l" in the repository tree to lock the version they
|
||||
# are working on. CVS will automagically release the lock when the
|
||||
# commit is performed.
|
||||
|
||||
# Method:
|
||||
# An "rlog -h" is exec'ed to give info on all about to be
|
||||
# committed files. This (header) information is parsed to determine
|
||||
# if any locks are outstanding and what versions of the file are
|
||||
# locked. This filename, version number info is used to index an
|
||||
# associative array. All of the files to be committed are checked to
|
||||
# see if any locks are outstanding. If locks are outstanding, the
|
||||
# version number of the current file (taken from the CVS/Entries
|
||||
# subdirectory) is used in the key to determine if that version is
|
||||
# locked. If the file being checked in is locked by the person doing
|
||||
# the checkin, the commit is allowed, but if the lock is held on that
|
||||
# version of a file by another person, the commit is not allowed.
|
||||
|
||||
$ext = ",v"; # The extension on your rcs files.
|
||||
|
||||
$\="\n"; # I hate having to put \n's at the end of my print statements
|
||||
$,=' '; # Spaces should occur between arguments to print when printed
|
||||
|
||||
# turn off setgid
|
||||
#
|
||||
$) = $(;
|
||||
|
||||
#
|
||||
# parse command line arguments
|
||||
#
|
||||
require 'getopts.pl';
|
||||
|
||||
&Getopts("vd"); # verbose or debugging
|
||||
|
||||
# Verbose is useful when debugging
|
||||
$opt_v = $opt_d if defined $opt_d;
|
||||
|
||||
# $files[0] is really the name of the subdirectory.
|
||||
# @files = split(/ /,$ARGV[0]);
|
||||
@files = @ARGV[0..$#ARGV];
|
||||
$cvsroot = $ENV{'CVSROOT'};
|
||||
|
||||
#
|
||||
# get login name
|
||||
#
|
||||
$login = getlogin || (getpwuid($<))[0] || "nobody";
|
||||
|
||||
#
|
||||
# save the current directory since we have to return here to parse the
|
||||
# CVS/Entries file if a lock is found.
|
||||
#
|
||||
$pwd = `/bin/pwd`;
|
||||
chop $pwd;
|
||||
|
||||
print "Starting directory is $pwd" if defined $opt_d ;
|
||||
|
||||
#
|
||||
# cd to the repository directory and check on the files.
|
||||
#
|
||||
print "Checking directory ", $files[0] if defined $opt_v ;
|
||||
|
||||
if ( $files[0] =~ /^\// )
|
||||
{
|
||||
print "Directory path is $files[0]" if defined $opt_d ;
|
||||
chdir $files[0] || die "Can't change to repository directory $files[0]" ;
|
||||
}
|
||||
else
|
||||
{
|
||||
print "Directory path is $cvsroot/$files[0]" if defined $opt_d ;
|
||||
chdir ($cvsroot . "/" . $files[0]) ||
|
||||
die "Can't change to repository directory $files[0] in $cvsroot" ;
|
||||
}
|
||||
|
||||
|
||||
# Open the rlog process and apss all of the file names to that one
|
||||
# process to cut down on exec overhead. This may backfire if there
|
||||
# are too many files for the system buffer to handle, but if there are
|
||||
# that many files, chances are that the cvs repository is not set up
|
||||
# cleanly.
|
||||
|
||||
print "opening rlog -h @files[1..$#files] |" if defined $opt_d;
|
||||
|
||||
open( RLOG, "rlog -h @files[1..$#files] |") || die "Can't run rlog command" ;
|
||||
|
||||
# Create the locks associative array. The elements in the array are
|
||||
# of two types:
|
||||
#
|
||||
# The name of the RCS file with a value of the total number of locks found
|
||||
# for that file,
|
||||
# or
|
||||
#
|
||||
# The name of the rcs file concatenated with the version number of the lock.
|
||||
# The value of this element is the name of the locker.
|
||||
|
||||
# The regular expressions used to split the rcs info may have to be changed.
|
||||
# The current ones work for rcs 5.6.
|
||||
|
||||
$lock = 0;
|
||||
|
||||
while (<RLOG>)
|
||||
{
|
||||
chop;
|
||||
next if /^$/; # ditch blank lines
|
||||
|
||||
if ( $_ =~ /^RCS file: (.*)$/ )
|
||||
{
|
||||
$curfile = $1;
|
||||
next;
|
||||
}
|
||||
|
||||
if ( $_ =~ /^locks: strict$/ )
|
||||
{
|
||||
$lock = 1 ;
|
||||
next;
|
||||
}
|
||||
|
||||
if ( $lock )
|
||||
{
|
||||
# access list: is the line immediately following the list of locks.
|
||||
if ( /^access list:/ )
|
||||
{ # we are done getting lock info for this file.
|
||||
$lock = 0;
|
||||
}
|
||||
else
|
||||
{ # We are accumulating lock info.
|
||||
|
||||
# increment the lock count
|
||||
$locks{$curfile}++;
|
||||
# save the info on the version that is locked. $2 is the
|
||||
# version number $1 is the name of the locker.
|
||||
$locks{"$curfile" . "$2"} = $1
|
||||
if /[ ]*([a-zA-Z._]*): ([0-9.]*)$/;
|
||||
|
||||
print "lock by $1 found on $curfile version $2" if defined $opt_d;
|
||||
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Lets go back to the starting directory and see if any locked files
|
||||
# are ones we are interested in.
|
||||
|
||||
chdir $pwd;
|
||||
|
||||
# fo all of the file names (remember $files[0] is the directory name
|
||||
foreach $i (@files[1..$#files])
|
||||
{
|
||||
if ( defined $locks{$i . $ext} )
|
||||
{ # well the file has at least one lock outstanding
|
||||
|
||||
# find the base version number of our file
|
||||
&parse_cvs_entry($i,*entry);
|
||||
|
||||
# is our version of this file locked?
|
||||
if ( defined $locks{$i . $ext . $entry{"version"}} )
|
||||
{ # if so, it is by us?
|
||||
if ( $login ne ($by = $locks{$i . $ext . $entry{"version"}}) )
|
||||
{# crud somebody else has it locked.
|
||||
$outstanding_lock++ ;
|
||||
print "$by has file $i locked for version " , $entry{"version"};
|
||||
}
|
||||
else
|
||||
{ # yeah I have it locked.
|
||||
print "You have a lock on file $i for version " , $entry{"version"}
|
||||
if defined $opt_v;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
exit $outstanding_lock;
|
||||
|
||||
|
||||
### End of main program
|
||||
|
||||
sub parse_cvs_entry
|
||||
{ # a very simple minded hack at parsing an entries file.
|
||||
local ( $file, *entry ) = @_;
|
||||
local ( @pp );
|
||||
|
||||
|
||||
open(ENTRIES, "< CVS/Entries") || die "Can't open entries file";
|
||||
|
||||
while (<ENTRIES>)
|
||||
{
|
||||
if ( $_ =~ /^\/$file\// )
|
||||
{
|
||||
@pp = split('/');
|
||||
|
||||
$entry{"name"} = $pp[1];
|
||||
$entry{"version"} = $pp[2];
|
||||
$entry{"dates"} = $pp[3];
|
||||
$entry{"name"} = $pp[4];
|
||||
$entry{"name"} = $pp[5];
|
||||
$entry{"sticky"} = $pp[6];
|
||||
return;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -1,280 +0,0 @@
|
|||
#! xCSH_PATHx -f
|
||||
#
|
||||
# Sccs2rcs is a script to convert an existing SCCS
|
||||
# history into an RCS history without losing any of
|
||||
# the information contained therein.
|
||||
# It has been tested under the following OS's:
|
||||
# SunOS 3.5, 4.0.3, 4.1
|
||||
# Ultrix-32 2.0, 3.1
|
||||
#
|
||||
# Things to note:
|
||||
# + It will NOT delete or alter your ./SCCS history under any circumstances.
|
||||
#
|
||||
# + Run in a directory where ./SCCS exists and where you can
|
||||
# create ./RCS
|
||||
#
|
||||
# + /usr/local/bin is put in front of the default path.
|
||||
# (SCCS under Ultrix is set-uid sccs, bad bad bad, so
|
||||
# /usr/local/bin/sccs here fixes that)
|
||||
#
|
||||
# + Date, time, author, comments, branches, are all preserved.
|
||||
#
|
||||
# + If a command fails somewhere in the middle, it bombs with
|
||||
# a message -- remove what it's done so far and try again.
|
||||
# "rm -rf RCS; sccs unedit `sccs tell`; sccs clean"
|
||||
# There is no recovery and exit is far from graceful.
|
||||
# If a particular module is hanging you up, consider
|
||||
# doing it separately; move it from the current area so that
|
||||
# the next run will have a better chance or working.
|
||||
# Also (for the brave only) you might consider hacking
|
||||
# the s-file for simpler problems: I've successfully changed
|
||||
# the date of a delta to be in sync, then run "sccs admin -z"
|
||||
# on the thing.
|
||||
#
|
||||
# + After everything finishes, ./SCCS will be moved to ./old-SCCS.
|
||||
#
|
||||
# This file may be copied, processed, hacked, mutilated, and
|
||||
# even destroyed as long as you don't tell anyone you wrote it.
|
||||
#
|
||||
# Ken Cox
|
||||
# Viewlogic Systems, Inc.
|
||||
# kenstir@viewlogic.com
|
||||
# ...!harvard!cg-atla!viewlog!kenstir
|
||||
#
|
||||
# Various hacks made by Brian Berliner before inclusion in CVS contrib area.
|
||||
|
||||
|
||||
#we'll assume the user set up the path correctly
|
||||
# for the Pmax, /usr/ucb/sccs is suid sccs, what a pain
|
||||
# /usr/local/bin/sccs should override /usr/ucb/sccs there
|
||||
set path = (/usr/local/bin $path)
|
||||
|
||||
|
||||
############################################################
|
||||
# Error checking
|
||||
#
|
||||
if (! -w .) then
|
||||
echo "Error: ./ not writeable by you."
|
||||
exit 1
|
||||
endif
|
||||
if (! -d SCCS) then
|
||||
echo "Error: ./SCCS directory not found."
|
||||
exit 1
|
||||
endif
|
||||
set edits = (`sccs tell`)
|
||||
if ($#edits) then
|
||||
echo "Error: $#edits file(s) out for edit...clean up before converting."
|
||||
exit 1
|
||||
endif
|
||||
if (-d RCS) then
|
||||
echo "Warning: RCS directory exists"
|
||||
if (`ls -a RCS | wc -l` > 2) then
|
||||
echo "Error: RCS directory not empty
|
||||
exit 1
|
||||
endif
|
||||
else
|
||||
mkdir RCS
|
||||
endif
|
||||
|
||||
sccs clean
|
||||
|
||||
set logfile = /tmp/sccs2rcs_$$_log
|
||||
rm -f $logfile
|
||||
set tmpfile = /tmp/sccs2rcs_$$_tmp
|
||||
rm -f $tmpfile
|
||||
set emptyfile = /tmp/sccs2rcs_$$_empty
|
||||
echo -n "" > $emptyfile
|
||||
set initialfile = /tmp/sccs2rcs_$$_init
|
||||
echo "Initial revision" > $initialfile
|
||||
set sedfile = /tmp/sccs2rcs_$$_sed
|
||||
rm -f $sedfile
|
||||
set revfile = /tmp/sccs2rcs_$$_rev
|
||||
rm -f $revfile
|
||||
|
||||
# the quotes surround the dollar signs to fool RCS when I check in this script
|
||||
set sccs_keywords = (\
|
||||
'%W%[ ]*%G%'\
|
||||
'%W%[ ]*%E%'\
|
||||
'%W%'\
|
||||
'%Z%%M%[ ]*%I%[ ]*%G%'\
|
||||
'%Z%%M%[ ]*%I%[ ]*%E%'\
|
||||
'%M%[ ]*%I%[ ]*%G%'\
|
||||
'%M%[ ]*%I%[ ]*%E%'\
|
||||
'%M%'\
|
||||
'%I%'\
|
||||
'%G%'\
|
||||
'%E%'\
|
||||
'%U%')
|
||||
set rcs_keywords = (\
|
||||
'$'Id'$'\
|
||||
'$'Id'$'\
|
||||
'$'Id'$'\
|
||||
'$'SunId'$'\
|
||||
'$'SunId'$'\
|
||||
'$'Id'$'\
|
||||
'$'Id'$'\
|
||||
'$'RCSfile'$'\
|
||||
'$'Revision'$'\
|
||||
'$'Date'$'\
|
||||
'$'Date'$'\
|
||||
'')
|
||||
|
||||
|
||||
############################################################
|
||||
# Get some answers from user
|
||||
#
|
||||
echo ""
|
||||
echo "Do you want to be prompted for a description of each"
|
||||
echo "file as it is checked in to RCS initially?"
|
||||
echo -n "(y=prompt for description, n=null description) [y] ?"
|
||||
set ans = $<
|
||||
if ((_$ans == _) || (_$ans == _y) || (_$ans == _Y)) then
|
||||
set nodesc = 0
|
||||
else
|
||||
set nodesc = 1
|
||||
endif
|
||||
echo ""
|
||||
echo "The default keyword substitutions are as follows and are"
|
||||
echo "applied in the order specified:"
|
||||
set i = 1
|
||||
while ($i <= $#sccs_keywords)
|
||||
# echo ' '\"$sccs_keywords[$i]\"' ==> '\"$rcs_keywords[$i]\"
|
||||
echo " $sccs_keywords[$i] ==> $rcs_keywords[$i]"
|
||||
@ i = $i + 1
|
||||
end
|
||||
echo ""
|
||||
echo -n "Do you want to change them [n] ?"
|
||||
set ans = $<
|
||||
if ((_$ans != _) && (_$ans != _n) && (_$ans != _N)) then
|
||||
echo "You can't always get what you want."
|
||||
echo "Edit this script file and change the variables:"
|
||||
echo ' $sccs_keywords'
|
||||
echo ' $rcs_keywords'
|
||||
else
|
||||
echo "good idea."
|
||||
endif
|
||||
|
||||
# create the sed script
|
||||
set i = 1
|
||||
while ($i <= $#sccs_keywords)
|
||||
echo "s,$sccs_keywords[$i],$rcs_keywords[$i],g" >> $sedfile
|
||||
@ i = $i + 1
|
||||
end
|
||||
|
||||
onintr ERROR
|
||||
|
||||
############################################################
|
||||
# Loop over every s-file in SCCS dir
|
||||
#
|
||||
foreach sfile (SCCS/s.*)
|
||||
# get rid of the "s." at the beginning of the name
|
||||
set file = `echo $sfile:t | sed -e "s/^..//"`
|
||||
|
||||
# work on each rev of that file in ascending order
|
||||
set firsttime = 1
|
||||
sccs prs $file | grep "^D " | awk '{print $2}' | sed -e 's/\./ /g' | sort -n -u +0 +1 +2 +3 +4 +5 +6 +7 +8 | sed -e 's/ /./g' > $revfile
|
||||
foreach rev (`cat $revfile`)
|
||||
if ($status != 0) goto ERROR
|
||||
|
||||
# get file into current dir and get stats
|
||||
set year = `echo $date | cut -c3-4`
|
||||
if ($year < 70) then
|
||||
# Y2K Bug, change century to 20
|
||||
set date = `echo $date | sed -e s/19/20/`
|
||||
endif
|
||||
set date = `sccs prs -r$rev $file | grep "^D " | awk '{printf("19%s %s", $3, $4); exit}'`
|
||||
set author = `sccs prs -r$rev $file | grep "^D " | awk '{print $5; exit}'`
|
||||
echo ""
|
||||
echo "==> file $file, rev=$rev, date=$date, author=$author"
|
||||
sccs edit -r$rev $file >>& $logfile
|
||||
if ($status != 0) goto ERROR
|
||||
echo checked out of SCCS
|
||||
|
||||
# add RCS keywords in place of SCCS keywords
|
||||
sed -f $sedfile $file > $tmpfile
|
||||
if ($status != 0) goto ERROR
|
||||
echo performed keyword substitutions
|
||||
cp $tmpfile $file
|
||||
|
||||
# check file into RCS
|
||||
if ($firsttime) then
|
||||
set firsttime = 0
|
||||
if ($nodesc) then
|
||||
echo about to do ci
|
||||
echo ci -f -r$rev -d"$date" -w$author -t$emptyfile $file
|
||||
ci -f -r$rev -d"$date" -w$author -t$emptyfile $file < $initialfile >>& $logfile
|
||||
if ($status != 0) goto ERROR
|
||||
echo initial rev checked into RCS without description
|
||||
else
|
||||
echo ""
|
||||
echo Enter a brief description of the file $file \(end w/ Ctrl-D\):
|
||||
cat > $tmpfile
|
||||
ci -f -r$rev -d"$date" -w$author -t$tmpfile $file < $initialfile >>& $logfile
|
||||
if ($status != 0) goto ERROR
|
||||
echo initial rev checked into RCS
|
||||
endif
|
||||
else
|
||||
# get RCS lock
|
||||
set lckrev = `echo $rev | sed -e 's/\.[0-9]*$//'`
|
||||
if ("$lckrev" =~ [0-9]*.*) then
|
||||
# need to lock the brach -- it is OK if the lock fails
|
||||
rcs -l$lckrev $file >>& $logfile
|
||||
else
|
||||
# need to lock the trunk -- must succeed
|
||||
rcs -l $file >>& $logfile
|
||||
if ($status != 0) goto ERROR
|
||||
endif
|
||||
echo got lock
|
||||
sccs prs -r$rev $file | grep "." > $tmpfile
|
||||
# it's OK if grep fails here and gives status == 1
|
||||
# put the delta message in $tmpfile
|
||||
ed $tmpfile >>& $logfile <<EOF
|
||||
/COMMENTS
|
||||
1,.d
|
||||
w
|
||||
q
|
||||
EOF
|
||||
ci -f -r$rev -d"$date" -w$author $file < $tmpfile >>& $logfile
|
||||
if ($status != 0) goto ERROR
|
||||
echo checked into RCS
|
||||
endif
|
||||
sccs unedit $file >>& $logfile
|
||||
if ($status != 0) goto ERROR
|
||||
end
|
||||
rm -f $file
|
||||
end
|
||||
|
||||
|
||||
############################################################
|
||||
# Clean up
|
||||
#
|
||||
echo cleaning up...
|
||||
mv SCCS old-SCCS
|
||||
rm -f $tmpfile $emptyfile $initialfile $sedfile
|
||||
echo ===================================================
|
||||
echo " Conversion Completed Successfully"
|
||||
echo ""
|
||||
echo " SCCS history now in old-SCCS/"
|
||||
echo ===================================================
|
||||
set exitval = 0
|
||||
goto cleanup
|
||||
|
||||
ERROR:
|
||||
foreach f (`sccs tell`)
|
||||
sccs unedit $f
|
||||
end
|
||||
echo ""
|
||||
echo ""
|
||||
echo Danger\! Danger\!
|
||||
echo Some command exited with a non-zero exit status.
|
||||
echo Log file exists in $logfile.
|
||||
echo ""
|
||||
echo Incomplete history in ./RCS -- remove it
|
||||
echo Original unchanged history in ./SCCS
|
||||
set exitval = 1
|
||||
|
||||
cleanup:
|
||||
# leave log file
|
||||
rm -f $tmpfile $emptyfile $initialfile $sedfile $revfile
|
||||
|
||||
exit $exitval
|
||||
Loading…
Reference in New Issue