Login
Change Modules::ProhibitEvilModules::initialize_if_enabled() into a
[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,
2e2680d2 39 parser => \&_parse_modules,
6ed4d974
ES
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
2e2680d2
ES
50sub _parse_modules {
51 my ($self, $parameter, $config_string) = @_;
d59eec4b 52
2e2680d2 53 return if not defined $config_string;
26babf22 54
2e2680d2
ES
55 my %evil_modules;
56 my @evil_modules_rx;
95ed7a74 57
2e2680d2
ES
58 my @modules = words_from_string($config_string);
59 foreach my $module ( @modules ) {
60 if ( $module =~ m{ \A [/] (.+) [/] \z }xms ) {
95ed7a74 61
2e2680d2
ES
62 # These are module name patterns (e.g. /Acme/)
63 my $re = $1; # Untainting
64 my $pattern = eval { qr/$re/ }; ## no critic (RegularExpressions::.*)
95ed7a74 65
2e2680d2
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"};
26babf22 73 }
2e2680d2
ES
74
75 push @evil_modules_rx, $pattern;
76 }
77 else {
78 # These are literal module names (e.g. Acme::Foo)
79 $evil_modules{$module} = 1;
d59eec4b
JRT
80 }
81 }
005d2cb9 82
2e2680d2
ES
83 $self->{_evil_modules} = \%evil_modules;
84 $self->{_evil_modules_rx} = \@evil_modules_rx;
85
86 return;
d59eec4b
JRT
87}
88
6036a254 89#-----------------------------------------------------------------------------
d59eec4b
JRT
90
91sub violates {
e5f6c18d 92 my ( $self, $elem, undef ) = @_;
6015ad73
CD
93 my $module = $elem->module();
94 return if !$module;
26babf22
JRT
95
96 if ( exists $self->{_evil_modules}->{ $module } ||
2f54fe18 97 any { $module =~ $_ } @{ $self->{_evil_modules_rx} } ) {
26babf22 98
2f54fe18
ES
99 my $description = qq<Prohibited module "$module" used>;
100 return $self->violation( $description, $EXPL, $elem );
d59eec4b
JRT
101 }
102 return; #ok!
103}
104
1051;
106
107__END__
108
6036a254 109#-----------------------------------------------------------------------------
2c943bed 110
d59eec4b
JRT
111=pod
112
113=head1 NAME
114
f017d93a 115Perl::Critic::Policy::Modules::ProhibitEvilModules - Ban modules that aren't blessed by your shop.
d59eec4b 116
11f53956 117
af93c316
ES
118=head1 AFFILIATION
119
11f53956
ES
120This Policy is part of the core L<Perl::Critic|Perl::Critic>
121distribution.
af93c316
ES
122
123
d59eec4b
JRT
124=head1 DESCRIPTION
125
126Use this policy if you wish to prohibit the use of specific modules.
127These may be modules that you feel are deprecated, buggy, unsupported,
128insecure, or just don't like.
129
11f53956 130
8a25c8a0 131=head1 CONFIGURATION
d59eec4b 132
11f53956
ES
133The set of prohibited modules is configurable via the C<modules>
134option. The value of C<modules> should be a string of
135space-delimited, fully qualified module names and/or regular
136expressions. An example of prohibiting two specific modules in a
137F<.perlcriticrc> file:
138
139 [Modules::ProhibitEvilModules]
140 modules = Getopt::Std Autoload
d59eec4b 141
11f53956
ES
142Regular expressions are identified by values beginning and ending with
143slashes. Any module with a name that matches C<m/pattern/> will be
144forbidden. For example:
d59eec4b 145
11f53956
ES
146 [Modules::ProhibitEvilModules]
147 modules = /Acme::/
26babf22 148
11f53956
ES
149would cause all modules that match C<m/Acme::/> to be forbidden. You
150can add any of the C<imxs> switches to the end of a pattern, but be
151aware that patterns cannot contain whitespace because the
152configuration file parser uses it to delimit the module names and
153patterns.
26babf22 154
11f53956
ES
155By default, there are no prohibited modules (although I can think of a
156few that should be).
26babf22 157
d59eec4b
JRT
158
159=head1 NOTES
160
161Note that this policy doesn't apply to pragmas. Future versions may
162allow you to specify an alternative for each prohibited module, which
11f53956
ES
163can be suggested by L<Perl::Critic|Perl::Critic>.
164
d59eec4b
JRT
165
166=head1 AUTHOR
167
168Jeffrey Ryan Thalhammer <thaljef@cpan.org>
169
11f53956 170
d59eec4b
JRT
171=head1 COPYRIGHT
172
20dfddeb 173Copyright (c) 2005-2008 Jeffrey Ryan Thalhammer. All rights reserved.
d59eec4b
JRT
174
175This program is free software; you can redistribute it and/or modify
176it under the same terms as Perl itself. The full text of this license
177can be found in the LICENSE file included with this module.
178
179=cut
737d3b65
CD
180
181# Local Variables:
182# mode: cperl
183# cperl-indent-level: 4
184# fill-column: 78
185# indent-tabs-mode: nil
186# c-indentation-style: bsd
187# End:
96fed375 188# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :