git.maemo.org Git - pkg-perl/blob - deb-src/libperl-critic-perl/libperl-critic-perl-1.088/lib/Perl/Critic/Policy/Modules/ProhibitEvilModules.pm

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