Login
Created a new Policy to prohibit an unrestricted ## no critic.
authorJeffrey Ryan Thalhammer <jeff@imaginative-software.com>
Sun, 28 Sep 2008 02:32:42 +0000 (02:32 +0000)
committerJeffrey Ryan Thalhammer <jeff@imaginative-software.com>
Sun, 28 Sep 2008 02:32:42 +0000 (02:32 +0000)
I was able to implement this as a policy rather than a
command-line switch by adding a method to the Policy
base class that indicates whether the policy can be disabled.

I can think of a few other applications for this new method,
such as policy that prohibits you from disabling certain other
policies.  For example, shops using Test::Perl::Critic
may wish to prevent unruly developers from locally disabling
some policies that they feel are irrefutable.  I realize
that it isn't very kind, but I've been in situations where I
wished that I could do that.

Changes
TODO.pod
lib/Perl/Critic.pm
lib/Perl/Critic/Policy.pm
lib/Perl/Critic/Policy/Miscellanea/ProhibitUnrestrictedNoCritic.pm [new file with mode: 0644]
t/03_pragmas.t
t/Miscellanea/ProhibitUnrestrictedNoCritic.run [new file with mode: 0644]

diff --git a/Changes b/Changes
index 8200031..9aaab2e 100644 (file)
--- a/Changes
+++ b/Changes
@@ -14,6 +14,9 @@
       Unfortunately, autodie is currently treated like a module and not a
       pragma, which means that the lexical scoping is not taken into account.
 
       Unfortunately, autodie is currently treated like a module and not a
       pragma, which means that the lexical scoping is not taken into account.
 
+    New Policies:
+    * Miscellanea::ProhibitUnrestrictedNoCritic
+    
 [1.093_01] Released on 2008-09-07
 
     New Developer Features:
 [1.093_01] Released on 2008-09-07
 
     New Developer Features:
index a906572..7f7b00e 100644 (file)
--- a/TODO.pod
+++ b/TODO.pod
@@ -62,17 +62,6 @@ applies_to.
 Support Jeff Bisbee's use case (he dumps all the policies in severity order
 with full descriptions and other metadata).
 
 Support Jeff Bisbee's use case (he dumps all the policies in severity order
 with full descriptions and other metadata).
 
-=item * Add --prohibit-unrestricted-no-critic option to F<perlcritic>.
-
-Requires C<## no critic> to take an argument:
-
-  ## no critic (SomePolicyPattern)     # ok
-  ## no critic                         # not ok
-
-Can't be done as a regular Policy because any line that violated it would
-disable it.
-
-
 =item * Support for C<#line 123 "filename"> directives.
 
 For code generators and template languages that allow inline Perl code.
 =item * Support for C<#line 123 "filename"> directives.
 
 For code generators and template languages that allow inline Perl code.
index 6593e85..02fb5fd 100644 (file)
@@ -215,8 +215,10 @@ sub _critique {
             for my $violation ( $policy->violates( $element, $doc ) ) {
                 my $line = $violation->location()->[0];
                 if (exists $is_line_disabled->{$line}) {
             for my $violation ( $policy->violates( $element, $doc ) ) {
                 my $line = $violation->location()->[0];
                 if (exists $is_line_disabled->{$line}) {
-                    next VIOLATION if $is_line_disabled->{$line}->{$policy_name};
-                    next VIOLATION if $is_line_disabled->{$line}->{ALL};
+                    next VIOLATION if $is_line_disabled->{$line}->{$policy_name}
+                        && $policy->can_be_disabled();
+                    next VIOLATION if $is_line_disabled->{$line}->{ALL}
+                        && $policy->can_be_disabled();
                 }
 
                 push @violations, $violation;
                 }
 
                 push @violations, $violation;
index 36f9f31..c604f7a 100644 (file)
@@ -128,6 +128,12 @@ sub prepare_to_scan_document {
 
 #-----------------------------------------------------------------------------
 
 
 #-----------------------------------------------------------------------------
 
+sub can_be_disabled {
+    return $TRUE;
+}
+
+#-----------------------------------------------------------------------------
+
 sub _validate_config_keys {
     my ( $self, $errors, $config ) = @_;
 
 sub _validate_config_keys {
     my ( $self, $errors, $config ) = @_;
 
@@ -428,7 +434,6 @@ sub new_parameter_value_exception {
     );
 }
 
     );
 }
 
-
 #-----------------------------------------------------------------------------
 
 ## no critic (Subroutines::RequireFinalReturn)
 #-----------------------------------------------------------------------------
 
 ## no critic (Subroutines::RequireFinalReturn)
@@ -732,6 +737,14 @@ overwritten.  Duplicate themes will be removed.
 Appends additional themes to this Policy.  Any existing themes are
 preserved.  Duplicate themes will be removed.
 
 Appends additional themes to this Policy.  Any existing themes are
 preserved.  Duplicate themes will be removed.
 
+=item C< can_be_disabled() >
+
+Returns a true value if this Policy can be disabled by a C<"## no critic">
+marker.  The default method returns true.  Most Policies should never need
+to override this.  But If you want to write a policy that cannot be disabled, 
+override this method to return false.  Note that this only affects the 
+C<"## no critic"> markers -- the Policy can still be disabled via the 
+F<.perlcriticrc> file.
 
 =item C< get_abstract() >
 
 
 =item C< get_abstract() >
 
diff --git a/lib/Perl/Critic/Policy/Miscellanea/ProhibitUnrestrictedNoCritic.pm b/lib/Perl/Critic/Policy/Miscellanea/ProhibitUnrestrictedNoCritic.pm
new file mode 100644 (file)
index 0000000..3ba6b6d
--- /dev/null
@@ -0,0 +1,107 @@
+##############################################################################
+#      $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/lib/Perl/Critic/Policy/Miscellanea/ProhibitFormats.pm $
+#     $Date: 2008-09-07 03:33:32 -0700 (Sun, 07 Sep 2008) $
+#   $Author: clonezone $
+# $Revision: 2730 $
+##############################################################################
+
+package Perl::Critic::Policy::Miscellanea::ProhibitUnrestrictedNoCritic;
+
+use 5.006001;
+use strict;
+use warnings;
+use Readonly;
+
+use Perl::Critic::Utils qw<:severities :booleans>;
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '1.093_01';
+
+#-----------------------------------------------------------------------------
+
+Readonly::Scalar my $DESC => q{Unrestriced '## no critic' pseudo-pragma};
+Readonly::Scalar my $EXPL => q{Only disable the Policies you really need to disable};
+
+#-----------------------------------------------------------------------------
+
+sub supported_parameters { return ()                         }
+sub default_severity     { return $SEVERITY_MEDIUM           }
+sub default_themes       { return qw( core maintenance )     }
+sub applies_to           { return 'PPI::Token::Comment'      }
+sub can_be_disabled      { return $FALSE                     }
+
+#-----------------------------------------------------------------------------
+
+sub violates {
+    my ( $self, $elem, undef ) = @_;
+    return if $elem !~ m{\A \#\# \s+ no \s+ critic \b}smx;
+    
+    if ($elem !~ m{\A \#\# \s+ no \s+ critic \s* (?: qw)? \( .+ \)}smx ) {
+        return $self->violation( $DESC, $EXPL, $elem );
+    }   
+    
+    return; # ok!
+}
+
+
+1;
+
+__END__
+
+#-----------------------------------------------------------------------------
+
+=pod
+
+=head1 NAME
+
+Perl::Critic::Policy::Miscellanea::ProhibitUnrestrictedNoCritic - Forbid a bare C<## no critic>
+
+
+=head1 AFFILIATION
+
+This Policy is part of the core L<Perl::Critic|Perl::Critic>
+distribution.
+
+
+=head1 DESCRIPTION
+
+A bare C<## no critic> marker will disable B<all> the active Policies.
+This creates holes for other, unintended violations to appear in your code.  It is
+better to disable B<only> the particular Policies that you need to get around.
+By putting Policy names in parenthsis after the C<## no critic> marker, then
+it will only disable the named Policies.  Policy names are matched as regular
+expressions, so you can use shortened Policy names, or patterns that match
+several Policies. This Policy generates a violation any time that an 
+unrestricted C<## no critic> marker appears.
+
+  ## no critic                    # not ok
+  ## no critic ()                 # not ok
+  ## no critic (SomePolicyNames)  # ok
+
+=head1 CONFIGURATION
+
+This Policy is not configurable except for the standard options.
+
+
+=head1 AUTHOR
+
+Jeffrey Ryan Thalhammer <thaljef@cpan.org>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2005-2008 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
+
+# Local Variables:
+#   mode: cperl
+#   cperl-indent-level: 4
+#   fill-column: 78
+#   indent-tabs-mode: nil
+#   c-indentation-style: bsd
+# End:
+# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
index 4336166..81f24e2 100644 (file)
@@ -31,6 +31,7 @@ my $profile = {
     '-CodeLayout::RequireTidyCode'                               => {},
     '-Documentation::PodSpelling'                                => {},
     '-ErrorHandling::RequireCheckingReturnValueOfEval'           => {},
     '-CodeLayout::RequireTidyCode'                               => {},
     '-Documentation::PodSpelling'                                => {},
     '-ErrorHandling::RequireCheckingReturnValueOfEval'           => {},
+    '-Miscellanea::ProhibitUnrestrictedNoCritic'                 => {},
     '-Miscellanea::RequireRcsKeywords'                           => {},
     '-ValuesAndExpressions::ProhibitMagicNumbers'                => {},
 };
     '-Miscellanea::RequireRcsKeywords'                           => {},
     '-ValuesAndExpressions::ProhibitMagicNumbers'                => {},
 };
diff --git a/t/Miscellanea/ProhibitUnrestrictedNoCritic.run b/t/Miscellanea/ProhibitUnrestrictedNoCritic.run
new file mode 100644 (file)
index 0000000..215f650
--- /dev/null
@@ -0,0 +1,34 @@
+##----------------------------------------------------------------------------
+## name standard failures
+## failures 6
+## cut
+
+## no critic
+## no critic;
+## no critic #blah,blah
+
+$foo = $bar; ## no critic ();
+$foo = $bar; ## no critic qw();
+
+sub frobulate { ## no critic
+    return $frob;
+}
+
+##----------------------------------------------------------------------------
+## name standard passes
+## failures 0
+## cut
+
+## no critic (shizzle)
+## no critic qw(shizzle) #blah,blah
+
+$foo = $bar; ## no critic (shizzle);
+$foo = $bar; ## no critic qw(shizzle);
+
+sub frobulate { ## no critic (shizzle)
+    return $frob;
+
+
+sub fornicate { ## no critic qw(shizzle)
+    return $forn;
+}
\ No newline at end of file