This is my hook script to check for file lock. And it does print the error
message to TortoiseSVN
#!/usr/bin/env perl
# ====================================================================
# ensure-needs-lock.pl: check that every added file has the
# svn:needs-lock property. If any file fails this test the user is
# sent a verbose error message suggesting solutions and the commit is
# aborted.
#
# Usage: ensure-needs-lock.pl REPOS TXN-NAME
# ====================================================================
# Most of ensure-needs-lock.pl was taken from
# check-mime-type.pl, Revision 12600, 2005-01-05 11:44:05 -0600.
# ====================================================================
# Copyright (c) 2000-2005 CollabNet. All rights reserved.
#
# This software is licensed as described in the file COPYING, which
# you should have received as part of this distribution. The terms
# are also available at http://subversion.tigris.org/license.html.
# If newer versions of this license are posted there, you may use a
# newer version instead, at your option.
#
# This software consists of voluntary contributions made by many
# individuals. For exact contribution history, see the revision
# history and logs, available at http://subversion.tigris.org/.
# ====================================================================
# 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;
######################################################################
# Configuration section.
# Svnlook path.
my $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;
}
######################################################################
# Initial setup/command-line handling.
&usage unless @ARGV == 2;
my $repos = shift;
my $txn = shift;
unless (-e $repos)
{
&usage("$0: repository directory `$repos' does not exist.");
}
unless (-d $repos)
{
&usage("$0: repository directory `$repos' is not a directory.");
}
# Define two constant subroutines to stand for read-only or read-write
# access to the repository.
sub ACCESS_READ_ONLY () { 'read-only' }
sub ACCESS_READ_WRITE () { 'read-write' }
######################################################################
# Harvest data using svnlook.
# Change into /tmp so that svnlook diff can create its .svnlook
# directory.
my $tmp_dir = '/tmp';
chdir($tmp_dir)
or die "$0: cannot chdir `$tmp_dir': $!\n";
# Figure out what files have added using svnlook.
my @files_added;
foreach my $line (&read_from_process($svnlook, 'changed', $repos, '-t',
$txn))
{
# Add only files that were added to @files_added
if ($line =~ /^A. (.*[^\/])$/)
{
push(@files_added, $1);
}
}
my @errors;
foreach my $path ( @files_added )
{
my $needs_lock;
# Parse the complete list of property values of the file $path to
extract
# the needs-lock property
foreach my $prop (&read_from_process($svnlook, 'proplist', $repos,
'-t',
$txn, '--verbose', $path))
{
if ($prop =~ /^\s*svn:needs-lock : (\S+)/)
{
$needs_lock = $1;
}
}
# Detect error conditions and add them to @errors
if (not $needs_lock)
{
push @errors, "$path : svn:needs-lock is not set";
}
}
# If there are any errors list the problem files and give information
# on how to avoid the problem. Hopefully people will set up auto-props
# and will not see this verbose message more than once.
if (@errors)
{
warn "$0:\n\n",
join("\n", @errors), "\n\n",
<<EOS;
Every added file must have the svn:needs-lock property set.
If you need more help contact Admin.
EOS
exit 1;
}
else
{
exit 0;
}
sub usage
{
warn "@_\n" if @_;
die "usage: $0 REPOS TXN-NAME\n";
}
sub safe_read_from_pipe
{
unless (@_)
{
croak "$0: safe_read_from_pipe passed no arguments.\n";
}
print "Running @_\n";
my $pid = open(SAFE_READ, '-|');
unless (defined $pid)
{
die "$0: cannot fork: $!\n";
}
unless ($pid)
{
open(STDERR, ">&STDOUT")
or die "$0: cannot dup STDOUT: $!\n";
exec(@_)
or die "$0: cannot exec `@_': $!\n";
}
my @output;
while (<SAFE_READ>)
{
chomp;
push(@output, $_);
}
close(SAFE_READ);
my $result = $?;
my $exit = $result >> 8;
my $signal = $result & 127;
my $cd = $result & 128 ? "with core dump" : "";
if ($signal or $cd)
{
warn "$0: pipe from `@_' failed $cd: exit=$exit signal=$signal\n";
}
if (wantarray)
{
return ($result, @output);
}
else
{
return $result;
}
}
sub read_from_process
{
unless (@_)
{
croak "$0: read_from_process passed no arguments.\n";
}
my ($status, @output) = &safe_read_from_pipe(@_);
if ($status)
{
if (@output)
{
die "$0: `@_' failed with this output:\n", join("\n", @output),
"\n";
}
else
{
die "$0: `@_' failed with no output.\n";
}
}
else
{
return @output;
}
}
On Mon, Mar 17, 2008 at 5:54 PM, DePriest Richard 403 <
richard.depriest_at_crackerbarrel.com> wrote:
> We are starting to use subversion with tortoise. There is a pre-commit
> hook that fires and calls a perl script that checks to see if a file is
> locked and if it is not it will error out and not allow the commit. The
> error is getting written to STDERR and we cannot see it through tortoise. Is
> there anyway to see the error in tortoise? I am including the hook and the
> perl program.
>
> hook:
> @ECHO OFF
> REM Set command line client language to english
> set LC_ALL=C
> set SVNLOOK="/usr/bin/svnlook"
> set REPOS=%1
> set TXN=%2
>
> cd /u01/svn/repositories/Crackerbarrel/hooks
> perl checklock_nopropcheck.pl %SVNLOOK% %REPOS% %TXN%
> exit %ERRORLEVEL%
>
> perl:
>
> $SVNLOOK = $ARGV[0];
> $REPOS = $ARGV[1];
> $TXN = $ARGV[2];
>
> sub main {
> #Get Author
> open(AUTHOR,"\"$SVNLOOK\" author -t $TXN \"$REPOS\" |");
> $Author = (<AUTHOR> =~ /(\w+\b)/)[0];
> close(AUTHOR);
>
> # Get changed files
> open(CHANGED,"\"$SVNLOOK\" changed -t $TXN \"$REPOS\" |");
> @ChangedFiles = <CHANGED>;
> close(CHANGED);
> print @ChangedFiles;
>
> foreach $File (@ChangedFiles){
> if($File =~ /^[UD]/){ #Only updated and deleted
> if($File !~ /(.*)\/\s*$/){ #Is not a directory
> $File = ($File =~ /....(.*)[\n\b]/)[0]; #Get just the file name
> open(LOCKDATA,"\"$SVNLOOK\" lock \"$REPOS\" \"$File\" |");
> $Lockdata = join("",<LOCKDATA>);
> close(LOCKDATA);
> if($Lockdata =~ /Owner: (\w+\b)/){
> return $1
> } else {
> print STDERR "Lock Error: There is a modified file without
> lock!($File)\n";
> exit 1
> }
> }
> }
> }
> }
>
> main();
>
> exit 0;
>
> Any help will be very much appreciated.
>
> Rick DePriest
> Project Manager - Retail Systems
> Cracker Barrel Old Country Stores, Inc.
> Ph. (615) 443-9845
> Email: rdepries_at_crackerbarrel.com
>
>
Received on 2008-03-18 16:19:46 CET