Hi there,
Please find attached a pre-commit hook script that can go into the
contrib directory. It will check that binary files that are listed in
"svnlook changed" (except deleted files) have the svn:needs-lock
property set. There are several scripts on the net that serve the same
purpose, but they only run on Windows. I couldn't find one that would
run on Linux, so I changed a few lines in svn-keyword-check.pl to make
it do what I need it to. This is the result.
Best regards,
Bastiaan Veelo.
#!/usr/bin/env perl
# Copyright (c) 2000-2008 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/.
# ====================================================================
# This pre-commit hook script will check that binary files that are listed
# in "svnlook changed" (except deleted files) have the svn:needs-lock
# property set. Based heavily on svn-keyword-check.pl.
#
# The way it determines if the file is binary is it takes the paranoid
# approach that all files are binary, unless proven otherwise. If a
# file has svn:eol-style set, it considers this file text. If the
# file has a svn:mime-type of text/*, it is text. Then, the script can
# be passed file extensions to always consider text.
#
# Command line options are:
#
# --revision (-r) = The revision to pass in on svnlook to inspect. To
# be used for testing only, use --transaction in the
# hook script.
#
# --transaction (-t) = The transaction to inspect. $2 in pre-commit
# scripts.
#
# --repos = The path to the repository. $1 in pre-commit scripts.
#
# --svnlook = Path to svnlook. Default: (/usr/bin/svnlook)
#
# --text (-x) = Declared multiple times for each extension.
# -x .txt -x .html -x .htm
#
# Example usage (inside pre-commit hook script)
#
# REPOS="$1"
# TXN="$2"
# check-needs-lock-on-binaries.pl --repos $REPOS --transaction $TXN --text
.java --text .txt
#
# $HeadURL$
# $LastChangedRevision$
# $LastChangedDate$
# $LastChangedBy$
BEGIN {
if ( $] >= 5.006_000) {
require warnings; import warnings;
} else {
$^W = 1;
}
}
use strict;
use Getopt::Long;
use Carp;
# Command line option parsing
my $transaction;
my $revision;
my $repos;
my $svnlook = "/usr/bin/svnlook";
my @text;
GetOptions(
'revision|r=s' => \$revision,
'transaction|t=s' => \$transaction,
'repos=s' => \$repos,
'svnlook=s' => \$svnlook,
'text|x=s' => \@text,
);
if (defined($transaction) and defined($revision)) {
croak "Can't define both revision and transaction!\n";
}
if (!defined($transaction) and !defined($revision)) {
croak "Need to pass a revision or a transaction!\n";
}
if (!defined($repos)) {
croak "Need to pass in repos path!\n";
}
my $flag = (defined($revision)) ? "-r" : "-t";
my $value = (defined($revision)) ? $revision : $transaction;
# Get a list of what has changed.
my @changed = read_from_process("$svnlook changed $flag $value $repos");
# Loop over changed entries, checking each one, except deleted paths.
my @errors;
foreach my $change (@changed) {
chomp($change);
if ($change =~ m/^D /) {
next;
}
$change =~ s/^(?:A|U|UU|_U)\s+(.*)/$1/;
if (check($change)) {
push(@errors, $change);
}
}
# Report any errors to STDERR to be marshaled back to the client, and
# exit 1.
if (@errors) {
warn "The following files appear not to contain plain text, but lack the\n";
warn "svn:needs-lock property. Since these files cannot be merged by
SVN,\n";
warn "only one developer may alter them at a time. By setting the\n";
warn "svn:needs-lock property these files become read-only in the\n";
warn "working copy. A developer may temporarily acquire write access\n";
warn "by getting an SVN lock on the file, which lasts until the next
commit.\n";
warn "Please add the svn:needs-lock property, or if the file is text, set
the\n";
warn "right svn:mime-type and svn:eol-style properties:\n\n";
foreach my $error (@errors) {
warn "\t$error\n";
}
exit 1;
}
# Subroutine that checks the paths passed to it. Checks if it has
# "svn:keywords" and if the file is binary, and greps the output of
# svnlook cat of the file for keywords, while trying to do that inside
# a loop to keep memory usage down.
sub check {
my $file = shift;
unless (has_svn_property($file, "svn:needs-lock")) {
if (file_is_binary($file)) {
return 1;
}
}
return 0;
}
# Heruistics to determine if file is binary.
#
# Take the paranoid approch, everything is binary, unless otherwise
# stated If svn:eol-style is set, it is text If svn:mime-type is
# text/*, it is text a configurable file glob list (extensions, *.txt,
# etc) that are text (defined on the command line)
sub file_is_binary {
my $file = shift;
if (has_svn_property($file, "svn:eol-style")) {
return 0;
}
if (has_svn_property($file, "svn:mime-type")) {
my ($mimetype) = read_from_process("$svnlook propget $flag $value
$repos svn:mime-type \"$file\"");
chomp($mimetype);
$mimetype =~ s/^\s*(.*)/$1/;
if ($mimetype =~ m/^text\//) {
return 0;
}
}
foreach my $ext (@text) {
if ($file =~ m/\Q$ext\E$/) {
return 0;
}
}
return 1;
}
# Checks if a Subversion property is set on a file.
sub has_svn_property {
my $file = shift;
my $keyword = shift;
my @proplist = read_from_process("$svnlook proplist $flag $value $repos
\"$file\"");
foreach my $prop (@proplist) {
chomp($prop);
if ($prop =~ m/\b$keyword\b/) {
return 1;
}
}
return 0;
}
# Copied from contrib/hook-scripts/check-mime-type.pl, with some
# modifications. Moved the actual pipe creation to another subroutine
# (_pipe), so I can use _pipe in this code, and the part of the code
# that loops over the output of svnlook cat.
sub safe_read_from_pipe {
unless (@_) {
croak "$0: safe_read_from_pipe passed no arguments.\n";
}
my $fh = _pipe(@_);
my @output;
while (<$fh>) {
chomp;
push(@output, $_);
}
close($fh);
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;
}
}
# Return the filehandle as a glob so we can loop over it elsewhere.
sub _pipe {
local *SAFE_READ;
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";
}
return *SAFE_READ;
}
# Copied from contrib/hook-scripts/check-mime-type.pl
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;
}
}
