From 05e2d404fa2d5067c98d27b74731a0fda15d6534 Mon Sep 17 00:00:00 2001 From: Jeffrey Ryan Thalhammer Date: Sun, 28 Sep 2008 02:32:42 +0000 Subject: [PATCH] Created a new Policy to prohibit an unrestricted ## no critic. 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 | 3 + TODO.pod | 11 --- lib/Perl/Critic.pm | 6 +- lib/Perl/Critic/Policy.pm | 15 ++- .../Miscellanea/ProhibitUnrestrictedNoCritic.pm | 107 +++++++++++++++++++++ t/03_pragmas.t | 1 + t/Miscellanea/ProhibitUnrestrictedNoCritic.run | 34 +++++++ 7 files changed, 163 insertions(+), 14 deletions(-) create mode 100644 lib/Perl/Critic/Policy/Miscellanea/ProhibitUnrestrictedNoCritic.pm create mode 100644 t/Miscellanea/ProhibitUnrestrictedNoCritic.run diff --git a/Changes b/Changes index 8200031..9aaab2e 100644 --- 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: diff --git a/TODO.pod b/TODO.pod index a906572..7f7b00e 100644 --- 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. - -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. diff --git a/lib/Perl/Critic.pm b/lib/Perl/Critic.pm index 6593e85..02fb5fd 100644 --- a/lib/Perl/Critic.pm +++ b/lib/Perl/Critic.pm @@ -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; diff --git a/lib/Perl/Critic/Policy.pm b/lib/Perl/Critic/Policy.pm index 36f9f31..c604f7a 100644 --- a/lib/Perl/Critic/Policy.pm +++ b/lib/Perl/Critic/Policy.pm @@ -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 index 0000000..3ba6b6d --- /dev/null +++ b/lib/Perl/Critic/Policy/Miscellanea/ProhibitUnrestrictedNoCritic.pm @@ -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 +distribution. + + +=head1 DESCRIPTION + +A bare C<## no critic> marker will disable B the active Policies. +This creates holes for other, unintended violations to appear in your code. It is +better to disable B 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 + +=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 : diff --git a/t/03_pragmas.t b/t/03_pragmas.t index 4336166..81f24e2 100644 --- a/t/03_pragmas.t +++ b/t/03_pragmas.t @@ -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 index 0000000..215f650 --- /dev/null +++ b/t/Miscellanea/ProhibitUnrestrictedNoCritic.run @@ -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 -- 1.9.1