line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package SVN::Hooks::CheckStructure; |
2
|
|
|
|
|
|
|
{ |
3
|
|
|
|
|
|
|
$SVN::Hooks::CheckStructure::VERSION = '1.27'; |
4
|
|
|
|
|
|
|
} |
5
|
|
|
|
|
|
|
# ABSTRACT: Check the structure of a repository. |
6
|
|
|
|
|
|
|
|
7
|
1
|
|
|
1
|
|
61089
|
use strict; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
38
|
|
8
|
1
|
|
|
1
|
|
4
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
28
|
|
9
|
|
|
|
|
|
|
|
10
|
1
|
|
|
1
|
|
5
|
use Carp; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
135
|
|
11
|
1
|
|
|
1
|
|
1055
|
use Data::Util qw(:check); |
|
1
|
|
|
|
|
1230
|
|
|
1
|
|
|
|
|
254
|
|
12
|
1
|
|
|
1
|
|
1218
|
use SVN::Hooks; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
use Exporter qw/import/; |
15
|
|
|
|
|
|
|
my $HOOK = 'CHECK_STRUCTURE'; |
16
|
|
|
|
|
|
|
our @EXPORT = ($HOOK, 'check_structure'); |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
my $Structure; |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
sub CHECK_STRUCTURE { |
22
|
|
|
|
|
|
|
($Structure) = @_; |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
PRE_COMMIT(\&pre_commit); |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
return 1; |
27
|
|
|
|
|
|
|
} |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
sub _check_structure { |
30
|
|
|
|
|
|
|
my ($structure, $path) = @_; |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
@$path > 0 or croak "Can't happen!"; |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
if (is_string($structure)) { |
35
|
|
|
|
|
|
|
if ($structure eq 'DIR') { |
36
|
|
|
|
|
|
|
return (1) if @$path > 1; |
37
|
|
|
|
|
|
|
return (0, "the component ($path->[0]) should be a DIR in"); |
38
|
|
|
|
|
|
|
} elsif ($structure eq 'FILE') { |
39
|
|
|
|
|
|
|
return (0, "the component ($path->[0]) should be a FILE in") if @$path > 1; |
40
|
|
|
|
|
|
|
return (1); |
41
|
|
|
|
|
|
|
} elsif (is_integer($structure)) { |
42
|
|
|
|
|
|
|
return (1) if $structure; |
43
|
|
|
|
|
|
|
return (0, "invalid path"); |
44
|
|
|
|
|
|
|
} else { |
45
|
|
|
|
|
|
|
return (0, "syntax error: unknown string spec ($structure), while checking"); |
46
|
|
|
|
|
|
|
} |
47
|
|
|
|
|
|
|
} elsif (is_array_ref($structure)) { |
48
|
|
|
|
|
|
|
return (0, "syntax error: odd number of elements in the structure spec, while checking") |
49
|
|
|
|
|
|
|
unless scalar(@$structure) % 2 == 0; |
50
|
|
|
|
|
|
|
return (0, "the component ($path->[0]) should be a DIR in") |
51
|
|
|
|
|
|
|
unless @$path > 1; |
52
|
|
|
|
|
|
|
shift @$path; |
53
|
|
|
|
|
|
|
# Return ok if the directory doesn't have subcomponents. |
54
|
|
|
|
|
|
|
return (1) if @$path == 1 && length($path->[0]) == 0; |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
for (my $s=0; $s<$#$structure; $s+=2) { |
57
|
|
|
|
|
|
|
my ($lhs, $rhs) = @{$structure}[$s, $s+1]; |
58
|
|
|
|
|
|
|
if (is_string($lhs)) { |
59
|
|
|
|
|
|
|
if ($lhs eq $path->[0]) { |
60
|
|
|
|
|
|
|
return _check_structure($rhs, $path); |
61
|
|
|
|
|
|
|
} elsif (is_integer($lhs)) { |
62
|
|
|
|
|
|
|
if ($lhs) { |
63
|
|
|
|
|
|
|
return _check_structure($rhs, $path); |
64
|
|
|
|
|
|
|
} elsif (is_string($rhs)) { |
65
|
|
|
|
|
|
|
return (0, "$rhs, while checking"); |
66
|
|
|
|
|
|
|
} else { |
67
|
|
|
|
|
|
|
return (0, "syntax error: the right hand side of a number must be string, while checking"); |
68
|
|
|
|
|
|
|
} |
69
|
|
|
|
|
|
|
} |
70
|
|
|
|
|
|
|
} elsif (is_rx($lhs)) { |
71
|
|
|
|
|
|
|
if ($path->[0] =~ $lhs) { |
72
|
|
|
|
|
|
|
return _check_structure($rhs, $path); |
73
|
|
|
|
|
|
|
} |
74
|
|
|
|
|
|
|
} else { |
75
|
|
|
|
|
|
|
my $what = ref $lhs; |
76
|
|
|
|
|
|
|
return (0, "syntax error: the left hand side of arrays in the structure spec must be scalars or qr/Regexes/, not $what, while checking"); |
77
|
|
|
|
|
|
|
} |
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
return (0, "the component ($path->[0]) is not allowed in"); |
80
|
|
|
|
|
|
|
} else { |
81
|
|
|
|
|
|
|
my $what = ref $structure; |
82
|
|
|
|
|
|
|
return (0, "syntax error: invalid reference to a $what in the structure spec, while checking"); |
83
|
|
|
|
|
|
|
} |
84
|
|
|
|
|
|
|
} |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
sub check_structure { |
88
|
|
|
|
|
|
|
my ($structure, $path) = @_; |
89
|
|
|
|
|
|
|
$path = "/$path" unless $path =~ m@^/@; # make sure it's an absolute path |
90
|
|
|
|
|
|
|
my @path = split '/', $path, -1; # preserve trailing empty components |
91
|
|
|
|
|
|
|
my ($code, $error) = _check_structure($structure, \@path); |
92
|
|
|
|
|
|
|
croak "$error: $path\n" if $code == 0; |
93
|
|
|
|
|
|
|
return 1; |
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
sub pre_commit { |
97
|
|
|
|
|
|
|
my ($svnlook) = @_; |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
my @errors; |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
foreach my $added ($svnlook->added()) { |
102
|
|
|
|
|
|
|
# Split the $added path in its components. We prefix $added |
103
|
|
|
|
|
|
|
# with a slash to make it look like an absolute path for |
104
|
|
|
|
|
|
|
# _check_structure. The '-1' is to preserve trailing empty |
105
|
|
|
|
|
|
|
# components so that we can differentiate directory paths from |
106
|
|
|
|
|
|
|
# file paths. |
107
|
|
|
|
|
|
|
my @added = split '/', "/$added", -1; |
108
|
|
|
|
|
|
|
my ($code, $error) = _check_structure($Structure, \@added); |
109
|
|
|
|
|
|
|
push @errors, "$error: $added" if $code == 0; |
110
|
|
|
|
|
|
|
} |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
croak join("\n", "$HOOK:", @errors), "\n" |
113
|
|
|
|
|
|
|
if @errors; |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
return; |
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
1; # End of SVN::Hooks::CheckStructure |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
__END__ |