Login
Put severity setting in the perlcriticrc file
[gknop/Perl-Critic.git] / lib / Perl / Critic / Policy / Modules / ProhibitEvilModules.pm
CommitLineData
800f036a
CD
1#######################################################################
2# $URL$
3# $Date$
4# $Author$
5# $Revision$
6########################################################################
d59eec4b
JRT
7package Perl::Critic::Policy::Modules::ProhibitEvilModules;
8
9use strict;
10use warnings;
a168820a 11use Carp qw(cluck);
7cc385e4 12use English qw(-no_match_vars);
26babf22 13use List::MoreUtils qw(any);
d59eec4b 14use Perl::Critic::Utils;
d59eec4b
JRT
15use base 'Perl::Critic::Policy';
16
a7340650 17our $VERSION = 0.22;
d59eec4b
JRT
18
19my $expl = q{Find an alternative module};
20my $desc = q{Prohibited module used};
21
22#----------------------------------------------------------------------------
23
7a6b5c70
JRT
24sub default_severity { return $SEVERITY_HIGHEST }
25sub default_themes { return qw(danger) }
26sub applies_to { return 'PPI::Statement::Include' }
2c943bed
JRT
27
28#----------------------------------------------------------------------------
29
d59eec4b
JRT
30sub new {
31 my ( $class, %args ) = @_;
32 my $self = bless {}, $class;
33
26babf22
JRT
34 $self->{_evil_modules} = {}; #Hash
35 $self->{_evil_modules_rx} = []; #Array
36
d59eec4b
JRT
37 #Set config, if defined
38 if ( defined $args{modules} ) {
39 for my $module ( split m{ \s+ }mx, $args{modules} ) {
7cc385e4 40 if ( $module =~ m{ \A [/] (.+) [/] \z }mx ) {
702bf3be 41 # These are module name patterns (e.g. /Acme/)
a168820a 42 my $re = $1; # Untainting
7cc385e4
CD
43 my $pattern = eval { qr/$re/ };
44 if ( $EVAL_ERROR ) {
a168820a 45 cluck qq{Regexp syntax error in "$module"};
7cc385e4
CD
46 }
47 else {
48 push @{ $self->{_evil_modules_rx} }, $pattern;
49 }
26babf22
JRT
50 }
51 else {
702bf3be 52 # These are literal module names (e.g. Acme::Foo)
26babf22
JRT
53 $self->{_evil_modules}->{$module} = 1;
54 }
d59eec4b
JRT
55 }
56 }
57 return $self;
58}
59
2c943bed 60#----------------------------------------------------------------------------
d59eec4b
JRT
61
62sub violates {
e5f6c18d 63 my ( $self, $elem, undef ) = @_;
6015ad73
CD
64 my $module = $elem->module();
65 return if !$module;
26babf22
JRT
66
67 if ( exists $self->{_evil_modules}->{ $module } ||
68 any { $module =~ $_ } @{ $self->{_evil_modules_rx} } ) {
69
2c6df011 70 return $self->violation( $desc, $expl, $elem );
d59eec4b
JRT
71 }
72 return; #ok!
73}
74
751;
76
77__END__
78
2c943bed
JRT
79#----------------------------------------------------------------------------
80
d59eec4b
JRT
81=pod
82
83=head1 NAME
84
85Perl::Critic::Policy::Modules::ProhibitEvilModules
86
87=head1 DESCRIPTION
88
89Use this policy if you wish to prohibit the use of specific modules.
90These may be modules that you feel are deprecated, buggy, unsupported,
91insecure, or just don't like.
92
93=head1 CONSTRUCTOR
94
95This policy accepts an additional key-value pair in the C<new> method.
96The key should be 'modules' and the value is a string of
2c943bed
JRT
97space-delimited fully qualified module names. These can be configured
98in the F<.perlcriticrc> file like this:
d59eec4b
JRT
99
100 [Modules::ProhibitEvilModules]
101 modules = Getopt::Std Autoload
102
26babf22
JRT
103If any module name in your configuration is braced with slashes, it
104is interpreted as a regular expression. So any module that matches
105C<m/$module_name/> will be forbidden. For example:
106
107 [Modules::ProhibitEvilModules]
108 modules = /Acme::/
109
110would cause all modules that match C<m/Acme::/> to be forbidden. You
111can add any of the C<imxs> switches to the end of the pattern, but
112beware that your pattern should not contain spaces, lest the parser
40b4a6ae 113get confused.
26babf22 114
40b4a6ae 115By default, there are no prohibited modules (although I can think
d59eec4b
JRT
116of a few that should be).
117
118=head1 NOTES
119
120Note that this policy doesn't apply to pragmas. Future versions may
121allow you to specify an alternative for each prohibited module, which
122can be suggested by L<Perl::Critic>.
123
124=head1 AUTHOR
125
126Jeffrey Ryan Thalhammer <thaljef@cpan.org>
127
128=head1 COPYRIGHT
129
c3c88e54 130Copyright (c) 2005-2006 Jeffrey Ryan Thalhammer. All rights reserved.
d59eec4b
JRT
131
132This program is free software; you can redistribute it and/or modify
133it under the same terms as Perl itself. The full text of this license
134can be found in the LICENSE file included with this module.
135
136=cut
737d3b65
CD
137
138# Local Variables:
139# mode: cperl
140# cperl-indent-level: 4
141# fill-column: 78
142# indent-tabs-mode: nil
143# c-indentation-style: bsd
144# End:
dbb78cdc 145# ex: set ts=8 sts=4 sw=4 expandtab :