view release on metacpan or  search on metacpan

lib/criticism.pm  view on Meta::CPAN

#######################################################################
#      $URL: http://perlcritic.tigris.org/svn/perlcritic/tags/criticism-1.02/lib/criticism.pm $
#     $Date: 2008-07-27 16:11:59 -0700 (Sun, 27 Jul 2008) $
#   $Author: thaljef $
# $Revision: 203 $
########################################################################

package criticism;

use strict;
use warnings;
use English qw(-no_match_vars);
use Carp qw(carp croak);

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

our $VERSION = 1.02;

#-----------------------------------------------------------------------------
# We could use the SEVERITY constants from Perl::Critic instead of magic
# numbers.  That would require us to load Perl::Critic, but this pragma
# must fail gracefully if Perl::Critic is not available.  Therefore, we're
# going to tolerate the magic numbers.

## no critic (ProhibitMagicNumbers);
my %SEVERITY_OF = (
    gentle => 5,
    stern  => 4,
    harsh  => 3,
    cruel  => 2,
    brutal => 1,
);
## use critic;

my $DEFAULT_MOOD = 'gentle';
my $DEFAULT_VERBOSE = "%m at %f line %l.\n";

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

sub import {

    my ($pkg, @args) = @_;
    my $file = (caller)[1];
    return 1 if not -f $file;
    my %pc_args = _make_pc_args( @args );
    return _critique( $file, %pc_args );
}

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

sub _make_pc_args {

    my (@args) = @_;
    my %pc_args = ();

    if (@args <= 1 ) {
        my $mood = $args[0] || $DEFAULT_MOOD;
        my $severity = $SEVERITY_OF{$mood} || _throw_mood_exception( $mood );
        %pc_args = (-severity => $severity, -verbose => $DEFAULT_VERBOSE);
    }
    else {
        %pc_args = @args;
        $pc_args{-verbose} ||= $DEFAULT_VERBOSE;
    }

    return %pc_args;
}

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

sub _critique {

    my ($file, %pc_args) = @_;
    my @violations = ();
    my $critic = undef;

    eval {
        require Perl::Critic;
        require Perl::Critic::Violation;
        $critic  = Perl::Critic->new( %pc_args );
        my $verbose = $critic->config->verbose();
        Perl::Critic::Violation::set_format($verbose);
        @violations = $critic->critique($file);
        print {*STDERR} @violations;
        1;
    }
    or do {
        if ($ENV{DEBUG} || $PERLDB) {
            carp qq{'criticism' failed to load: $EVAL_ERROR};
            return;
        }
    };

    die "Refusing to continue due to Perl::Critic violations.\n"
      if @violations && $critic->config->criticism_fatal();

    return @violations ? 0 : 1;
}

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

sub _throw_mood_exception {
    my ($mood) = @_;