How does this look? (it seems to work, but since I've only been using Perl 90
minutes, is probably buggy as hell!):
============================
my $allowsteal = "John";
# Turn on warnings the best way depending on the Perl version.
BEGIN {
if ( $] >= 5.006_000)
{ require warnings; import warnings; }
else
{ $^W = 1; }
}
use strict;
use Carp;
# Svnlook path.
my $svnlook;
if ($^O eq 'MSWin32') {
$svnlook = 'c:\Program Files\subversion\bin\svnlook.exe';
} else {
$svnlook = '/usr/local/bin/svnlook';
}
# Since the path to svnlook depends upon the local installation
# preferences, check that the required program exists to insure that
# the administrator has set up the script properly.
{
my $ok = 1;
foreach my $program ($svnlook)
{
if (-e $program)
{
unless (-x $program)
{
warn "$0: required program `$program' is not executable, ",
"edit $0.\n";
$ok = 0;
}
}
else
{
warn "$0: required program `$program' does not exist, edit $0.\n";
$ok = 0;
}
}
exit 1 unless $ok;
}
&usage unless @ARGV == 3;
my $repos = shift;
my $path = shift;
my $user = shift;
#print "repos ", $repos, "\n";
#print "path ", $path, "\n";
#print "user ", $user, "\n";
unless (-e $repos)
{
&usage("$0: repository directory `$repos' does not exist.");
}
unless (-d $repos)
{
&usage("$0: repository directory `$repos' is not a directory.");
}
my $lockowner = "";
local *SVNLOOK;
my $cmd = "\"$svnlook\" lock \"$repos\" \"$path\"";
open(SVNLOOK, '-|', $cmd)
or die("$0: cannot open '$cmd' pipe for reading: $!\n");
while (<SVNLOOK>) {
chomp;
if (/^Owner: (\S+)$/) {
$lockowner = $1;
}
}
close SVNLOOK;
# if no lock, or this user owns it, or this user is allowed to steal, signal ok
if ($lockowner eq "" || $lockowner eq $user || $user eq $allowsteal)
{
#print "fine to break, or nothing to break";
exit 0;
} else
{
print STDERR "You cannot break a lock owned by $lockowner";
exit 1;
}
exit 1;
sub usage
{
warn "@_\n" if @_;
die "usage: $0 REPOS PATHinREPOS USER\n";
}
---------------------------------------------------------------------
To unsubscribe, e-mail: users-unsubscribe@subversion.tigris.org
For additional commands, e-mail: users-help@subversion.tigris.org
Received on Mon May 30 16:14:00 2005