vcs.maemo.org Git - dh-make-perl/blob - dev/i386/libperl-critic-perl/libperl-critic-perl-1.088/lib/Perl/Critic/Policy/ControlStructures/ProhibitLabelsWithSpecialBlockNames.pm

   1 ##############################################################################
   2 #      $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/lib/Perl/Critic/Policy/ControlStructures/ProhibitLabelsWithSpecialBlockNames.pm $
   3 #     $Date: 2008-07-03 10:19:10 -0500 (Thu, 03 Jul 2008) $
   4 #   $Author: clonezone $
   5 # $Revision: 2489 $
   6 ##############################################################################
   7
   8 package Perl::Critic::Policy::ControlStructures::ProhibitLabelsWithSpecialBlockNames;
   9
  10 use 5.006001;
  11 use strict;
  12 use warnings;
  13
  14 use Readonly;
  15
  16 use Perl::Critic::Utils qw{ :severities hashify };
  17 use base 'Perl::Critic::Policy';
  18
  19 our $VERSION = '1.088';
  20
  21 Readonly::Hash my %SPECIAL_BLOCK_NAMES =>
  22     hashify( qw< BEGIN END INIT CHECK UNITCHECK > );
  23
  24 #-----------------------------------------------------------------------------
  25
  26 Readonly::Scalar my $DESC => q<Special block name used as label.>;
  27 Readonly::Scalar my $EXPL =>
  28     q<Use a label that cannot be confused with BEGIN, END, CHECK, INIT, or UNITCHECK blocks.>;
  29
  30 #-----------------------------------------------------------------------------
  31
  32 sub supported_parameters { return ()                      }
  33 sub default_severity     { return $SEVERITY_HIGH          }
  34 sub default_themes       { return qw< core bugs >         }
  35 sub applies_to           { return qw< PPI::Token::Label > }
  36
  37 #-----------------------------------------------------------------------------
  38
  39 sub violates {
  40     my ($self, $elem, undef) = @_;
  41
  42     # Does the function call have enough arguments?
  43     my $label = $elem->content();
  44     $label =~ s/ \s* : \z //xms;
  45     return if not $SPECIAL_BLOCK_NAMES{ $label };
  46
  47     return $self->violation( $DESC, $EXPL, $elem );
  48 }
  49
  50
  51 1;
  52
  53 #-----------------------------------------------------------------------------
  54
  55 __END__
  56
  57 =for stopwords Lauen O'Regan
  58
  59 =pod
  60
  61 =head1 NAME
  62
  63 Perl::Critic::Policy::ControlStructures::ProhibitLabelsWithSpecialBlockNames - Don't use labels that are the same as the special block names.
  64
  65
  66 =head1 AFFILIATION
  67
  68 This Policy is part of the core L<Perl::Critic> distribution.
  69
  70
  71 =head1 DESCRIPTION
  72
  73 When using one of the special Perl blocks C<BEGIN>, C<END>, C<CHECK>,
  74 C<INIT>, and C<UNITCHECK>, it is easy to mistakenly add a colon to the
  75 end of the block name.  E.g.:
  76
  77     # a BEGIN block that gets executed at compile time.
  78     BEGIN { <...code...> }
  79
  80     # an ordinary labeled block that gets executed at run time.
  81     BEGIN: { <...code...> }
  82
  83 The labels "BEGIN:", "END:", etc. are probably errors.  This policy
  84 prohibits the special Perl block names from being used as labels.
  85
  86
  87 =head1 CONFIGURATION
  88
  89 This Policy is not configurable except for the standard options.
  90
  91
  92 =head1 SEE ALSO
  93
  94 L<Perl Buzz article|http://perlbuzz.com/2008/05/colons-invalidate-your-begin-and-end-blocks.html>
  95 on this issue.
  96
  97
  98 =head1 ACKNOWLEDGMENT
  99
 100 Randy Lauen for identifying the problem.
 101
 102
 103 =head1 AUTHOR
 104
 105 Mike O'Regan
 106
 107
 108 =head1 COPYRIGHT
 109
 110 Copyright (c) 2008 Mike O'Regan.  All rights reserved.
 111
 112 This program is free software; you can redistribute it and/or modify
 113 it under the same terms as Perl itself.
 114
 115 =cut
 116
 117 # Local Variables:
 118 #   mode: cperl
 119 #   cperl-indent-level: 4
 120 #   fill-column: 78
 121 #   indent-tabs-mode: nil
 122 #   c-indentation-style: bsd
 123 # End:
 124 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :