Login
Allow specification of violation descriptions in ProhibitEvilModules.
[gknop/Perl-Critic.git] / lib / Perl / Critic / Policy / Modules / ProhibitEvilModules.pm
CommitLineData
6036a254 1##############################################################################
800f036a
CD
2# $URL$
3# $Date$
4# $Author$
5# $Revision$
6036a254 6##############################################################################
d59eec4b
JRT
7package Perl::Critic::Policy::Modules::ProhibitEvilModules;
8
df6dee2b 9use 5.006001;
d59eec4b
JRT
10use strict;
11use warnings;
7cc385e4 12use English qw(-no_match_vars);
c680a9c9
ES
13use Readonly;
14
6ed4d974
ES
15use Perl::Critic::Exception::Configuration::Option::Policy::ParameterValue
16 qw{ throw_policy_value };
005d2cb9
ES
17use Perl::Critic::Utils qw{
18 :booleans :characters :severities :data_conversion
19};
c680a9c9 20
d59eec4b
JRT
21use base 'Perl::Critic::Policy';
22
173667ce 23our $VERSION = '1.093_01';
d59eec4b 24
fd5bd7b5
JRT
25#-----------------------------------------------------------------------------
26
c680a9c9 27Readonly::Scalar my $EXPL => q{Find an alternative module};
d59eec4b 28
a6539177
ES
29Readonly::Scalar my $MODULE_NAME_REGEX =>
30 qr<
31 \b
32 [[:alpha:]_]
33 (?:
34 (?: \w | :: )*
35 \w
36 )?
37 \b
38 >xms;
39Readonly::Scalar my $REGULAR_EXPRESSION_REGEX => qr< [/] ( [^/]+ ) [/] >xms;
40Readonly::Scalar my $DESCRIPTION_REGEX => qr< [{] ( [^}]+ ) [}] >xms;
41
42# It's kind of unfortunate that I had to put capturing parentheses in the
43# component regexes above, because they're not visible here and so make
44# figuring out the positions of captures hard. Too bad we can't make the
45# minimum perl version 5.10. :]
46Readonly::Scalar my $MODULES_REGEX =>
47 qr<
48 \A
49 \s*
50 (?:
51 ( $MODULE_NAME_REGEX )
52 | $REGULAR_EXPRESSION_REGEX
53 )
54 (?: \s* $DESCRIPTION_REGEX )?
55 \s*
56 >xms;
57
58# Indexes in the arrays of regexes for the "modules" option.
59Readonly::Scalar my $INDEX_REGEX => 0;
60Readonly::Scalar my $INDEX_DESCRIPTION => 1;
61
6036a254 62#-----------------------------------------------------------------------------
d59eec4b 63
6ed4d974
ES
64sub supported_parameters {
65 return (
66 {
67 name => 'modules',
68 description => 'The names of or patterns for modules to forbid.',
69 default_string => $EMPTY,
2e2680d2 70 parser => \&_parse_modules,
6ed4d974
ES
71 },
72 );
73}
74
fd5bd7b5
JRT
75sub default_severity { return $SEVERITY_HIGHEST }
76sub default_themes { return qw( core bugs ) }
77sub applies_to { return 'PPI::Statement::Include' }
2c943bed 78
6036a254 79#-----------------------------------------------------------------------------
2c943bed 80
2e2680d2
ES
81sub _parse_modules {
82 my ($self, $parameter, $config_string) = @_;
d59eec4b 83
2e2680d2 84 return if not defined $config_string;
26babf22 85
2e2680d2 86 my %evil_modules;
95ed7a74 87
a6539177
ES
88 # Can't use a hash due to stringification, so this is an AoA.
89 my @evil_modules_regexes;
90
91 my $module_specifications = $config_string;
92 while ( $module_specifications =~ s< $MODULES_REGEX ><>xms ) {
93 my ($module, $regex_string, $description) = ($1, $2, $3);
95ed7a74 94
a6539177 95 if ( $regex_string ) {
2e2680d2 96 # These are module name patterns (e.g. /Acme/)
a6539177 97 my $actual_regex;
95ed7a74 98
a6539177
ES
99 eval { $actual_regex = qr/$regex_string/; 1 } ## no critic (RegularExpressions::.*)
100 or throw_policy_value
2e2680d2
ES
101 policy => $self->get_short_name(),
102 option_name => 'modules',
a6539177 103 option_value => $config_string,
2e2680d2 104 message_suffix =>
a6539177 105 qq{contains an invalid regular expression: "$regex_string"};
2e2680d2 106
a6539177
ES
107 push
108 @evil_modules_regexes,
109 [ $actual_regex, $description || $EMPTY ];
2e2680d2
ES
110 }
111 else {
112 # These are literal module names (e.g. Acme::Foo)
a6539177 113 $evil_modules{$module} = $description || $EMPTY;
d59eec4b
JRT
114 }
115 }
005d2cb9 116
a6539177
ES
117 if ($module_specifications) {
118 throw_policy_value
119 policy => $self->get_short_name(),
120 option_name => 'modules',
121 option_value => $config_string,
122 message_suffix =>
123 qq{contains unparseable data: "$module_specifications"};
124 }
125
126 $self->{_evil_modules} = \%evil_modules;
127 $self->{_evil_modules_regexes} = \@evil_modules_regexes;
2e2680d2
ES
128
129 return;
d59eec4b
JRT
130}
131
6036a254 132#-----------------------------------------------------------------------------
d59eec4b
JRT
133
134sub violates {
e5f6c18d 135 my ( $self, $elem, undef ) = @_;
a6539177 136
6015ad73 137 my $module = $elem->module();
a6539177 138 return if not $module;
26babf22 139
a6539177
ES
140 my $evil_modules = $self->{_evil_modules};
141 my $evil_modules_regexes = $self->{_evil_modules_regexes};
142 my $description;
143
144 if ( exists $evil_modules->{$module} ) {
145 $description = $evil_modules->{ $module };
146 }
147 else {
148 REGEX:
149 foreach my $regex ( @{$evil_modules_regexes} ) {
150 if ( $module =~ $regex->[$INDEX_REGEX] ) {
151 $description = $regex->[$INDEX_DESCRIPTION];
152 last REGEX;
153 }
154 }
155 }
156
157 if (defined $description) {
158 $description ||= qq<Prohibited module "$module" used>;
26babf22 159
2f54fe18 160 return $self->violation( $description, $EXPL, $elem );
d59eec4b 161 }
a6539177
ES
162
163 return; # ok!
d59eec4b
JRT
164}
165
1661;
167
168__END__
169
6036a254 170#-----------------------------------------------------------------------------
2c943bed 171
d59eec4b
JRT
172=pod
173
174=head1 NAME
175
f017d93a 176Perl::Critic::Policy::Modules::ProhibitEvilModules - Ban modules that aren't blessed by your shop.
d59eec4b 177
11f53956 178
af93c316
ES
179=head1 AFFILIATION
180
11f53956
ES
181This Policy is part of the core L<Perl::Critic|Perl::Critic>
182distribution.
af93c316
ES
183
184
d59eec4b
JRT
185=head1 DESCRIPTION
186
187Use this policy if you wish to prohibit the use of specific modules.
188These may be modules that you feel are deprecated, buggy, unsupported,
189insecure, or just don't like.
190
11f53956 191
8a25c8a0 192=head1 CONFIGURATION
d59eec4b 193
11f53956
ES
194The set of prohibited modules is configurable via the C<modules>
195option. The value of C<modules> should be a string of
196space-delimited, fully qualified module names and/or regular
197expressions. An example of prohibiting two specific modules in a
198F<.perlcriticrc> file:
199
200 [Modules::ProhibitEvilModules]
201 modules = Getopt::Std Autoload
d59eec4b 202
11f53956
ES
203Regular expressions are identified by values beginning and ending with
204slashes. Any module with a name that matches C<m/pattern/> will be
205forbidden. For example:
d59eec4b 206
11f53956
ES
207 [Modules::ProhibitEvilModules]
208 modules = /Acme::/
26babf22 209
a6539177
ES
210would cause all modules that match C<m/Acme::/> to be forbidden.
211
212In addition, you can override the default message ("Prohibited module
213"I<module>" used") with your own, in order to give suggestions for
214alternative action. To do so, put your message in curly brackets
215after the module name or regular expression. Like this:
216
217 [Modules::ProhibitEvilModules]
218 modules = Fatal {Found use of Fatal. Use autodie instead} /Acme::/ {We don't use joke modules}
26babf22 219
11f53956
ES
220By default, there are no prohibited modules (although I can think of a
221few that should be).
26babf22 222
d59eec4b
JRT
223
224=head1 NOTES
225
a6539177 226Note that this policy doesn't apply to pragmas.
11f53956 227
d59eec4b
JRT
228
229=head1 AUTHOR
230
231Jeffrey Ryan Thalhammer <thaljef@cpan.org>
232
11f53956 233
d59eec4b
JRT
234=head1 COPYRIGHT
235
20dfddeb 236Copyright (c) 2005-2008 Jeffrey Ryan Thalhammer. All rights reserved.
d59eec4b
JRT
237
238This program is free software; you can redistribute it and/or modify
239it under the same terms as Perl itself. The full text of this license
240can be found in the LICENSE file included with this module.
241
242=cut
737d3b65
CD
243
244# Local Variables:
245# mode: cperl
246# cperl-indent-level: 4
247# fill-column: 78
248# indent-tabs-mode: nil
249# c-indentation-style: bsd
250# End:
96fed375 251# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :