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.
 
+    New Policies:
+    * Miscellanea::ProhibitUnrestrictedNoCritic
+    
 [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).
 
-=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.
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}) {
-                    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;
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 ) = @_;
 
@@ -428,7 +434,6 @@ sub new_parameter_value_exception {
     );
 }
 
-
 #-----------------------------------------------------------------------------
 
 ## 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.
 
+=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() >
 
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'           => {},
+    '-Miscellanea::ProhibitUnrestrictedNoCritic'                 => {},
     '-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