Login
Committing the rest of my work on refactoring the handling of the
authorJeffrey Ryan Thalhammer <jeff@imaginative-software.com>
Mon, 10 Nov 2008 04:43:41 +0000 (04:43 +0000)
committerJeffrey Ryan Thalhammer <jeff@imaginative-software.com>
Mon, 10 Nov 2008 04:43:41 +0000 (04:43 +0000)
"## no critic" annotations.  This completes the integration with the
new Annotation class.

I also created a new ProhibitUselessNoCritic policy, which uses the
new capabilities of P::C::Document and P::C::Annotation to effectively
replace the --warn-about-useless-no-critc option.  Thanks Elliot for i
suggesting that we implement this as a Policy instead of an option.

Next, I want to change all the code and documentation to recharacterize
the "## no critic" thingies as "annotations".  Also need to write some
unit tests for P::C::Annotation and P::C::Document.  I've had success
using Test::Class at work lately, so I'm thinking of using it here.

19 files changed:
Changes
bin/perlcritic
examples/loadanalysisdb
inc/Perl/Critic/BuildUtilities.pm
lib/Perl/Critic.pm
lib/Perl/Critic/Annotation.pm
lib/Perl/Critic/Config.pm
lib/Perl/Critic/Document.pm
lib/Perl/Critic/OptionsProcessor.pm
lib/Perl/Critic/Policy/InputOutput/RequireBriefOpen.pm
lib/Perl/Critic/Policy/Miscellanea/ProhibitUnrestrictedNoCritic.pm
lib/Perl/Critic/Policy/Miscellanea/ProhibitUselessNoCritic.pm [new file with mode: 0644]
lib/Perl/Critic/Utils.pm
lib/Perl/Critic/Utils/McCabe.pm
t/03_pragmas.t
t/03_useless_pragmas.t [deleted file]
t/05_utils.t
t/07_perlcritic.t
t/Miscellanea/ProhibitUnrestrictedNoCritic.run

diff --git a/Changes b/Changes
index f7ec19b..f6a9e8b 100644 (file)
--- a/Changes
+++ b/Changes
@@ -7,14 +7,25 @@
     * The deprecated $FORMAT variables for Perl::Critic::Policy and
       Perl::Critic::Violation no longer exist.  Use the corresponding
       get_format() and set_format() functions instead.
-
-    New User Features:
-    * Now you can use the --warn-about-useless-no-critic option and
-      Perl::Critic will tell you all the places that you used a
-      "## no critic" marker, but it didn't actually have any effect
-      (given your current profile).  This helps prevent your code
-      from becoming littered with too many "## no critic" annotations.
-
+    * Also, the way that "## no critic" markers was refactored.  As
+      a result, we discovered that the syntax for the markers was
+      pretty vague.  If you didn't do it just right, it would
+      disable all policies, and not just the specific ones that
+      you wanted.  So we've tightened this up a bit.  If you
+      followed the examples that have been in the docs for the
+      last couple years, then you should be fine.  But if you've
+      been using certain other variations in your "## no critic"
+      markers, then you might suddenly find yourself violating
+      the new ProhibtUnrestrictedNoCritic policy.  To fix this,
+      just make sure your Policy names appear in parentheses:
+
+        ## no critic Foo, Bar, Baz     # wrong!
+        ## no critic Foo Bar Baz       # wrong!
+        
+              
+        ## no critic (Foo, Bar, Baz)   # ok!
+        ## no critic qw(Foo Bar Baz)   # also ok!
     New Developer Features:
     * Perl::Critic::Policy::is_document_exempt() has been renamed to
       prepare_to_scan_document() and the sense of the return value has been
@@ -33,6 +44,7 @@
 
     New Policies:
     * Miscellanea::ProhibitUnrestrictedNoCritic
+    * Miscellanea::ProhibitUselessNoCritic
     * Variables::ProhibitReusedNames
 
 [1.093_01] Released on 2008-09-07
index c76bfac..72cf1c6 100755 (executable)
@@ -453,7 +453,6 @@ sub _get_option_specification {
         theme=s
         top:i
         verbose=s
-        warn-about-useless-no-critic!
     );
 }
 
index 8487fbb..794f07b 100755 (executable)
@@ -7,7 +7,7 @@
 # $Revision$
 ##############################################################################
 
-## no critic (ErrorHandling::RequireUseOfExceptions)
+
 use 5.008001;
 use strict;
 use warnings;
index 9793a30..5e2b838 100644 (file)
@@ -54,7 +54,6 @@ sub test_wrappers_to_generate {
         t/01_policy_config.t
         t/02_policy.t
         t/03_pragmas.t
-        t/03_useless_pragmas.t
         t/04_optionsprocessor.t
         t/05_utils.t
         t/05_utils_ppi.t
index 27608c3..93802f5 100644 (file)
@@ -18,12 +18,9 @@ use base qw(Exporter);
 
 use File::Spec;
 use Scalar::Util qw(blessed);
-
-use PPI::Document;
-use PPI::Document::File;
+use List::MoreUtils qw(firstidx);
 
 use Perl::Critic::Exception::Configuration::Generic;
-use Perl::Critic::Exception::Parse qw{ throw_parse };
 use Perl::Critic::Config;
 use Perl::Critic::Violation;
 use Perl::Critic::Document;
@@ -36,7 +33,8 @@ our $VERSION = '1.093_02';
 
 Readonly::Array our @EXPORT_OK => qw(critique);
 
-#-----------------------------------------------------------------------------
+#=============================================================================
+# PUBLIC methods
 
 sub new {
     my ( $class, %args ) = @_;
@@ -102,7 +100,8 @@ sub critique {  ## no critic (ArgUnpacking)
     $self = ref $self eq 'HASH' ? __PACKAGE__->new(%{ $self }) : $self;
     return if not defined $source_code;  # If no code, then nothing to do.
 
-    my $doc = $self->_create_perl_critic_document($source_code);
+    my $doc = blessed($source_code) && $source_code->isa('Perl::Critic::Document') ?
+        $source_code : Perl::Critic::Document->new($source_code);
 
     if ( 0 == $self->policies() ) {
         Perl::Critic::Exception::Configuration::Generic->throw(
@@ -114,58 +113,24 @@ sub critique {  ## no critic (ArgUnpacking)
 }
 
 #=============================================================================
-# PRIVATE functions
-
-sub _create_perl_critic_document {
-    my ($self, $source_code) = @_;
-
-    # $source_code can be a file name, or a reference to a
-    # PPI::Document, or a reference to a scalar containing source
-    # code.  In the last case, PPI handles the translation for us.
-
-    my $doc = _is_ppi_doc( $source_code ) ? $source_code
-              : ref $source_code ? PPI::Document->new($source_code)
-              : PPI::Document::File->new($source_code);
-
-    # Bail on error
-    if ( not defined $doc ) {
-        my $errstr   = PPI::Document::errstr();
-        my $file     = ref $source_code ? undef : $source_code;
-        throw_parse
-            message     => qq<Can't parse code: $errstr>,
-            file_name   => $file;
-    }
-
-    # Pre-index location of each node (for speed)
-    $doc->index_locations();
-
-    # Wrap the doc in a caching layer
-    return Perl::Critic::Document->new($doc);
-}
-
-#-----------------------------------------------------------------------------
+# PRIVATE methods
 
 sub _gather_violations {
     my ($self, $doc) = @_;
 
     # Disable exempt code lines, if desired
     if ( not $self->config->force() ) {
-        my @site_policies = $self->config->site_policy_names();
-        $doc->mark_disabled_regions(@site_policies);
+        $doc->process_annotations();
     }
 
     # Evaluate each policy
     my @policies = $self->config->policies();
-    my @violations = map { _critique($_, $doc) } @policies;
+    my @ordered_policies = _futz_with_policy_order(@policies);
+    my @violations = map { _critique($_, $doc) } @ordered_policies;
 
     # Accumulate statistics
     $self->statistics->accumulate( $doc, \@violations );
 
-    # Warn about useless "no critic" markers
-    if ($self->config->warn_about_useless_no_critic() ) {
-        for ($doc->useless_no_critic_warnings()) {warn "$_\n"};
-    }
-
     # If requested, rank violations by their severity and return the top N.
     if ( @violations && (my $top = $self->config->top()) ) {
         my $limit = @violations < $top ? $#violations : $top-1;
@@ -177,14 +142,8 @@ sub _gather_violations {
     return Perl::Critic::Violation->sort_by_location(@violations);
 }
 
-#-----------------------------------------------------------------------------
-
-sub _is_ppi_doc {
-    my ($ref) = @_;
-    return blessed($ref) && $ref->isa('PPI::Document');
-}
-
-#-----------------------------------------------------------------------------
+#=============================================================================
+# PRIVATE functions
 
 sub _critique {
     my ($policy, $doc) = @_;
@@ -195,7 +154,6 @@ sub _critique {
     return if defined $maximum_violations && $maximum_violations == 0;
 
     my @violations = ();
-    my $policy_name = $policy->get_long_name();
 
   TYPE:
     for my $type ( $policy->applies_to() ) {
@@ -212,10 +170,10 @@ sub _critique {
             for my $violation ( $policy->violates( $element, $doc ) ) {
 
                 my $line = $violation->location()->[0];
-                if ( $doc->line_is_disabled($line, $policy_name) ) {
-                     $doc->mark_supressed_violation($line, $policy_name);
-                     next VIOLATION;
-                 }
+                if ( $doc->line_is_disabled_for_policy($line, $policy) ) {
+                    $doc->add_suppressed_violation($violation);
+                    next VIOLATION;
+                }
 
                 push @violations, $violation;
                 last TYPE if defined $maximum_violations and @violations >= $maximum_violations;
@@ -228,6 +186,22 @@ sub _critique {
 
 #-----------------------------------------------------------------------------
 
+sub _futz_with_policy_order {
+
+    # The ProhibitUselessNoCritic policy is another special policy.  It
+    # deals with the violations that *other* Policies produce.  Therefore
+    # it needs to be run *after* all the other Policies.  TODO: find
+    # a way for Policies to express an ordering preference somehow.
+
+    my @policy_objects = @_;
+    my $magical_policy_name = 'Perl::Critic::Policy::Miscellanea::ProhibitUselessNoCritic';
+    my $idx = firstidx {ref $_ eq $magical_policy_name} @policy_objects;
+    push @policy_objects, splice @policy_objects, $idx, 1;
+    return @policy_objects;
+}
+
+#-----------------------------------------------------------------------------
+
 1;
 
 
@@ -236,8 +210,7 @@ __END__
 
 =pod
 
-=for stopwords DGR INI-style API -params pbp refactored ActivePerl
-ben Jore Dolan's
+=for stopwords DGR INI-style API -params pbp refactored ActivePerl ben Jore Dolan's
 
 =head1 NAME
 
index 2cce53d..7fbc0e1 100644 (file)
@@ -21,47 +21,75 @@ use Perl::Critic::Utils qw(:characters hashify);
 
 our $VERSION = '1.093_02';
 
+#=============================================================================
+# CLASS methods
+
+sub create_annotations {
+    my ($class, $doc) = @_;
+    
+    my @annotations = ();
+    my $comment_elements_ref  = $doc->find('PPI::Token::Comment') || return;
+    my $annotation_rx  = qr{\A (?: [#]! .*? )? \s* [#][#] \s* no  \s+ critic}xms;
+    for my $annotation_element ( grep { $_ =~ $annotation_rx } @{$comment_elements_ref} ) {
+        push @annotations, Perl::Critic::Annotation->new( -element => $annotation_element);
+    }
+    
+    return @annotations;
+}
+
 #-----------------------------------------------------------------------------
 
 sub new {
-    my ($class, %args) = @_;
+    my ($class, @args) = @_;
     my $self = bless {}, $class;
-    return $self->_init(%args);
+    $self->_init(@args);
+    return $self;
 }
 
-#-----------------------------------------------------------------------------
+#=============================================================================
+# OBJECT methods
 
 sub _init {
     my ($self, %args) = @_;
-    my $annotation_token = $args{-token} || confess '-token argument is required';
-    $self->{_token} = $annotation_token;
+    my $annotation_element = $args{-element} || confess '-element argument is required';
+    $self->{_element} = $annotation_element;
 
-    my %disabled_policies = _parse_annotation( $annotation_token );
+    my %disabled_policies = _parse_annotation( $annotation_element );
     $self->{_disables_all_policies} = %disabled_policies ? 0 : 1;
     $self->{_disabled_policies} = \%disabled_policies;
 
     # Grab surrounding nodes to determine the context.
     # This determines whether the pragma applies to
     # the current line or the block that follows.
-    my $annotation_token_line = $annotation_token->location()->[0];
-    my $parent = $annotation_token->parent();
+    my $annotation_line = $annotation_element->location()->[0];
+    my $parent = $annotation_element->parent();
     my $grandparent = $parent ? $parent->parent() : undef;
-    my $sib = $annotation_token->sprevious_sibling();
+    my $sib = $annotation_element->sprevious_sibling();
 
+    # Handle case when it appears on the shebang line.  In this
+    # situation, it only affects the first line, not the whole doc
+    if ( $annotation_element =~ m{\A [#]!}xms) {
+        $self->{_effective_range} = [$annotation_line, $annotation_line];
+        return $self;
+    }
 
-    # Handle single-line usage on simple statements
-    if ( $sib && $sib->location->[0] == $annotation_token_line ) {
-        $self->{_effective_range} = [$annotation_token_line];
+    # Handle single-line usage on simple statements.  In this
+    # situation, it only affects the line that it appears on.
+    # TODO: Make this work for simple statements that are broken
+    # onto multiple lines.
+    if ( $sib && $sib->location->[0] == $annotation_line ) {
+        $self->{_effective_range} = [$annotation_line, $annotation_line];
         return $self;
     }
 
-    # Handle single-line usage on compound statements
+    # Handle single-line usage on compound statements.  In this
+    # situation -- um -- I'm not sure how this works, but it does.
     if ( ref $parent eq 'PPI::Structure::Block' ) {
         if ( ref $grandparent eq 'PPI::Statement::Compound'
             || ref $grandparent eq 'PPI::Statement::Sub' ) {
-            if ( $parent->location->[0] == $annotation_token_line ) {
-                my $line = $grandparent->location->[0];
-                $self->{_effective_range} = [$line];
+            if ( $parent->location->[0] == $annotation_line ) {
+                my $grandparent_line = $grandparent->location->[0];
+                $self->{_effective_range} = [$grandparent_line, $grandparent_line];
                 return $self;
             }
         }
@@ -69,11 +97,10 @@ sub _init {
 
 
     # Handle multi-line usage.  This is either a "no critic" ..
-    # "use critic" region or a block where "no critic" persists
+    # "use critic" region or a block where "no critic" is in effect
     # until the end of the scope.  The start is the always the "no
     # critic" which we already found.  So now we have to search for the end.
-
-    my $start = my $end = $annotation_token;
+    my $end = $annotation_element;
     my $use_critic = qr{\A \s* [#][#] \s* use \s+ critic}xms;
 
   SIB:
@@ -83,16 +110,16 @@ sub _init {
     }
 
     # We either found an end or hit the end of the scope.
-    my ($starting_line, $ending_line) = ($start->location->[0], $end->location->[0]);
-    $self->{_effective_range} = [$starting_line, $ending_line];
+    my $ending_line = $end->location->[0];
+    $self->{_effective_range} = [$annotation_line, $ending_line];
     return $self;
 }
 
 #-----------------------------------------------------------------------------
 
-sub token {
+sub element {
     my ($self) = @_;
-    return $self->{_token};
+    return $self->{_element};
 }
 
 #-----------------------------------------------------------------------------
@@ -138,31 +165,29 @@ sub disables_line {
 
 sub _parse_annotation {
 
-    my ($annotation_token) = @_;
+    my ($annotation_element) = @_;
 
     #############################################################################
     # This regex captures the list of Policy name patterns that are to be
-    # disabled.  It is generally assumed that the token has already been
+    # disabled.  It is generally assumed that the element has already been
     # verified as a no-critic annotation.  So if this regex does not match,
     # then it implies that all Policies are to be disabled.
     #
     my $no_critic = qr{\#\# \s* no \s+ critic \s* (?:qw)? [("'] ([\s\w:,]+) }xms;
-    #                  ---  --------------------- ------- ----- -----------
-    #                   |             |              |      |        |
-    #     Starts with "##"            |              |      |        |
+    #                  -------------------------- ------- ----- -----------
     #                                 |              |      |        |
-    #   "no critic" with optional spaces             |      |        |
+    #   "## no critic" with optional spaces          |      |        |
     #                                                |      |        |
     #             Policy list may be prefixed with "qw"     |        |
     #                                                       |        |
-    #                  Policy list is begins with one of these       |
+    #         Optional Policy list must begin with one of these      |
     #                                                                |
-    #           Capture entire Policy list string (with delimiters) here
+    #                 Capture entire Policy list (with delimiters) here
     #
     #############################################################################
 
     my @disabled_policy_names = ();
-    if ( my ($patterns_string) = $annotation_token =~ $no_critic ) {
+    if ( my ($patterns_string) = $annotation_element =~ $no_critic ) {
 
         # Compose the specified modules into a regex alternation.  Wrap each
         # in a no-capturing group to permit "|" in the modules specification.
@@ -199,43 +224,52 @@ __END__
 
 Perl::Critic::Annotation - Represents a "## no critic" marker
 
-
 =head1 SYNOPSIS
 
   use Perl::Critic::Annotation;
-  $annotation = Perl::Critic::Annotation->new( -token => $no_critic_ppi_token );
-
+  $annotation = Perl::Critic::Annotation->new( -element => $no_critic_ppi_element );
+  
   $bool = $annotation->disables_line( $number );
   $bool = $annotation->disables_policy( $policy_object );
   $bool = $annotation->disables_all_policies();
-
+  
   ($start, $end) = $annotation->effective_range();
   @disabled_policy_names = $annotation->disabled_policies();
-
-
+  
 =head1 DESCRIPTION
 
 L<Perl::Critic::Annotation> represents a single C<"## no critic"> marker in a
-L<PPI:Document>.  The Annotation takes care of parsing the markers and
+L<PPI:Document>.  The Annotation takes care of parsing the markers and 
 keeps track of which lines and Policies it affects. It is intended to
-encapsulate the details of the no-critic markers, and to provide a way for
+encapsulate the details of the no-critic markers, and to provide a way for 
 Policy objects to interact with the markers (via a L<Perl::Critic::Document>).
 
+=head1 CLASS METHODS
+
+=over
+
+=item create_annotations( -doc => $doc )
+
+Given a L<Perl::Critic::Document>, finds all the C<"## no critic"> annotations
+and constructs a new L<Perl::Critic::Annotation> for each one and returns
+them.  The order of the returned objects is not defined.  It is generally
+expected that clients will use this interface rather than calling the
+L<Perl::Critic::Annotation> constructor directly.
+
+=back
 
 =head1 CONSTRUCTOR
 
 =over
 
-=item C<< new( -token => $ppi_annotation_token ) >>
+=item C<< new( -element => $ppi_annotation_element ) >>
 
-Returns a reference to a new Annotation object.  The B<-token> argument
-is required and should be a C<PPI::Token::Comment> that conforms to the
+Returns a reference to a new Annotation object.  The B<-element> argument
+is required and should be a C<PPI::Token::Comment> that conforms to the 
 C<"## no critic"> syntax.
 
-
 =back
 
-
 =head1 METHODS
 
 =over
@@ -244,7 +278,6 @@ C<"## no critic"> syntax.
 
 Returns true if this Annotation disables C<$line> for any (or all) Policies.
 
-
 =item C<< disables_policy( $policy_object ) >>
 
 =item C<< disables_policy( $policy_name ) >>
@@ -252,39 +285,33 @@ Returns true if this Annotation disables C<$line> for any (or all) Policies.
 Returns true if this Annotation disables C<$polciy_object> or C<$policy_name>
 at any (or all) lines.
 
-
 =item C<< disables_all_policies() >>
 
 Returns true if this Annotation disables all Policies at any (or all) lines.
 If this method returns true, C<disabled_policies> will return an empty list.
 
-
 =item C<< effective_range() >>
 
 Returns a two-element list, representing the first and last line numbers where
 this Annotation has effect.
 
-
 =item C<< disabled_policies() >>
 
 Returns a list of the names of the Policies that are affected by this Annotation.
 If this list is empty, then it means that all Policies are affected by this
 Annotation, and C<disables_all_policies()> should return true.
 
+=item C<< element() >>
 
-=item C<< token() >>
-
-Returns the L<PPI::Token::Comment> where this annotation started.
-
+Returns the L<PPI::Element> where this annotation started.  This is typically
+an instance of L<PPI::Token::Comment>.
 
 =back
 
-
 =head1 AUTHOR
 
 Jeffrey Ryan Thalhammer <thaljef@cpan.org>
 
-
 =head1 COPYRIGHT
 
 Copyright (c) 2005-2008 Jeffrey Ryan Thalhammer.  All rights reserved.
index 63be22b..38630dd 100644 (file)
@@ -62,9 +62,8 @@ sub _init {
     my $errors = Perl::Critic::Exception::AggregateConfiguration->new();
 
     # Construct the UserProfile to get default options.
-    my $profile_source  = $args{-profile}; #Can be file path or data struct
-    my $profile =
-        Perl::Critic::UserProfile->new( -profile => $profile_source );
+    my $profile_source = $args{-profile}; # Can be file path or data struct
+    my $profile = Perl::Critic::UserProfile->new( -profile => $profile_source );
     my $options_processor = $profile->options_processor();
     $self->{_profile} = $profile;
 
@@ -90,25 +89,16 @@ sub _init {
     $self->_validate_and_save_verbosity($args{-verbose}, $errors);
     $self->_validate_and_save_severity($args{-severity}, $errors);
     $self->_validate_and_save_top($args{-top}, $errors);
+    $self->_validate_and_save_theme($args{-theme}, $errors);
+    $self->_validate_and_save_pager($args{-pager}, $errors);
 
     # If given, these options can be true or false (but defined)
     # We normalize these to numeric values by multiplying them by 1;
-    {
-        $self->{_force} = boolean_to_number( dor( $args{-force}, $options_processor->force() ) );
-        $self->{_only}  = boolean_to_number( dor( $args{-only},  $options_processor->only()  ) );
-        $self->{_color} = boolean_to_number( dor( $args{-color}, $options_processor->color() ) );
-        $self->{_criticism_fatal} =
-            boolean_to_number(
-                dor( $args{'-criticism-fatal'}, $options_processor->criticism_fatal() )
-            );
-
-        $self->{_warn_about_useless_no_critic} =
-            boolean_to_number(dor( $args{'-warn-about-useless-no-critic'},
-                 $options_processor->warn_about_useless_no_critic() ) );
-    }
+    $self->{_force} = boolean_to_number( dor( $args{-force}, $options_processor->force() ) );
+    $self->{_only}  = boolean_to_number( dor( $args{-only},  $options_processor->only()  ) );
+    $self->{_color} = boolean_to_number( dor( $args{-color}, $options_processor->color() ) );
+    $self->{_criticism_fatal} = boolean_to_number( dor( $args{'-criticism-fatal'}, $options_processor->criticism_fatal() ) );
 
-    $self->_validate_and_save_theme($args{-theme}, $errors);
-    $self->_validate_and_save_pager($args{-pager}, $errors);
 
     # Construct a Factory with the Profile
     my $factory =
@@ -780,13 +770,6 @@ sub criticism_fatal {
 
 #-----------------------------------------------------------------------------
 
-sub warn_about_useless_no_critic {
-    my ($self) = @_;
-    return $self->{_warn_about_useless_no_critic};
-}
-
-#-----------------------------------------------------------------------------
-
 sub site_policy_names {
     return Perl::Critic::PolicyFactory::site_policy_names();
 }
@@ -1019,11 +1002,6 @@ Returns the value of the C<-pager> attribute for this Config.
 Returns the value of the C<-criticsm-fatal> attribute for this Config.
 
 
-=item C< warn_about_useless_no_critic() >
-
-Returns the value of the C<-warn-about-useless-no-critic> attribute for this Config.
-
-
 =back
 
 
index ebed60d..4d48382 100644 (file)
@@ -11,13 +11,18 @@ use 5.006001;
 use strict;
 use warnings;
 
-use List::Util qw< max >;
-use List::MoreUtils qw< none >;
+use Carp qw< confess >;
 
 use PPI::Document;
-use Scalar::Util qw< weaken >;
+use PPI::Document::File;
+
+use List::Util qw< max >;
+use Scalar::Util qw< blessed weaken >;
 use version;
 
+use Perl::Critic::Annotation;
+use Perl::Critic::Exception::Parse qw{ throw_parse };
+
 #-----------------------------------------------------------------------------
 
 our $VERSION = '1.093_02';
@@ -35,17 +40,53 @@ sub AUTOLOAD {  ## no critic (ProhibitAutoloading,ArgUnpacking)
 #-----------------------------------------------------------------------------
 
 sub new {
-    my ($class, $doc) = @_;
+    my ($class, @args) = @_;
     my $self = bless {}, $class;
-    $self->{_supressed_violations} = {};
-    $self->{_disabled_regions} = {};
+    return $self->_init(@args);
+}
+
+#-----------------------------------------------------------------------------
+
+sub _init {
+
+    my ($self, $source_code) = @_;
+
+    # $source_code can be a file name, or a reference to a
+    # PPI::Document, or a reference to a scalar containing source
+    # code.  In the last case, PPI handles the translation for us.
+
+    my $doc = _is_ppi_doc( $source_code ) ? $source_code
+              : ref $source_code ? PPI::Document->new($source_code)
+              : PPI::Document::File->new($source_code);
+
+    # Bail on error
+    if ( not defined $doc ) {
+        my $errstr   = PPI::Document::errstr();
+        my $file     = ref $source_code ? undef : $source_code;
+        throw_parse
+            message     => qq<Can't parse code: $errstr>,
+            file_name   => $file;
+    }
+
     $self->{_doc} = $doc;
-    $self->_unfix_shebang();
+    $self->{_annotations} = [];
+    $self->{_suppressed_violations} = [];
+    $self->{_disabled_line_map} = {};
+    $self->index_locations();
+    $self->_disable_shebang_fix();
+
     return $self;
 }
 
 #-----------------------------------------------------------------------------
 
+sub _is_ppi_doc {
+    my ($ref) = @_;
+    return blessed($ref) && $ref->isa('PPI::Document');
+}
+
+#-----------------------------------------------------------------------------
+
 sub ppi_document {
     my ($self) = @_;
     return $self->{_doc};
@@ -164,69 +205,81 @@ sub highest_explicit_perl_version {
 
 #-----------------------------------------------------------------------------
 
-sub mark_disabled_regions {
-    my ($self, @site_policies) = @_;
+sub process_annotations {
+    my ($self) = @_;
 
-    my $nodes_ref  = $self->find('PPI::Token::Comment') || return;
-    $self->_disable_shebang_region($nodes_ref, \@site_policies);
-    $self->_disable_other_regions($nodes_ref, \@site_policies);
+    my @annotations = Perl::Critic::Annotation->create_annotations($self);
+    $self->add_annotation(@annotations);
     return $self;
 }
 
 #-----------------------------------------------------------------------------
 
-sub line_is_disabled {
-    my ($self, $line, $policy_name) = @_;
+sub line_is_disabled_for_policy {
+    my ($self, $line, $policy) = @_;
+    my $policy_name = ref $policy || $policy;
 
     # HACK: This Policy is special.  If it is active, it cannot be
     # disabled by a "## no critic" marker.  Rather than create a general
     # hook in Policy.pm for enabling this behavior, we chose to hack
-    # it here, since this isn't the kind of thing that most policies
-    # should be doning.
+    # it here, since this isn't the kind of thing that most policies do
 
     return 0 if $policy_name eq
         'Perl::Critic::Policy::Miscellanea::ProhibitUnrestrictedNoCritic';
 
-    for my $region ( $self->_disabled_regions($policy_name) ) {
-        return 1 if $line >= $region->[0] and $line <= $region->[-1];
-    }
-
+    return 1 if $self->{_disabled_line_map}->{$line}->{$policy_name};
+    return 1 if $self->{_disabled_line_map}->{$line}->{ALL};
     return 0;
 }
 
 #-----------------------------------------------------------------------------
 
-sub mark_supressed_violation {
-    my ($self, $line, $policy_name) = @_;
-    $self->{_supressed_violations}{$policy_name}{$line} = 1;
+sub add_annotation {
+    my ($self, @annotations) = @_;
+
+    # Add annotation to our private map for quick lookup
+    for my $annotation (@annotations) {
+
+        my ($start, $end) = $annotation->effective_range();
+        my @affected_policies = $annotation->disables_all_policies ?
+            qw(ALL) : $annotation->disabled_policies();
+
+        # TODO: Find clever way to do this with hash slices
+        for my $line ($start .. $end) {
+            for my $policy (@affected_policies) {
+                $self->{_disabled_line_map}->{$line}->{$policy} = 1;
+            }
+        }
+    }
+
+    push @{ $self->{_annotations} }, @annotations;
     return $self;
 }
 
 #-----------------------------------------------------------------------------
 
-sub useless_no_critic_warnings {
+sub annotations {
     my ($self) = @_;
+    return @{ $self->{_annotations} };
+}
 
-    my @warnings = ();
-    my $file = $self->filename() || 'UNKNOWN';
+#-----------------------------------------------------------------------------
 
-    my %disabled_regions = %{ $self->{_disabled_regions} };
-    for my $policy (keys %disabled_regions) {
+sub add_suppressed_violation {
+    my ($self, $violation) = @_;
+    push @{$self->{_suppressed_violations}}, $violation;
+    return $self;
+}
 
-        my @regions = @{ $disabled_regions{$policy} };
+#-----------------------------------------------------------------------------
 
-        for my $region (@regions) {
-            if (none {$self->_violation_was_supressed($_, $policy)} @{$region} ) {
-                my $start = $region->[0];
-                my $which_policy = $policy eq 'ALL' ? 'all Policies' : $policy;
-                push @warnings, qq{Useless disabling of $which_policy in "$file" at line $start.};
-            }
-        }
-    }
-    return @warnings;
+sub suppressed_violations {
+    my ($self) = @_;
+    return @{ $self->{_suppressed_violations} };
 }
 
 #-----------------------------------------------------------------------------
+# PRIVATE functions & methods
 
 sub _is_a_version_statement {
     my (undef, $element) = @_;
@@ -273,172 +326,16 @@ sub _caching_finder {
 
 #-----------------------------------------------------------------------------
 
-sub _disabled_regions {
-    my ($self, $policy_name) = @_;
-    my @disabled_regions = ();
-
-    # Get policy-specific reigions
-    if ( my $region = $self->{_disabled_regions}->{$policy_name} ) {
-        push @disabled_regions, @{$region};
-    }
-
-    # Get regions for all policies
-    if ( my $region = $self->{_disabled_regions}->{ALL} ) {
-        push @disabled_regions, @{$region};
-    }
-
-    return @disabled_regions;
-}
-
-#-----------------------------------------------------------------------------
-
-sub _violation_was_supressed {
-    my ($self, $line, $policy) = @_;
-    return 1 if $self->{_supressed_violations}->{$policy}->{$line};
-    return 0;
-}
-
-#-----------------------------------------------------------------------------
-
-sub _mark_disabled_region {
-    my ($self, $starting_line, $ending_line, @disabled_policies) = @_;
-    return if not @disabled_policies;
-
-    for my $policy (@disabled_policies) {
-        my $region = [$starting_line .. $ending_line];
-        $self->{_disabled_regions}->{$policy} ||= [];
-        push @{ $self->{_disabled_regions}->{$policy} }, $region;
-    }
-
-    return $self;
-}
-
-#-----------------------------------------------------------------------------
-
-sub _disable_shebang_region {
-    my ($self, $nodes_ref, $site_policies) = @_;
-
-    my $first_comment = $nodes_ref->[0] || return;
-    my $shebang_no_critic  = qr{\A [#]! .*? [#][#] \s* no  \s+ critic}xms;
-
-    # Special case for the very beginning of the file: allow "##no critic" after the shebang
-    my $loc = $first_comment->location();
-    if (1 == $loc->[0] && 1 == $loc->[1] && $first_comment =~ $shebang_no_critic) {
-        my @disabled_policies = _parse_nocritic_import($first_comment, $site_policies);
-        $self->_mark_disabled_region(1, 1, @disabled_policies);
-    }
-
-    return $self;
-}
-
-#-----------------------------------------------------------------------------
-
-sub _disable_other_regions {
-    my ($self, $nodes_ref, $site_policies) = @_;
-
-    my $no_critic  = qr{\A \s* [#][#] \s* no  \s+ critic}xms;
-    my $use_critic = qr{\A \s* [#][#] \s* use \s+ critic}xms;
-
-  PRAGMA:
-    for my $pragma ( grep { $_ =~ $no_critic } @{$nodes_ref} ) {
-
-        # Parse out the list of Policy names after the
-        # 'no critic' pragma.  I'm thinking of this just
-        # like a an C<import> argument for real pragmas.
-        my @no_policies = _parse_nocritic_import($pragma, $site_policies);
-
-        # Grab surrounding nodes to determine the context.
-        # This determines whether the pragma applies to
-        # the current line or the block that follows.
-        my $parent = $pragma->parent();
-        my $grandparent = $parent ? $parent->parent() : undef;
-        my $sib = $pragma->sprevious_sibling();
-
-
-        # Handle single-line usage on simple statements
-        if ( $sib && $sib->location->[0] == $pragma->location->[0] ) {
-            my $line = $pragma->location->[0];
-            $self->_mark_disabled_region($line, $line, @no_policies);
-            next PRAGMA;
-        }
-
-
-        # Handle single-line usage on compound statements
-        if ( ref $parent eq 'PPI::Structure::Block' ) {
-            if ( ref $grandparent eq 'PPI::Statement::Compound'
-                 || ref $grandparent eq 'PPI::Statement::Sub' ) {
-                if ( $parent->location->[0] == $pragma->location->[0] ) {
-                    my $line = $grandparent->location->[0];
-                    $self->_mark_disabled_region($line, $line, @no_policies);
-                    next PRAGMA;
-                }
-            }
-        }
-
-
-        # Handle multi-line usage.  This is either a "no critic" ..
-        # "use critic" region or a block where "no critic" persists
-        # until the end of the scope.  The start is the always the "no
-        # critic" which we already found.  So now we have to search
-        # for the end.
-
-        my $start = $pragma;
-        my $end   = $pragma;
-
-      SIB:
-        while ( my $esib = $end->next_sibling() ) {
-            $end = $esib; # keep track of last sibling encountered in this scope
-            last SIB if $esib->isa('PPI::Token::Comment') && $esib =~ $use_critic;
-        }
-
-        # We either found an end or hit the end of the scope.
-        my ($starting_line, $ending_line) = ($start->location->[0], $end->location->[0]);
-        $self->_mark_disabled_region($starting_line, $ending_line, @no_policies);
-    }
-
-    return $self;
-}
-
-#-----------------------------------------------------------------------------
-
-sub _parse_nocritic_import {
-
-    my ($pragma, $site_policies) = @_;
-
-    my $module    = qr{ [\w:]+ }xms;
-    my $delim     = qr{ \s* [,\s] \s* }xms;
-    my $qw        = qr{ (?: qw )? }xms;
-    my $qualifier = qr{ $qw [(]? \s* ( $module (?: $delim $module)* ) \s* [)]? }xms;
-    my $no_critic = qr{ \#\# \s* no \s+ critic \s* $qualifier }xms;
-
-    if ( my ($module_list) = $pragma =~ $no_critic ) {
-        my @modules = split $delim, $module_list;
-
-        # Compose the specified modules into a regex alternation.  Wrap each
-        # in a no-capturing group to permit "|" in the modules specification
-        # (backward compatibility)
-        my $re = join q{|}, map {"(?:$_)"} @modules;
-        return grep {m/$re/ixms} @{$site_policies};
-    }
-
-    # Default to disabling ALL policies.
-    return qw(ALL);
-}
-
-#-----------------------------------------------------------------------------
-
-sub _unfix_shebang {
-
+sub _disable_shebang_fix {
     my ($self) = @_;
 
     # When you install a script using ExtUtils::MakeMaker or Module::Build, it
     # inserts some magical code into the top of the file (just after the
     # shebang).  This code allows people to call your script using a shell,
     # like `sh my_script`.  Unfortunately, this code causes several Policy
-    # violations, so we just disable it as if a "## no critic" comment had
-    # been attached.
+    # violations, so we disable them as if they had "## no critic" markers.
 
-    my $first_stmnt = $self->schild(0) || return $self;
+    my $first_stmnt = $self->schild(0) || return;
 
     # Different versions of MakeMaker and Build use slightly different shebang
     # fixing strings.  This matches most of the ones I've found in my own Perl
@@ -446,11 +343,11 @@ sub _unfix_shebang {
 
     my $fixin_rx = qr<^eval 'exec .* \$0 \${1\+"\$@"}'\s*[\r\n]\s*if.+;>ms; ## no critic (ExtendedFormatting)
     if ( $first_stmnt =~ $fixin_rx ) {
-        my $line = $first_stmnt->location()->[0];
-        $self->_mark_disabled_region($line, $line+1, 'ALL');
+        my $line = $first_stmnt->location->[0];
+        $self->{_disabled_line_map}->{$line}->{ALL} = 1;
+        $self->{_disabled_line_map}->{$line + 1}->{ALL} = 1;
     }
 
-    #No magic shebang was found!
     return $self;
 }
 
@@ -505,23 +402,19 @@ better than we do here?
 
 =over
 
-=item C<< new($doc) >>
-
-Create a new instance referencing a PPI::Document instance.
+=item C<< new($source_code) >>
 
+Create a new instance referencing a PPI::Document instance.  The
+C<$source_code> can be the name of a file, a reference to a scalar
+containing actual source code, or a L<PPI::Document> or 
+L<PPI::Document::File>.
 
 =back
 
-
 =head1 METHODS
 
 =over
 
-=item C<< new($doc) >>
-
-Create a new instance referencing a PPI::Document instance.
-
-
 =item C<< ppi_document() >>
 
 Accessor for the wrapped PPI::Document instance.  Note that altering
@@ -560,49 +453,42 @@ Returns a L<version|version> object for the highest Perl version
 requirement declared in the document via a C<use> or C<require>
 statement.  Returns nothing if there is no version statement.
 
+=item C<< process_annotations() >>
 
-=item C<< mark_disabled_regions( @policy_names ) >>
-
-Scans the document for C<"## no critic"> pseudo-pragmas and builds
-an internal table of which of the listed C<@policy_names> have
-been disabled at each line.  Unless you want to ignore the
-C<"## no critic"> markers, you should call this method before 
-critiquing the document. Returns C<$self>.
+Causes this Document to scan itself and mark which lines &
+policies are disabled by the C<"## no critic"> annotations.
 
+=item C<< line_is_disabled_for_policy($line, $policy_object) >>
 
-=item C<< line_is_disabled($line, $policy_name) >>
+Returns true if the given C<$policy_object> or C<$policy_name> has 
+been disabled for at C<$line> in this Document.  Otherwise, returns false.
 
-Returns true if the given C<$policy_name> has been disabled for
-at C<$line> in this document.  Otherwise, returns false.
+=item C<< add_annotation( $annotation ) >>
 
+Adds an C<$annotation> object to this Document.
 
-=item C<< mark_supressed_violation($line, $policy_name) >>
+=item C<< annotations() >>
 
-Indicates to this Document that a violation of policy C<$policy_name>
-was found at line c<$line>, but was not reported because it
-fell on a line that had been disabled by a C<"## no critic"> marker.
-This is how the Document figures out if there are any useless
-C<"## no critic"> markers in the file. Returns C<$self>.
+Returns a list containing all the L<Perl::Critic::Annotation> that
+were found in this Document.
 
+=item C<< add_suppressed_violation($violation) >>
 
-=item C<< useless_no_critic_warnings(@violations) >>
+Informs this Document that a C<$violation> was found but not reported 
+because it fell on a line that had been suppressed by a C<"## no critic">
+annotation. Returns C<$self>.
 
-Given a list of violation objects that are assumed to have been found
-in this Document, returns a warning message for each line where a 
-policy was disabled using a C<"##no critic"> pseudo-pragma, but
-no violation was actually found on that line.  If multiple policies
-are disabled on a given line, then you'll get a warning message
-for each policy.
+=item C<< suppressed_violations() >>
 
+Returns a list of references to all the L<Perl::Critic::Violation>s
+that were found in this Document but were suppressed.
 
 =back
 
-
 =head1 AUTHOR
 
 Chris Dolan <cdolan@cpan.org>
 
-
 =head1 COPYRIGHT
 
 Copyright (c) 2006-2008 Chris Dolan.  All rights reserved.
@@ -613,6 +499,7 @@ can be found in the LICENSE file included with this module.
 
 =cut
 
+##############################################################################
 # Local Variables:
 #   mode: cperl
 #   cperl-indent-level: 4
index 096c9b7..e2973be 100644 (file)
@@ -54,8 +54,6 @@ sub _init {
     $self->{_top}             = dor(delete $args{top},                $FALSE);
     $self->{_verbose}         = dor(delete $args{verbose},            $DEFAULT_VERBOSITY);
     $self->{_criticism_fatal} = dor(delete $args{'criticism-fatal'},  $FALSE);
-    $self->{_warn_about_useless_no_critic} =
-        dor(delete $args{'warn_about_useless_no_critic'}, $FALSE);
     $self->{_pager}           = dor(delete $args{pager},              $EMPTY);
 
     # If we're using a pager or not outputing to a tty don't use colors.
@@ -171,13 +169,6 @@ sub criticism_fatal {
 
 #-----------------------------------------------------------------------------
 
-sub warn_about_useless_no_critic {
-    my ($self) = @_;
-    return $self->{_warn_about_useless_no_critic};
-}
-
-#-----------------------------------------------------------------------------
-
 sub force {
     my ($self) = @_;
     return $self->{_force};
@@ -190,6 +181,7 @@ sub top {
     return $self->{_top};
 }
 
+#-----------------------------------------------------------------------------
 
 1;
 
@@ -303,10 +295,6 @@ command string).
 
 Returns the default C<criticism-fatal> setting (Either 1 or 0).
 
-=item C< warn_about_useless_no_critic() >
-
-Returns the default C<warn-about-useless-no-critic> setting (Either 1 or 0).
-
 =back
 
 
index 2078393..452f420 100644 (file)
@@ -22,7 +22,7 @@ our $VERSION = '1.093_02';
 
 #-----------------------------------------------------------------------------
 
-Readonly::Scalar my $DESC => q<Close filehandles as soon as possible after opening them>;
+Readonly::Scalar my $DESC => q<Close filehandles as soon as possible after opening them..>;
 Readonly::Scalar my $EXPL => [209];
 
 Readonly::Scalar my $SCALAR_SIGIL => q<$>;
index 5f15a02..4b43d4d 100644 (file)
@@ -19,7 +19,7 @@ our $VERSION = '1.093_02';
 
 #-----------------------------------------------------------------------------
 
-Readonly::Scalar my $DESC => q{Unrestriced '## no critic' pseudo-pragma};
+Readonly::Scalar my $DESC => q{Unrestriced '## no critic' annotation};
 Readonly::Scalar my $EXPL => q{Only disable the Policies you really need to disable};
 
 #-----------------------------------------------------------------------------
@@ -27,23 +27,28 @@ Readonly::Scalar my $EXPL => q{Only disable the Policies you really need to disa
 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 applies_to           { return 'PPI::Document'            }
 
 #-----------------------------------------------------------------------------
-# TODO: Consolidate these regexen with those used in Critic.pm
 
 sub violates {
-    my ( $self, $elem, undef ) = @_;
-    $elem =~ m{\A \#\# \s* no \s+ critic \s* (.*) \z}smx
-        or return;
+    my ( $self, $doc, undef ) = @_;
 
-    if ($1 !~ m{\A (?: qw)? \s* [("'] \s* \w+ }smx ) {
-        return $self->violation( $DESC, $EXPL, $elem );
+    # If for some reason $doc is not a P::C::Document, then all bets are off
+    return if not $doc->isa('Perl::Critic::Document');
+
+    my @violations = ();
+    for my $annotation ($doc->annotations()) {
+        if ($annotation->disables_all_policies()) {
+            my $elem = $annotation->element();
+            push @violations, $self->violation($DESC, $EXPL, $elem);
+        }
     }
 
-    return; # ok!
+    return @violations;
 }
 
+#-----------------------------------------------------------------------------
 
 1;
 
diff --git a/lib/Perl/Critic/Policy/Miscellanea/ProhibitUselessNoCritic.pm b/lib/Perl/Critic/Policy/Miscellanea/ProhibitUselessNoCritic.pm
new file mode 100644 (file)
index 0000000..5788d43
--- /dev/null
@@ -0,0 +1,154 @@
+##############################################################################
+#      $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::ProhibitUselessNoCritic;
+
+use 5.006001;
+use strict;
+use warnings;
+use Readonly;
+
+use List::MoreUtils qw< none >;
+
+use Perl::Critic::Utils qw{ :severities :classification hashify };
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '1.093_02';
+
+#-----------------------------------------------------------------------------
+
+Readonly::Scalar my $DESC => q{Useless '## no critic' annotation};
+Readonly::Scalar my $EXPL => q{This annotation can be removed};
+
+#-----------------------------------------------------------------------------
+
+sub supported_parameters { return ()                         }
+sub default_severity     { return $SEVERITY_LOW              }
+sub default_themes       { return qw(core maintenance)       }
+sub applies_to           { return 'PPI::Document'            }
+
+#-----------------------------------------------------------------------------
+
+sub violates {
+    my ( $self, undef, $doc ) = @_;
+
+    # If for some reason $doc is not a P::C::Document, then all bets are off
+    return if not $doc->isa('Perl::Critic::Document');
+
+    my @violations = ();
+    my @suppressed_viols = $doc->suppressed_violations();
+
+    for my $ann ( $doc->annotations() ) {
+        if ( none { _annotation_suppresses_violation($ann, $_) } @suppressed_viols ) {
+            push @violations, $self->violation($DESC, $EXPL, $ann->element());
+        }
+    }
+
+    return @violations;
+}
+
+#-----------------------------------------------------------------------------
+
+sub _annotation_suppresses_violation {
+    my ($annotation, $violation) = @_;
+
+    my $policy_name = $violation->policy();
+    my $line = $violation->location()->[0];
+
+    return $annotation->disables_line($line)
+        && $annotation->disables_policy($policy_name);
+}
+
+#-----------------------------------------------------------------------------
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Perl::Critic::Policy::Miscellanea::ProhibitUselessNoCritic - Remove ineffective "## no critic" markers.
+
+=head1 AFFILIATION
+
+This Policy is part of the core L<Perl::Critic|Perl::Critic> distribution.
+
+=head1 DESCRIPTION
+
+Sometimes, you may need to use a C<"## no critic"> annotation to work around
+a false-positive bug in L<Perl::Critic>.  But eventually, that bug might get
+fixed, leaving your code with extra C<"## no critic"> annotations lying about.
+Or you may use them to locally disable a Policy, but then later decide to
+permanently remove that Policy entirely from your profile, making some of
+those C<"## no critic"> annotations pointless.  Or, you may accidentally
+disable too many Policies at once, creating an opportunity for new
+violations to slip in unnoticed.
+
+This Policy will emit violations if you have a C<"## no critic"> annotation in
+your source code that does not actually suppress any violations given your
+current profile.  To resolve this, you should either remove the annotation
+entirely, or adjust the Policy name patterns in the annotation to match only
+the Policies that are actually being violated in your code.
+
+=head1 EXAMPLE
+
+For example, let's say I have a regex, but I don't want to use the C</x> flag,
+which violates the C<RegularExpressions::RequireExtendedFormatting> policy.
+In the following code, the C<"## no critic"> annotation will suppress
+violations of that Policy and ALL Policies that match
+C<m/RegularExpressions/imx>
+
+  my $re = qr/foo bar baz/ms;  ## no critic (RegularExpressions)
+
+However, this creates a potential loop-hole for someone to introduce
+additional violations in the future, without explicitly acknowledging them.
+This Policy is designed to catch these situations by warning you that you've
+disabled more Policies than the situation really requires.  The above code
+should be remedied like this:
+
+  my $re = qr/foo bar baz/ms;  ## no critic (RequireExtendedFormatting)
+
+Notice how the C<RequireExtendedFormatting> pattern more precisely matches
+the name of the Policy that I'm trying to suppress.
+
+=head1 NOTE
+
+Changing your F<.perlcriticrc> file and disabling policies globally or running
+at a higher (i.e. less restrictive) severity level may cause this Policy to
+emit additional violations.  So you might want to defer using this Policy
+until you have a fairly stable profile.
+
+
+=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 65d7c93..a080e2f 100644 (file)
@@ -106,8 +106,9 @@ Readonly::Array our @EXPORT_OK => qw(
 );
 
 
-# Note: this is deprecated.
-Readonly::Array our @EXPORT => @EXPORT_OK;  ## no critic (ProhibitAutomaticExport)
+# Note: this is deprecated.  This should also violate ProhibitAutomaticExportation,
+# but at the moment, we aren't smart enough to deal with Readonly variables.
+Readonly::Array our @EXPORT => @EXPORT_OK;
 
 
 Readonly::Hash our %EXPORT_TAGS => (
index b794f2c..7f4ea76 100644 (file)
@@ -75,7 +75,7 @@ sub _count_main_logic_operators_and_keywords {
         # Only count things that *are not* in a subroutine.  Returning an
         # explicit 'undef' here prevents PPI from descending into the node.
 
-        ## no critic Subroutines::ProhibitExplicitReturnUndef
+        ## no critic (ProhibitExplicitReturnUndef)
         return undef if $elem->isa('PPI::Statement::Sub');
 
 
index c05ea11..7df1aa2 100644 (file)
@@ -11,7 +11,7 @@ use 5.006001;
 use strict;
 use warnings;
 
-use Test::More (tests => 28);
+use Test::More (tests => 29);
 use Perl::Critic::PolicyFactory (-test => 1);
 
 # common P::C testing tools
@@ -32,6 +32,7 @@ my $profile = {
     '-Documentation::PodSpelling'                                => {},
     '-ErrorHandling::RequireCheckingReturnValueOfEval'           => {},
     '-Miscellanea::ProhibitUnrestrictedNoCritic'                 => {},
+    '-Miscellanea::ProhibitUselessNoCritic'                      => {},
     '-Miscellanea::RequireRcsKeywords'                           => {},
     '-ValuesAndExpressions::ProhibitMagicNumbers'                => {},
     '-Variables::ProhibitReusedNames'                            => {},
@@ -752,13 +753,26 @@ barf() unless $$ eq '';    ##no critic qw(Postfix,Empty,Punctuation)
 barf() unless $$ eq '';    ##no critic qw(Postfix , Empty , Punctuation)
 barf() unless $$ eq '';    ##no critic qw(Postfix Empty Punctuation)
 
-# no parentheses
-my $noisy = '!';           ##no critic NoisyQuotes;
-barf() unless $$ eq '';    ##no critic Postfix,Empty,Punctuation;
-barf() unless $$ eq '';    ##no critic Postfix , Empty , Punctuation;
-barf() unless $$ eq '';    ##no critic Postfix Empty Punctuation;
+# with quotes
+my $noisy = '!';           ##no critic 'NoisyQuotes';
+barf() unless $$ eq '';    ##no critic 'Postfix,Empty,Punctuation';
+barf() unless $$ eq '';    ##no critic 'Postfix , Empty , Punctuation';
+barf() unless $$ eq '';    ##no critic 'Postfix Empty Punctuation';
+
+# with double quotes
+my $noisy = '!';           ##no critic "NoisyQuotes";
+barf() unless $$ eq '';    ##no critic "Postfix,Empty,Punctuation";
+barf() unless $$ eq '';    ##no critic "Postfix , Empty , Punctuation";
+barf() unless $$ eq '';    ##no critic "Postfix Empty Punctuation";
+
+# with spacing variations
+my $noisy = '!';           ##no critic (NoisyQuotes)
+barf() unless $$ eq '';    ##  no   critic   (Postfix,Empty,Punctuation)
+barf() unless $$ eq '';    ##no critic(Postfix , Empty , Punctuation)
+barf() unless $$ eq '';    ##   no critic(Postfix Empty Punctuation)
 
 1;
+
 END_PERL
 
 is(
@@ -851,6 +865,29 @@ is(
 
 #-----------------------------------------------------------------------------
 
+$code = <<'END_PERL';
+#!/usr/bin/perl -w ## no critic
+
+package Foo;
+use strict;
+use warnings;
+our $VERSION = 1;
+
+my $noisy = '!'; # should find this
+
+END_PERL
+
+is(
+    critique(
+        \$code,
+        {-profile  => $profile, -severity => 1, -theme => 'core'},
+    ),
+    1,
+    'no critic on shebang line'
+);
+
+#-----------------------------------------------------------------------------
+
 # ensure we run true if this test is loaded by
 # t/03_pragmas.t_without_optional_dependencies.t
 1;
diff --git a/t/03_useless_pragmas.t b/t/03_useless_pragmas.t
deleted file mode 100644 (file)
index fb11ed4..0000000
+++ /dev/null
@@ -1,64 +0,0 @@
-#!perl
-
-##############################################################################
-#     $URL$
-#    $Date$
-#   $Author$
-# $Revision$
-##############################################################################
-
-use 5.006001;
-use strict;
-use warnings;
-
-#-----------------------------------------------------------------------------
-
-our $VERSION = '1.093_02';
-
-#-----------------------------------------------------------------------------
-
-use Test::More (tests => 1);
-use Perl::Critic::PolicyFactory (test => 1);
-use Perl::Critic::Document;
-use PPI::Document;
-
-#-----------------------------------------------------------------------------
-
-my $violation_free_code = <<'END_PERL';
-
-$foo = 0;  ## this line is not disabled
-
-## no critic;    
-$foo = 1;        
-## use critic;
-
-$foo = 2; ## no critic;
-
-$foo = 3; ## no critic (MagicNumbers)
-
-sub foo {  ## no critic (ExcessComplexity, BuiltinHomonyms)
-    return 1;
-}
-
-sub bar {
-    ## use critic (NoisyQuotes); # runs to end of block
-    return 1;
-}
-
-$foo = 5;  ## this line is not disabled
-
-## no critic (TwoArgOpen, ProtectPrivateVars); # runs to end of file...
-
-END_PERL
-
-my $ppi_doc = PPI::Document->new(\$violation_free_code);
-my $doc = Perl::Critic::Document->new($ppi_doc);
-
-my @site_policies = Perl::Critic::PolicyFactory::site_policy_names();
-$doc->mark_disabled_regions(@site_policies);
-
-my @empty_violation_list = ();
-my @got_warnings = $doc->useless_no_critic_warnings(@empty_violation_list);
-is(scalar @got_warnings, 7, 'Got correct numer of useless-no-critic warnings.');
-
-#-----------------------------------------------------------------------------
index 43c4db7..d92ece0 100644 (file)
@@ -130,12 +130,10 @@ sub test_is_hash_key {
     );
     is(scalar @words, scalar @expect, 'is_hash_key count');
 
-    ## no critic (ProhibitCStyleForLoops)
     for my $i (0 .. $#expect) {
         is($words[$i], $expect[$i][0], 'is_hash_key word');
         is(is_hash_key($words[$i]), $expect[$i][1], 'is_hash_key boolean');
     }
-    ## use critic
 
     return;
 }
index 21caa65..ac826de 100644 (file)
@@ -33,7 +33,7 @@ my $perlcritic = File::Spec->catfile( qw(blib script perlcritic) );
 if (not -e $perlcritic) {
     $perlcritic = File::Spec->catfile( qw(bin perlcritic) )
 }
-require $perlcritic;  ## no critic (StringyEval)
+require $perlcritic;
 
 # Because bin/perlcritic does not declare a package, it has functions
 # in main, just like this test file, so we can use its functions
index 59aa0e2..7a5eb0e 100644 (file)
@@ -10,7 +10,7 @@
 
 ##----------------------------------------------------------------------------
 ## name slightly more complicated failures
-## failures 6
+## failures 4
 ## cut
 
 # just some spacing variations here...
@@ -18,8 +18,8 @@ $foo = $bar; ##  no critic
 $foo = $bar; ##no critic
 
 $foo = $bar; ## no critic ()
-$foo = $bar; ## no critic ''
-$foo = $bar; ## no critic ""
+#$foo = $bar; ## no critic ''
+#$foo = $bar; ## no critic ""
 $foo = $bar; ## no critic qw()
 
 #----------------------------------------------------------------------------