Login
Change Modules::ProhibitEvilModules to include the bad module name in
[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
26babf22 15use List::MoreUtils qw(any);
c680a9c9 16
6ed4d974
ES
17use Perl::Critic::Exception::Configuration::Option::Policy::ParameterValue
18 qw{ throw_policy_value };
005d2cb9
ES
19use Perl::Critic::Utils qw{
20 :booleans :characters :severities :data_conversion
21};
c680a9c9 22
d59eec4b
JRT
23use base 'Perl::Critic::Policy';
24
173667ce 25our $VERSION = '1.093_01';
d59eec4b 26
fd5bd7b5
JRT
27#-----------------------------------------------------------------------------
28
c680a9c9 29Readonly::Scalar my $EXPL => q{Find an alternative module};
d59eec4b 30
6036a254 31#-----------------------------------------------------------------------------
d59eec4b 32
6ed4d974
ES
33sub supported_parameters {
34 return (
35 {
36 name => 'modules',
37 description => 'The names of or patterns for modules to forbid.',
38 default_string => $EMPTY,
39 behavior => 'string list',
40 },
41 );
42}
43
fd5bd7b5
JRT
44sub default_severity { return $SEVERITY_HIGHEST }
45sub default_themes { return qw( core bugs ) }
46sub applies_to { return 'PPI::Statement::Include' }
2c943bed 47
6036a254 48#-----------------------------------------------------------------------------
2c943bed 49
005d2cb9
ES
50sub initialize_if_enabled {
51 my ($self, $config) = @_;
d59eec4b 52
26babf22
JRT
53 $self->{_evil_modules} = {}; #Hash
54 $self->{_evil_modules_rx} = []; #Array
55
d59eec4b 56 #Set config, if defined
6ed4d974
ES
57 if ( defined $self->{_modules} ) {
58 my @modules = sort keys %{ $self->{_modules} };
59 foreach my $module ( @modules ) {
a0dcf06f 60 if ( $module =~ m{ \A [/] (.+) [/] \z }xms ) {
95ed7a74 61
702bf3be 62 # These are module name patterns (e.g. /Acme/)
a168820a 63 my $re = $1; # Untainting
a0dcf06f 64 my $pattern = eval { qr/$re/ }; ## no critic (RegularExpressions::.*)
95ed7a74 65
6ed4d974
ES
66 if ( $EVAL_ERROR ) {
67 throw_policy_value
68 policy => $self->get_short_name(),
69 option_name => 'modules',
70 option_value => ( join q{", "}, @modules ),
71 message_suffix =>
72 qq{contains an invalid regular expression: "$module"};
73 }
95ed7a74
JRT
74
75 push @{ $self->{_evil_modules_rx} }, $pattern;
26babf22
JRT
76 }
77 else {
702bf3be 78 # These are literal module names (e.g. Acme::Foo)
26babf22
JRT
79 $self->{_evil_modules}->{$module} = 1;
80 }
d59eec4b
JRT
81 }
82 }
005d2cb9
ES
83
84 return $TRUE;
d59eec4b
JRT
85}
86
6036a254 87#-----------------------------------------------------------------------------
d59eec4b
JRT
88
89sub violates {
e5f6c18d 90 my ( $self, $elem, undef ) = @_;
6015ad73
CD
91 my $module = $elem->module();
92 return if !$module;
26babf22
JRT
93
94 if ( exists $self->{_evil_modules}->{ $module } ||
2f54fe18 95 any { $module =~ $_ } @{ $self->{_evil_modules_rx} } ) {
26babf22 96
2f54fe18
ES
97 my $description = qq<Prohibited module "$module" used>;
98 return $self->violation( $description, $EXPL, $elem );
d59eec4b
JRT
99 }
100 return; #ok!
101}
102
1031;
104
105__END__
106
6036a254 107#-----------------------------------------------------------------------------
2c943bed 108
d59eec4b
JRT
109=pod
110
111=head1 NAME
112
f017d93a 113Perl::Critic::Policy::Modules::ProhibitEvilModules - Ban modules that aren't blessed by your shop.
d59eec4b 114
11f53956 115
af93c316
ES
116=head1 AFFILIATION
117
11f53956
ES
118This Policy is part of the core L<Perl::Critic|Perl::Critic>
119distribution.
af93c316
ES
120
121
d59eec4b
JRT
122=head1 DESCRIPTION
123
124Use this policy if you wish to prohibit the use of specific modules.
125These may be modules that you feel are deprecated, buggy, unsupported,
126insecure, or just don't like.
127
11f53956 128
8a25c8a0 129=head1 CONFIGURATION
d59eec4b 130
11f53956
ES
131The set of prohibited modules is configurable via the C<modules>
132option. The value of C<modules> should be a string of
133space-delimited, fully qualified module names and/or regular
134expressions. An example of prohibiting two specific modules in a
135F<.perlcriticrc> file:
136
137 [Modules::ProhibitEvilModules]
138 modules = Getopt::Std Autoload
d59eec4b 139
11f53956
ES
140Regular expressions are identified by values beginning and ending with
141slashes. Any module with a name that matches C<m/pattern/> will be
142forbidden. For example:
d59eec4b 143
11f53956
ES
144 [Modules::ProhibitEvilModules]
145 modules = /Acme::/
26babf22 146
11f53956
ES
147would cause all modules that match C<m/Acme::/> to be forbidden. You
148can add any of the C<imxs> switches to the end of a pattern, but be
149aware that patterns cannot contain whitespace because the
150configuration file parser uses it to delimit the module names and
151patterns.
26babf22 152
11f53956
ES
153By default, there are no prohibited modules (although I can think of a
154few that should be).
26babf22 155
d59eec4b
JRT
156
157=head1 NOTES
158
159Note that this policy doesn't apply to pragmas. Future versions may
160allow you to specify an alternative for each prohibited module, which
11f53956
ES
161can be suggested by L<Perl::Critic|Perl::Critic>.
162
d59eec4b
JRT
163
164=head1 AUTHOR
165
166Jeffrey Ryan Thalhammer <thaljef@cpan.org>
167
11f53956 168
d59eec4b
JRT
169=head1 COPYRIGHT
170
20dfddeb 171Copyright (c) 2005-2008 Jeffrey Ryan Thalhammer. All rights reserved.
d59eec4b
JRT
172
173This program is free software; you can redistribute it and/or modify
174it under the same terms as Perl itself. The full text of this license
175can be found in the LICENSE file included with this module.
176
177=cut
737d3b65
CD
178
179# Local Variables:
180# mode: cperl
181# cperl-indent-level: 4
182# fill-column: 78
183# indent-tabs-mode: nil
184# c-indentation-style: bsd
185# End:
96fed375 186# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :