1package SVN::Hooks::DenyFilenames;
2# ABSTRACT: Deny some file names.
3$SVN::Hooks::DenyFilenames::VERSION = '1.34';
4use strict;
5use warnings;
6
7use Carp;
8use Data::Util qw(:check);
9use SVN::Hooks;
10
11use Exporter qw/import/;
12my $HOOK = 'DENY_FILENAMES';
13our @EXPORT = ($HOOK, 'DENY_FILENAMES_PER_PATH');
14
15
16sub _grok_check {
17    my ($directive, $check) = @_;
18    if (is_rx($check)) {
19	return [$check => 'filename not allowed'];
20    } elsif (is_array_ref($check)) {
21	@$check == 2           or croak "$directive: array arguments must have two arguments.\n";
22	is_rx($check->[0])     or croak "$directive: got \"$check->[0]\" while expecting a qr/Regex/.\n";
23	is_string($check->[1]) or croak "$directive: got \"$check->[1]\" while expecting a string.\n";
24	return $check;
25    } else {
26	croak "$directive: got \"$check\" while expecting a qr/Regex/ or a [qr/Regex/, 'message'].\n";
27    }
28}
29
30my @Checks;			# default restrictions
31
32sub DENY_FILENAMES {
33    foreach my $check (@_) {
34	push @Checks, _grok_check('DENY_FILENAMES', $check);
35    }
36
37    PRE_COMMIT(\&pre_commit);
38
39    return 1;
40}
41
42
43my @Per_path_checks;		# per path restrictions
44
45sub DENY_FILENAMES_PER_PATH {
46
47    my (@rules) = @_;
48
49    @rules % 2 == 0
50	or croak "DENY_FILENAMES_PER_PATH: got odd number of arguments.\n";
51
52    while (@rules) {
53	my ($match, $check) = splice @rules, 0, 2;
54	is_rx($match) or croak "DENY_FILENAMES_PER_PATH: rule prefix isn't a Regexp.\n";
55
56	push @Per_path_checks, [$match => _grok_check('DENY_FILENAMES_PER_PATH', $check)];
57    }
58
59    PRE_COMMIT(\&pre_commit);
60
61    return 1;
62}
63
64sub pre_commit {
65    my ($svnlook) = @_;
66    my $errors;
67  ADDED:
68    foreach my $added ($svnlook->added()) {
69	foreach my $rule (@Per_path_checks) {
70	    if ($added =~ $rule->[0]) {
71		$errors .= "$HOOK: $rule->[1][1]: $added\n"
72		    if $added =~ $rule->[1][0];
73		next ADDED;
74	    }
75	}
76	foreach my $check (@Checks) {
77	    if ($added =~ $check->[0]) {
78		$errors .= "$HOOK: $check->[1]: $added\n";
79		next ADDED;
80	    }
81	}
82    }
83
84    croak $errors if $errors;
85}
86
871; # End of SVN::Hooks::DenyFilenames
88
89__END__
90
91=pod
92
93=encoding UTF-8
94
95=head1 NAME
96
97SVN::Hooks::DenyFilenames - Deny some file names.
98
99=head1 VERSION
100
101version 1.34
102
103=head1 SYNOPSIS
104
105This SVN::Hooks plugin is used to disallow the addition of some file
106names.
107
108It's active in the C<pre-commit> hook.
109
110It's configured by the following directives.
111
112=head2 DENY_FILENAMES(REGEXP, [REGEXP => MESSAGE], ...)
113
114This directive denies the addition of new files matching the Regexps
115passed as arguments. If any file or directory added in the commit
116matches one of the specified Regexps the commit is aborted with an
117error message telling about every denied file.
118
119The arguments may be compiled Regexps or two-element arrays consisting
120of a compiled Regexp and a specific error message. If a file matches
121one of the lone Regexps an error message like this is produced:
122
123        DENY_FILENAMES: filename not allowed: filename
124
125If a file matches a Regexp associated with an error message, the
126specified error message is substituted for the 'filename not allowed'
127default.
128
129Note that this directive specifies a default restriction. If there are
130any B<DENY_FILENAMES_PER_PATH> directives (see below) being used, this
131one is only used for files that don't match any specific rules there.
132
133Example:
134
135        DENY_FILENAMES(
136            qr/\.(doc|xls|ppt)$/i, # ODF only, please
137            [qr/\.(exe|zip|jar)/i => 'No binaries, please!'],
138        );
139
140=head2 DENY_FILENAMES_PER_PATH(REGEXP => REGEXP, REGEXP => [REGEXP => MESSAGE], ...)
141
142This directive is more specific than the B<DENY_FILENAMES>, because it
143allows one to specify different restrictions in different regions of
144the repository tree.
145
146Its arguments are a sequence of rules, each one consisting of a
147pair. The first element of each pair is a regular expression
148specifying where in the repository this rule applies. It applies if
149any file being added matches the regexp. The second element specifies
150the restrictions that should be imposed, just like the arguments to
151B<DENY_FILENAMES>.
152
153The first rule matching an added file is used to check it. The
154following rules aren't tried.
155
156Only if no rules match a particular file will the restrictions defined
157by B<DENY_FILENAMES> be imposed.
158
159Example:
160
161        DENY_FILENAMES_PER_PATH(
162            qr:/src/:   => [qr/[^\w.-]/ => 'source files must be strict'],
163            qr:/doc/:   => qr/[^\w\s.-]/i, # document files allow spaces too.
164            qr:/notes/: => qr/^$/,         # notes directory allows anything.
165        );
166
167=for Pod::Coverage pre_commit
168
169=head1 AUTHOR
170
171Gustavo L. de M. Chaves <gnustavo@cpan.org>
172
173=head1 COPYRIGHT AND LICENSE
174
175This software is copyright (c) 2016 by CPqD <www.cpqd.com.br>.
176
177This is free software; you can redistribute it and/or modify it under
178the same terms as the Perl 5 programming language system itself.
179
180=cut
181