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