Login
Added "criticim-fatal" switch, which will make the criticism
authorJeffrey Ryan Thalhammer <jeff@imaginative-software.com>
Mon, 14 Jan 2008 04:41:38 +0000 (04:41 +0000)
committerJeffrey Ryan Thalhammer <jeff@imaginative-software.com>
Mon, 14 Jan 2008 04:41:38 +0000 (04:41 +0000)
pragma die if it finds any violations.

Changes
lib/Perl/Critic.pm
lib/Perl/Critic/Config.pm
lib/Perl/Critic/Defaults.pm
t/00_modules.t
t/01_config.t
t/04_defaults.t

diff --git a/Changes b/Changes
index 41c4280..2a92e25 100644 (file)
--- a/Changes
+++ b/Changes
@@ -3,6 +3,11 @@
      New Policy:
      * Module::RequireNoMatchVarsWithUseEnglish
 
+     Miscellanea:
+     * Added support for "criticism-fatal" option in your perlcriticrc
+       file.  This will be used by the criticism pragma to cause execution
+       to abort if the file contains any violations.
+
 [1.081_005] Released on 2007-12-29
 
      Policy Changes:
index a61e942..d94fd90 100644 (file)
@@ -454,7 +454,7 @@ interface to the service are subject to change.
 
 =over 8
 
-=item C<< new( [ -profile => $FILE, -severity => $N, -theme => $string, -include => \@PATTERNS, -exclude => \@PATTERNS, -top => $N, -only => $B, -profile-strictness => $PROFILE_STRICTNESS_{WARN|FATAL|QUIET}, -force => $B, -verbose => $N ], -color => $B ) >>
+=item C<< new( [ -profile => $FILE, -severity => $N, -theme => $string, -include => \@PATTERNS, -exclude => \@PATTERNS, -top => $N, -only => $B, -profile-strictness => $PROFILE_STRICTNESS_{WARN|FATAL|QUIET}, -force => $B, -verbose => $N ], -color => $B, -criticism-fatal => $B) >>
 
 =item C<< new( -config => Perl::Critic::Config->new() ) >>
 
@@ -579,6 +579,9 @@ F<.perlcriticrc> file.
 B<-color> is not used by Perl::Critic but is provided for the benefit of
 L<perlcritic>.
 
+B<-criticism-fatal> is not used by Perl::Critic but is provided for the
+benefit of L<criticism>.
+
 B<-config> is a reference to a L<Perl::Critic::Config> object.  If you have
 created your own Config object for some reason, you can pass it in here
 instead of having Perl::Critic create one for you.  Using the C<-config>
@@ -686,6 +689,7 @@ constructor argument.
     theme     = (pbp || security) && bugs             #A theme expression
     include   = NamingConventions ClassHierarchies    #Space-delimited list
     exclude   = Variables  Modules::RequirePackage    #Space-delimited list
+    criticism-fatal = 1                               #Zero or One
     color     = 1                                     #Zero or One
 
 The remainder of the configuration file is a series of blocks like this:
index 6f07850..436e5e1 100644 (file)
@@ -95,6 +95,8 @@ sub _init {
         $self->{_force} = boolean_to_number( _dor( $args{-force}, $defaults->force() ) );
         $self->{_only}  = boolean_to_number( _dor( $args{-only},  $defaults->only()  ) );
         $self->{_color} = boolean_to_number( _dor( $args{-color}, $defaults->color() ) );
+        $self->{_criticism_fatal} =
+          boolean_to_number(_dor( $args{'-criticism_fatal'}, $defaults->criticism_fatal() ) );
     }
 
     $self->_validate_and_save_theme($args{-theme}, $errors);
@@ -726,6 +728,13 @@ sub color {
 
 #-----------------------------------------------------------------------------
 
+sub criticism_fatal {
+    my $self = shift;
+    return $self->{_criticism_fatal};
+}
+
+#-----------------------------------------------------------------------------
+
 sub site_policy_names {
     return Perl::Critic::PolicyFactory::site_policy_names();
 }
@@ -757,7 +766,7 @@ constructor will do it for you.
 
 =over 8
 
-=item C<< new( [ -profile => $FILE, -severity => $N, -theme => $string, -include => \@PATTERNS, -exclude => \@PATTERNS, -single-policy => $PATTERN, -top => $N, -only => $B, -profile-strictness => $PROFILE_STRICTNESS_{WARN|FATAL|QUIET}, -force => $B, -verbose => $N, -color => $B ] ) >>
+=item C<< new( [ -profile => $FILE, -severity => $N, -theme => $string, -include => \@PATTERNS, -exclude => \@PATTERNS, -single-policy => $PATTERN, -top => $N, -only => $B, -profile-strictness => $PROFILE_STRICTNESS_{WARN|FATAL|QUIET}, -force => $B, -verbose => $N, -color => $B, -criticism-fatal => $B] ) >>
 
 =item C<< new() >>
 
@@ -846,6 +855,11 @@ explanation of format specifications.
 B<-color> is not used by Perl::Critic but is provided for the benefit
 of L<perlcritic>.
 
+B<-criticism-fatal> is not used by Perl::Critic but is provided for the benefit
+of L<criticism>.
+
+
+
 =back
 
 =head1 METHODS
@@ -919,6 +933,10 @@ Returns the value of the C<-verbose> attribute for this Config.
 
 Returns the value of the C<-color> attribute for this Config.
 
+=item C< criticism_fatal() >
+
+Returns the value of the C<-criticsm-fatal> attribute for this Config.
+
 =back
 
 =head1 SUBROUTINES
index a0a4cd3..59286d8 100644 (file)
@@ -54,6 +54,7 @@ sub _init {
     $self->{_top}            = delete $args{top}              || $FALSE;
     $self->{_verbose}        = delete $args{verbose}          || $DEFAULT_VERBOSITY;
     $self->{_color}          = delete $args{color}            || $TRUE;
+    $self->{_criticism_fatal} = delete $args{'criticism-fatal'} || $FALSE;
 
     # If there's anything left, complain.
     _check_for_extra_options(%args);
@@ -149,6 +150,13 @@ sub color {
 
 #-----------------------------------------------------------------------------
 
+sub criticism_fatal {
+    my ($self) = @_;
+    return $self->{_criticism_fatal};
+}
+
+#-----------------------------------------------------------------------------
+
 sub force {
     my ($self) = @_;
     return $self->{_force};
@@ -225,7 +233,7 @@ string.
 
 =item C< single_policy() >
 
-Returns the default single-policy pattern.  (As a string.)
+Returns the default C<single-policy> pattern.  (As a string.)
 
 =item C< severity() >
 
@@ -248,6 +256,10 @@ string).
 
 Returns the default C<color> setting. (Either 1 or 0).
 
+=item C< criticism_fatal() >
+
+Returns the default C<criticism-fatal> setting (Either 1 or 0).
+
 =back
 
 =head1 AUTHOR
index e25d693..3dea610 100644 (file)
@@ -37,7 +37,7 @@ my @concrete_exceptions = qw{
 };
 
 plan tests =>
-        106
+        108
     +   (  9 * scalar @concrete_exceptions  )
     +   ( 14 * scalar @bundled_policy_names );
 
@@ -77,6 +77,7 @@ can_ok('Perl::Critic::Config', 'theme');
 can_ok('Perl::Critic::Config', 'top');
 can_ok('Perl::Critic::Config', 'verbose');
 can_ok('Perl::Critic::Config', 'color');
+can_ok('Perl::Critic::Config', 'criticism_fatal');
 can_ok('Perl::Critic::Config', 'site_policy_names');
 
 #Set -profile to avoid messing with .perlcriticrc
@@ -100,6 +101,7 @@ can_ok('Perl::Critic::Defaults', 'theme');
 can_ok('Perl::Critic::Defaults', 'top');
 can_ok('Perl::Critic::Defaults', 'verbose');
 can_ok('Perl::Critic::Defaults', 'color');
+can_ok('Perl::Critic::Defaults', 'criticism_fatal');
 
 my $defaults = Perl::Critic::Defaults->new();
 isa_ok($defaults, 'Perl::Critic::Defaults');
index 2ea2085..af286b9 100644 (file)
@@ -15,7 +15,7 @@ use List::MoreUtils qw(all any);
 use Perl::Critic::PolicyFactory (-test => 1);
 use Perl::Critic::Config qw();
 use Perl::Critic::Utils qw{ :severities };
-use Test::More (tests => 67);
+use Test::More (tests => 73);
 
 # common P::C testing tools
 use Perl::Critic::TestUtils qw{
@@ -193,7 +193,17 @@ my $total_policies   = scalar @names_of_policies_willing_to_work;
 # Test the switch behavior
 
 {
-    my @switches = qw(-top -verbose -theme -severity -only -force);
+    my @switches = qw(
+        -top
+        -verbose
+        -theme
+        -severity
+        -only
+        -force
+        -color
+        -criticism-fatal
+    );
+
     my %undef_args = map { $_ => undef } @switches;
     my $c = Perl::Critic::Config->new( %undef_args );
     is( $c->force(),     0,     'Undefined -force');
@@ -201,7 +211,9 @@ my $total_policies   = scalar @names_of_policies_willing_to_work;
     is( $c->severity(),  5,     'Undefined -severity');
     is( $c->theme()->rule(),   q{},   'Undefined -theme');
     is( $c->top(),       0,     'Undefined -top');
+    is( $c->color(),     1,     'Undefined -color');
     is( $c->verbose(),   4,     'Undefined -verbose');
+    is( $c->criticism_fatal(), 0, 'Undefined -criticism-fatal');
 
     my %zero_args = map { $_ => 0 } @switches;
     $c = Perl::Critic::Config->new( %zero_args );
@@ -210,7 +222,9 @@ my $total_policies   = scalar @names_of_policies_willing_to_work;
     is( $c->severity(),  1,       'zero -severity');
     is( $c->theme()->rule(),     q{},     'zero -theme');
     is( $c->top(),       0,       'zero -top');
+    is( $c->color(),     0,       'zero -color');
     is( $c->verbose(),   4,       'zero -verbose');
+    is( $c->criticism_fatal(), 0, 'zero -criticism-fatal');
 
     my %empty_args = map { $_ => q{} } @switches;
     $c = Perl::Critic::Config->new( %empty_args );
@@ -219,7 +233,9 @@ my $total_policies   = scalar @names_of_policies_willing_to_work;
     is( $c->severity(),  1,       'empty -severity');
     is( $c->theme->rule(),     q{},     'empty -theme');
     is( $c->top(),       0,       'empty -top');
+    is( $c->color(),     0,       'empty -color');
     is( $c->verbose(),   4,       'empty -verbose');
+    is( $c->criticism_fatal(), 0, 'empty -criticism-fatal');
 }
 
 #-----------------------------------------------------------------------------
index 182482d..c607575 100644 (file)
@@ -10,7 +10,7 @@
 use strict;
 use warnings;
 use English qw(-no_match_vars);
-use Test::More tests => 18;
+use Test::More tests => 21;
 use Perl::Critic::Defaults;
 
 #-----------------------------------------------------------------------------
@@ -22,7 +22,9 @@ use Perl::Critic::Defaults;
     is($d->severity(), 5,           'native default severity');
     is($d->theme(),    q{},         'native default theme');
     is($d->top(),      0,           'native default top');
+    is($d->color(),    1,           'native default color');
     is($d->verbose(),  4,           'native default verbose');
+    is($d->criticism_fatal,   0,    'native default criticism-fatal');
     is_deeply($d->include(), [],    'native default include');
     is_deeply($d->exclude(), [],    'native default exclude');
 }
@@ -36,7 +38,9 @@ use Perl::Critic::Defaults;
          severity  => 4,
          theme     => 'pbp',
          top       => 50,
+         color     => 1,
          verbose   => 7,
+         'criticism-fatal'   => 1,
          include   => 'foo bar',
          exclude   => 'baz nuts',
     );
@@ -48,6 +52,7 @@ use Perl::Critic::Defaults;
     is($d->theme(),    'pbp',       'user default theme');
     is($d->top(),      50,          'user default top');
     is($d->verbose(),  7,           'user default verbose');
+    is($d->criticism_fatal(),  1,   'user default criticism_fatal');
     is_deeply($d->include(), [ qw(foo bar) ], 'user default include');
     is_deeply($d->exclude(), [ qw(baz nuts)], 'user default exclude');
 }