From 43f9c4ed314f27c74a71fa94e1c74efc5c90786e Mon Sep 17 00:00:00 2001 From: peter Date: Fri, 10 Aug 2001 10:55:45 +0000 Subject: This commit was generated by cvs2svn to compensate for changes in r81434, which included commits to RCS files with non-trunk default branches. --- contrib/cvs/contrib/clmerge.pl | 152 ---------- contrib/cvs/contrib/cln_hist.pl | 91 ------ contrib/cvs/contrib/commit_prep.pl | 215 -------------- contrib/cvs/contrib/cvs_acls.pl | 141 --------- contrib/cvs/contrib/log_accum.pl | 576 ------------------------------------- contrib/cvs/contrib/mfpipe.pl | 85 ------ contrib/cvs/contrib/rcslock.pl | 235 --------------- 7 files changed, 1495 deletions(-) delete mode 100644 contrib/cvs/contrib/clmerge.pl delete mode 100644 contrib/cvs/contrib/cln_hist.pl delete mode 100644 contrib/cvs/contrib/commit_prep.pl delete mode 100644 contrib/cvs/contrib/cvs_acls.pl delete mode 100644 contrib/cvs/contrib/log_accum.pl delete mode 100644 contrib/cvs/contrib/mfpipe.pl delete mode 100644 contrib/cvs/contrib/rcslock.pl diff --git a/contrib/cvs/contrib/clmerge.pl b/contrib/cvs/contrib/clmerge.pl deleted file mode 100644 index ac81371..0000000 --- a/contrib/cvs/contrib/clmerge.pl +++ /dev/null @@ -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 (/^<<<>>>/) { - # 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; -} diff --git a/contrib/cvs/contrib/cln_hist.pl b/contrib/cvs/contrib/cln_hist.pl deleted file mode 100644 index 19a0b81..0000000 --- a/contrib/cvs/contrib/cln_hist.pl +++ /dev/null @@ -1,91 +0,0 @@ -#! xPERL_PATHx -# -*-Perl-*- -# -# Contributed by David G. Grubbs -# -# 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 () { - 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 () { - 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); diff --git a/contrib/cvs/contrib/commit_prep.pl b/contrib/cvs/contrib/commit_prep.pl deleted file mode 100644 index bf0ce92..0000000 --- a/contrib/cvs/contrib/commit_prep.pl +++ /dev/null @@ -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 -# -# Hacked on lots by Greg A. Woods - -# -# 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; ; $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 () { - 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); diff --git a/contrib/cvs/contrib/cvs_acls.pl b/contrib/cvs/contrib/cvs_acls.pl deleted file mode 100644 index c1d64e9..0000000 --- a/contrib/cvs/contrib/cvs_acls.pl +++ /dev/null @@ -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 () { - 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); diff --git a/contrib/cvs/contrib/log_accum.pl b/contrib/cvs/contrib/log_accum.pl deleted file mode 100644 index 2520fe1..0000000 --- a/contrib/cvs/contrib/log_accum.pl +++ /dev/null @@ -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 -# -# hacked greatly by Greg A. Woods - -# 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 = ; - close(FILE); - chop($line); - $line; -} - -sub read_logfile { - local(@text); - local($filename, $leader) = @_; - - open(FILE, "<$filename"); - while () { - 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 () { - 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 () { - chop; # Drop the newline - push(@text, $_); - } - - &mail_notification(@text); - - exit 0; -} - -# Iterate over the body of the message collecting information. -# -while () { - 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 () { - 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; diff --git a/contrib/cvs/contrib/mfpipe.pl b/contrib/cvs/contrib/mfpipe.pl deleted file mode 100644 index c74d715..0000000 --- a/contrib/cvs/contrib/mfpipe.pl +++ /dev/null @@ -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; diff --git a/contrib/cvs/contrib/rcslock.pl b/contrib/cvs/contrib/rcslock.pl deleted file mode 100644 index 01e349f..0000000 --- a/contrib/cvs/contrib/rcslock.pl +++ /dev/null @@ -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 () -{ - 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 () - { - 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; - } - } -} -- cgit v1.1