git.maemo.org Git - pkg-perl/blob - deb-src/libperl-critic-perl/libperl-critic-perl-1.088/lib/Perl/Critic/Policy/NamingConventions/ProhibitMixedCaseVars.pm

   1 ##############################################################################
   2 #      $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/lib/Perl/Critic/Policy/NamingConventions/ProhibitMixedCaseVars.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::NamingConventions::ProhibitMixedCaseVars;
   9
  10 use 5.006001;
  11 use strict;
  12 use warnings;
  13 use Readonly;
  14
  15 use Perl::Critic::Utils qw{ :severities };
  16
  17 use base 'Perl::Critic::Policy';
  18
  19 our $VERSION = '1.088';
  20
  21 #-----------------------------------------------------------------------------
  22
  23 Readonly::Scalar my $PACKAGE_RX     => qr/ :: /mx;
  24 Readonly::Scalar my $UPPER_LOWER    => qr/ [[:upper:]] [[:lower:]] /xm;
  25 Readonly::Scalar my $LOWER_UPPER    => qr/ [[:lower:]] [[:upper:]] /xm;
  26 Readonly::Scalar my $MIXED_RX       => qr{ $UPPER_LOWER | $LOWER_UPPER }xmo;
  27 Readonly::Scalar my $DESC       => 'Mixed-case variable name(s)';
  28 Readonly::Scalar my $EXPL       => [ 44 ];
  29
  30 #-----------------------------------------------------------------------------
  31
  32 sub supported_parameters { return ()                         }
  33 sub default_severity     { return $SEVERITY_LOWEST           }
  34 sub default_themes       { return qw( core pbp cosmetic )    }
  35 sub applies_to           { return 'PPI::Statement::Variable' }
  36
  37 #-----------------------------------------------------------------------------
  38
  39 sub violates {
  40     my ( $self, $elem, undef ) = @_;
  41     if ( _has_mixed_case_vars($elem) ) {
  42         return $self->violation( $DESC, $EXPL, $elem );
  43     }
  44     return;    #ok!
  45 }
  46
  47
  48 sub _has_mixed_case_vars {
  49     my $elem = shift;
  50     for my $variable_name ( $elem->variables() ) {
  51
  52         #Variables with fully qualified package names are exempt
  53         #because we can't really be responsible for symbols that
  54         #are defined in other packages.
  55
  56         next if $elem->type() eq 'local' && $variable_name =~ m/$PACKAGE_RX/xms;
  57         return 1 if $variable_name =~ m/$MIXED_RX/xms;
  58     }
  59     return 0;
  60 }
  61
  62 1;
  63
  64 __END__
  65
  66 #-----------------------------------------------------------------------------
  67
  68 =pod
  69
  70 =head1 NAME
  71
  72 Perl::Critic::Policy::NamingConventions::ProhibitMixedCaseVars - Write C<$my_variable = 42> instead of C<$MyVariable = 42>.
  73
  74 =head1 AFFILIATION
  75
  76 This Policy is part of the core L<Perl::Critic> distribution.
  77
  78
  79 =head1 DESCRIPTION
  80
  81 Conway's recommended naming convention is to use lower-case words
  82 separated by underscores.  Well-recognized acronyms can be in ALL
  83 CAPS, but must be separated by underscores from other parts of the
  84 name.
  85
  86   my $foo_bar   #ok
  87   my $foo_BAR   #ok
  88   my @FOO_bar   #ok
  89   my %FOO_BAR   #ok
  90
  91   my $FooBar   #not ok
  92   my $FOObar   #not ok
  93   my @fooBAR   #not ok
  94   my %fooBar   #not ok
  95
  96
  97 =head1 CONFIGURATION
  98
  99 This Policy is not configurable except for the standard options.
 100
 101
 102 =head1 SEE ALSO
 103
 104 L<Perl::Critic::Policy::NamingConventions::ProhibitMixedCaseSubs>
 105
 106 =head1 AUTHOR
 107
 108 Jeffrey Ryan Thalhammer <thaljef@cpan.org>
 109
 110 =head1 COPYRIGHT
 111
 112 Copyright (c) 2005-2008 Jeffrey Ryan Thalhammer.  All rights reserved.
 113
 114 This program is free software; you can redistribute it and/or modify
 115 it under the same terms as Perl itself.  The full text of this license
 116 can be found in the LICENSE file included with this module.
 117
 118 =cut
 119
 120 # Local Variables:
 121 #   mode: cperl
 122 #   cperl-indent-level: 4
 123 #   fill-column: 78
 124 #   indent-tabs-mode: nil
 125 #   c-indentation-style: bsd
 126 # End:
 127 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :