1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235
|
#! 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;
}
}
}
|