#######################################################################
#      $URL: http://perlcritic.tigris.org/svn/perlcritic/tags/Perl-Critic-0.20/lib/Perl/Critic/Policy/Modules/ProhibitEvilModules.pm $
#     $Date: 2006-09-10 21:18:18 -0700 (Sun, 10 Sep 2006) $
#   $Author: thaljef $
# $Revision: 663 $
# ex: set ts=8 sts=4 sw=4 expandtab
########################################################################
package Perl::Critic::Policy::Modules::ProhibitEvilModules;

use strict;
use warnings;
use Carp qw(cluck);
use English qw(-no_match_vars);
use List::MoreUtils qw(any);
use Perl::Critic::Utils;
use base 'Perl::Critic::Policy';

our $VERSION = 0.20;

my $expl = q{Find an alternative module};
my $desc = q{Prohibited module used};

#----------------------------------------------------------------------------

sub default_severity { return $SEVERITY_HIGHEST }
sub applies_to { return 'PPI::Statement::Include' }

#----------------------------------------------------------------------------

sub new {
    my ( $class, %args ) = @_;
    my $self = bless {}, $class;

    $self->{_evil_modules}    = {};  #Hash
    $self->{_evil_modules_rx} = [];  #Array

    #Set config, if defined
    if ( defined $args{modules} ) {
        for my $module ( split m{ \s+ }mx, $args{modules} ) {
            if ( $module =~ m{ \A [/] (.+) [/] \z }mx ) {
                # These are module name patterns (e.g. /Acme/)
                my $re = $1; # Untainting
                my $pattern = eval { qr/$re/ };
                if ( $EVAL_ERROR ) {
                    cluck qq{Regexp syntax error in "$module"};
                }
                else {
                    push @{ $self->{_evil_modules_rx} }, $pattern;
                }
            }
            else {
                # These are literal module names (e.g. Acme::Foo)
                $self->{_evil_modules}->{$module} = 1;
            }
        }
    }
    return $self;
}

#----------------------------------------------------------------------------

sub violates {
    my ( $self, $elem, undef ) = @_;
    my $module = $elem->module();
    return if !$module;

    if ( exists $self->{_evil_modules}->{ $module } ||
         any { $module =~ $_ } @{ $self->{_evil_modules_rx} } ) {

        return $self->violation( $desc, $expl, $elem );
    }
    return;    #ok!
}

1;

__END__

#----------------------------------------------------------------------------

=pod

=head1 NAME

Perl::Critic::Policy::Modules::ProhibitEvilModules

=head1 DESCRIPTION

Use this policy if you wish to prohibit the use of specific modules.
These may be modules that you feel are deprecated, buggy, unsupported,
insecure, or just don't like.

=head1 CONSTRUCTOR

This policy accepts an additional key-value pair in the C<new> method.
The key should be 'modules' and the value is a string of
space-delimited fully qualified module names.  These can be configured
in the F<.perlcriticrc> file like this:

 [Modules::ProhibitEvilModules]
 modules = Getopt::Std  Autoload

If any module name in your configuration is braced with slashes, it
is interpreted as a regular expression.  So any module that matches
C<m/$module_name/> will be forbidden.  For example:

  [Modules::ProhibitEvilModules]
  modules = /Acme::/

would cause all modules that match C<m/Acme::/> to be forbidden.  You
can add any of the C<imxs> switches to the end of the pattern, but
beware that your pattern should not contain spaces, lest the parser
get confused.

By default, there are no prohibited modules (although I can think
of a few that should be).

=head1 NOTES

Note that this policy doesn't apply to pragmas.  Future versions may
allow you to specify an alternative for each prohibited module, which
can be suggested by L<Perl::Critic>.

=head1 AUTHOR

Jeffrey Ryan Thalhammer <thaljef@cpan.org>

=head1 COPYRIGHT

Copyright (c) 2005-2006 Jeffrey Ryan Thalhammer.  All rights reserved.

This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.  The full text of this license
can be found in the LICENSE file included with this module.

=cut