r32021 - in /branches/upstream/libsvn-hooks-perl/current: Changes MANIFEST META.yml README TODO lib/SVN/Hooks.pm lib/SVN/Hooks/CheckStructure.pm t/02-checkstructure.t t/02-checkstructurealone.t
angelabad-guest at users.alioth.debian.org
angelabad-guest at users.alioth.debian.org
Fri Mar 13 09:23:25 UTC 2009
Author: angelabad-guest
Date: Fri Mar 13 09:23:21 2009
New Revision: 32021
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=32021
Log:
[svn-upgrade] Integrating new upstream version, libsvn-hooks-perl (0.15.41)
Added:
branches/upstream/libsvn-hooks-perl/current/t/02-checkstructurealone.t (with props)
Modified:
branches/upstream/libsvn-hooks-perl/current/Changes
branches/upstream/libsvn-hooks-perl/current/MANIFEST
branches/upstream/libsvn-hooks-perl/current/META.yml
branches/upstream/libsvn-hooks-perl/current/README
branches/upstream/libsvn-hooks-perl/current/TODO
branches/upstream/libsvn-hooks-perl/current/lib/SVN/Hooks.pm
branches/upstream/libsvn-hooks-perl/current/lib/SVN/Hooks/CheckStructure.pm
branches/upstream/libsvn-hooks-perl/current/t/02-checkstructure.t
Modified: branches/upstream/libsvn-hooks-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsvn-hooks-perl/current/Changes?rev=32021&op=diff
==============================================================================
--- branches/upstream/libsvn-hooks-perl/current/Changes (original)
+++ branches/upstream/libsvn-hooks-perl/current/Changes Fri Mar 13 09:23:21 2009
@@ -1,4 +1,14 @@
-Revision history for SVN-Look. -*- text -*-
+Revision history for SVN-Hooks. -*- text -*-
+
+0.15 2009-03-12
+
+ Corrects a nasty bug in CheckStructure.
+
+ Corrects some problems with the test scripts that prevented
+ them to work right in some environments.
+
+ Implements the function
+ SVN::Hooks::CheckStructure::check_structure.
0.14 2009-02-08
Modified: branches/upstream/libsvn-hooks-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsvn-hooks-perl/current/MANIFEST?rev=32021&op=diff
==============================================================================
--- branches/upstream/libsvn-hooks-perl/current/MANIFEST (original)
+++ branches/upstream/libsvn-hooks-perl/current/MANIFEST Fri Mar 13 09:23:21 2009
@@ -22,6 +22,7 @@
t/02-checkmimetypes.t
t/02-checkproperty.t
t/02-checkstructure.t
+t/02-checkstructurealone.t
t/02-denychanges.t
t/02-denyfilenames.t
t/02-jiraacceptance.t
Modified: branches/upstream/libsvn-hooks-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsvn-hooks-perl/current/META.yml?rev=32021&op=diff
==============================================================================
--- branches/upstream/libsvn-hooks-perl/current/META.yml (original)
+++ branches/upstream/libsvn-hooks-perl/current/META.yml Fri Mar 13 09:23:21 2009
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: SVN-Hooks
-version: 0.14.38
+version: 0.15.41
abstract: A framework for implementing Subversion hooks.
license: ~
author:
Modified: branches/upstream/libsvn-hooks-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsvn-hooks-perl/current/README?rev=32021&op=diff
==============================================================================
--- branches/upstream/libsvn-hooks-perl/current/README (original)
+++ branches/upstream/libsvn-hooks-perl/current/README Fri Mar 13 09:23:21 2009
@@ -1,6 +1,6 @@
Name: SVN-Hooks
What: Framework for Subversion hooks
-Version: 0.14
+Version: 0.15
Author: Gustavo Chaves <gnustavo at cpan.org>
SVN-Hooks is a framework for creating Subversion hooks
Modified: branches/upstream/libsvn-hooks-perl/current/TODO
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsvn-hooks-perl/current/TODO?rev=32021&op=diff
==============================================================================
--- branches/upstream/libsvn-hooks-perl/current/TODO (original)
+++ branches/upstream/libsvn-hooks-perl/current/TODO Fri Mar 13 09:23:21 2009
@@ -34,3 +34,5 @@
* Implement a clone of
http://svn.collab.net/viewvc/svn/trunk/contrib/hook-scripts/case-insensitive.py
+
+* Make each plugin an object factory.
Modified: branches/upstream/libsvn-hooks-perl/current/lib/SVN/Hooks.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsvn-hooks-perl/current/lib/SVN/Hooks.pm?rev=32021&op=diff
==============================================================================
--- branches/upstream/libsvn-hooks-perl/current/lib/SVN/Hooks.pm (original)
+++ branches/upstream/libsvn-hooks-perl/current/lib/SVN/Hooks.pm Fri Mar 13 09:23:21 2009
@@ -15,11 +15,11 @@
=head1 VERSION
-Version 0.14
+Version 0.15
=cut
-our $VERSION = '0.14.' . (q$Revision: 38 $ =~ / (\d+) /)[0]; # bump from 36
+our $VERSION = '0.15.' . (q$Revision: 41 $ =~ / (\d+) /)[0]; # bump from 38
=head1 SYNOPSIS
Modified: branches/upstream/libsvn-hooks-perl/current/lib/SVN/Hooks/CheckStructure.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsvn-hooks-perl/current/lib/SVN/Hooks/CheckStructure.pm?rev=32021&op=diff
==============================================================================
--- branches/upstream/libsvn-hooks-perl/current/lib/SVN/Hooks/CheckStructure.pm (original)
+++ branches/upstream/libsvn-hooks-perl/current/lib/SVN/Hooks/CheckStructure.pm Fri Mar 13 09:23:21 2009
@@ -6,7 +6,7 @@
use Exporter qw/import/;
my $HOOK = 'CHECK_STRUCTURE';
-our @EXPORT = ($HOOK);
+our @EXPORT = ($HOOK, 'check_structure');
our $VERSION = $SVN::Hooks::VERSION;
@@ -143,51 +143,38 @@
sub _check_structure {
my ($structure, $path) = @_;
- my $component = shift @$path;
-
- if (! defined $structure) {
- return (1);
- }
- elsif (! ref $structure) {
+ @$path > 0 or die "Can't happen!";
+
+ if (! ref $structure) {
if ($structure eq 'DIR') {
- if (defined $component) {
- return (1);
- }
- else {
- return (0, "a FILE should be a DIRECTORY in");
- }
+ return (1) if @$path > 1;
+ return (0, "the component ($path->[0]) should be a DIR in");
}
elsif ($structure eq 'FILE') {
- if (defined $component) {
- return (0, "a DIRECTORY should be a FILE in");
- }
- else {
- return (1);
- }
+ return (0, "the component ($path->[0]) should be a FILE in") if @$path > 1;
+ return (1);
}
elsif ($structure =~ /^\d+$/) {
- if ($structure) {
- return (1);
- }
- else {
- return (0, "invalid path");
- }
+ return (1) if $structure;
+ return (0, "invalid path");
}
else {
return (0, "syntax error: unknown string spec ($structure), while checking");
}
}
elsif (ref $structure eq 'ARRAY') {
- if (scalar(@$path) == 0 && $component eq '') {
- return (1);
- }
- if (scalar(@$structure) % 2 != 0) {
- return (0, "syntax error: odd number of elements in the structure spec, while checking")
- }
+ return (0, "syntax error: odd number of elements in the structure spec, while checking")
+ unless scalar(@$structure) % 2 == 0;
+ return (0, "the component ($path->[0]) should be a DIR in")
+ unless @$path > 1;
+ shift @$path;
+ # Return ok if the directory doesn't have subcomponents.
+ return (1) if @$path == 1 && length($path->[0]) == 0;
+
for (my $s=0; $s<$#$structure; $s+=2) {
my ($lhs, $rhs) = @{$structure}[$s, $s+1];
if (! ref $lhs) {
- if ($lhs eq $component) {
+ if ($lhs eq $path->[0]) {
return _check_structure($rhs, $path);
}
elsif ($lhs =~ /^\d+$/) {
@@ -203,7 +190,7 @@
}
}
elsif (ref $lhs eq 'Regexp') {
- if ($component =~ $lhs) {
+ if ($path->[0] =~ $lhs) {
return _check_structure($rhs, $path);
}
}
@@ -212,7 +199,7 @@
return (0, "syntax error: the left hand side of arrays in the structure spec must be scalars or qr/Regexes/, not $what, while checking");
}
}
- return (0, "the component ($component) is not allowed in");
+ return (0, "the component ($path->[0]) is not allowed in");
}
else {
my $what = ref $structure;
@@ -220,13 +207,45 @@
}
}
+=head1 EXPORT
+
+=head2 check_structure(STRUCT_DEF, PATH)
+
+SVN::Hooks::CheckStructure exports a function to allow for the
+verification of path structures outside the context of a Subversion
+hook. (It would probably be better to take this function to its own
+module and use that module here.)
+
+The function check_structure takes two arguments. The first is a
+STRUCT_DEF exactly the same as specified for the CHECK_STRUCTURE
+directive above. The second is a PATH to a file which will be checked
+against the STRUCT_DEF.
+
+The function returns true if the check succeeds and dies with a proper
+message otherwise.
+
+=cut
+
+sub check_structure {
+ my ($structure, $path) = @_;
+ my @path = split '/', $path, -1; # preserve trailing empty components
+ my ($code, $error) = _check_structure($structure, \@path);
+ die "$path: $error\n" if $code == 0;
+ 1;
+}
+
sub pre_commit {
my ($self, $svnlook) = @_;
my @errors;
foreach my $added ($svnlook->added()) {
- my @added = split '/', $added, -1; # preserve trailing empty components
+ # Split the $added path in its components. We prefix $added
+ # with a slash to make it look like an absolute path for
+ # _check_structure. The '-1' is to preserve trailing empty
+ # components so that we can differentiate directory paths from
+ # file paths.
+ my @added = split '/', "/$added", -1;
my ($code, $error) = _check_structure($self->{structure}, \@added);
push @errors, "$error: $added" if $code == 0;
}
Modified: branches/upstream/libsvn-hooks-perl/current/t/02-checkstructure.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsvn-hooks-perl/current/t/02-checkstructure.t?rev=32021&op=diff
==============================================================================
--- branches/upstream/libsvn-hooks-perl/current/t/02-checkstructure.t (original)
+++ branches/upstream/libsvn-hooks-perl/current/t/02-checkstructure.t Fri Mar 13 09:23:21 2009
@@ -59,7 +59,7 @@
svn ci -mx $t/wc/allow
EOS
-work_nok('is not file', 'a DIRECTORY should be a FILE in', <<"EOS");
+work_nok('is not file', 'the component (file) should be a FILE in', <<"EOS");
mkdir $t/wc/file
svn add -q --no-auto-props $t/wc/file
svn ci -mx $t/wc/file
@@ -72,7 +72,7 @@
svn ci -mx $t/wc/file
EOS
-work_nok('is not dir', 'a FILE should be a DIRECTORY in', <<"EOS");
+work_nok('is not dir', 'the component (dir) should be a DIR in', <<"EOS");
touch $t/wc/dir
svn add -q --no-auto-props $t/wc/dir
svn ci -mx $t/wc/dir
@@ -110,7 +110,7 @@
svn ci -mx $t/wc/preregexsuf/no
EOS
-work_nok('deny else', 'a FILE should be a DIRECTORY in', <<"EOS");
+work_nok('deny else', 'the component (else) should be a DIR in', <<"EOS");
touch $t/wc/else
svn add -q --no-auto-props $t/wc/else
svn ci -mx $t/wc/else
Added: branches/upstream/libsvn-hooks-perl/current/t/02-checkstructurealone.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsvn-hooks-perl/current/t/02-checkstructurealone.t?rev=32021&op=file
==============================================================================
--- branches/upstream/libsvn-hooks-perl/current/t/02-checkstructurealone.t (added)
+++ branches/upstream/libsvn-hooks-perl/current/t/02-checkstructurealone.t Fri Mar 13 09:23:21 2009
@@ -1,0 +1,64 @@
+use strict;
+use warnings;
+use Test::More tests => 14;
+use SVN::Hooks::CheckStructure;
+
+my $structure = [
+ file => 'FILE',
+ dir => 'DIR',
+ subdir1 => [
+ qr/^regex/ => 1,
+ qr/^noregex/ => 0,
+ 1 => 'FILE',
+ ],
+ subdir2 => [
+ subfile => 'FILE',
+ 0 => 'error 2',
+ ],
+ sub1 => [
+ sub2 => [
+ sub3 => [
+ ],
+ ],
+ ],
+];
+
+sub check_ok {
+ my ($path, $test) = @_;
+ eval {check_structure($structure, $path)};
+ ok(!$@, $test)
+ or diag $@;
+}
+
+sub check_nok {
+ my ($path, $expect, $test) = @_;
+ eval {check_structure($structure, $path)};
+ if ($@) {
+ like($@, $expect, $test);
+ }
+ else {
+ fail($test);
+ diag('test succeeded unexpectedly');
+ }
+}
+
+check_ok('/file', 'FILE ok');
+check_nok('/file/', qr/the component \(file\) should be a FILE/, 'FILE nok');
+
+check_ok('/dir/', 'DIR ok');
+check_nok('/dir', qr/the component \(dir\) should be a DIR/, 'DIR nok');
+
+check_nok('/subdir1', qr/the component \(subdir1\) should be a DIR/, 'array DIR nok');
+check_ok('/subdir1/', 'array DIR ok');
+
+check_ok('/subdir1/regex', 'regex ok');
+check_nok('/subdir1/noregex', qr/invalid path/, 'regex nok');
+
+check_ok('/subdir1/file', 'else FILE ok');
+check_nok('/subdir1/file/', qr/the component \(file\) should be a FILE/, 'else FILE nok');
+
+check_nok('/subdir2/other', qr/error 2/, '0 =>');
+
+check_ok('/sub1/', '/sub1');
+check_ok('/sub1/sub2/', '/sub1/sub2/');
+check_ok('/sub1/sub2/sub3/', '/sub1/sub2/sub3/');
Propchange: branches/upstream/libsvn-hooks-perl/current/t/02-checkstructurealone.t
------------------------------------------------------------------------------
svn:executable = *
More information about the Pkg-perl-cvs-commits
mailing list