File Coverage

blib/lib/Perl/Critic/Policy/NamingConventions/ProhibitMixedCaseVars.pm
Criterion Covered Total %
statement 30 31 96.7
branch 6 6 100.0
condition 3 3 100.0
subroutine 11 12 91.6
pod 4 5 80.0
total 54 57 94.7


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