Login
Rename is_document_exempt() to prepare_to_scan_document().
[gknop/Perl-Critic.git] / lib / Perl / Critic / Policy / NamingConventions / Capitalization.pm
CommitLineData
1a33d0ae
ES
1##############################################################################
2# $URL$
3# $Date$
4# $Author$
5# $Revision$
6##############################################################################
7
8package Perl::Critic::Policy::NamingConventions::Capitalization;
9
10use 5.006001;
11use strict;
12use warnings;
13
14use Readonly;
15
16use Perl::Critic::Utils qw{ :severities };
78afb6d4 17use Perl::Critic::Exception::Fatal::Internal qw{ throw_internal };
1a33d0ae
ES
18
19use base 'Perl::Critic::Policy';
20
c91d1333 21our $VERSION = '1.093_01';
1a33d0ae
ES
22
23#-----------------------------------------------------------------------------
24
78afb6d4
ES
25# Don't worry about leading digits-- let perl/PPI do that.
26Readonly::Scalar my $ALL_LOWER_REGEX => qr/ \A [[:lower:]_\d]+ \z /xms;
27Readonly::Scalar my $ALL_UPPER_REGEX => qr/ \A [[:upper:]_\d]+ \z /xms;
28Readonly::Scalar my $STARTS_WITH_LOWER_REGEX => qr/ \A [[:lower:]_] /xms;
29Readonly::Scalar my $STARTS_WITH_UPPER_REGEX => qr/ \A [[:upper:]_] /xms;
30Readonly::Scalar my $NO_RESTRICTION_REGEX => qr/ . /xms;
31
32Readonly::Hash my %CAPITALIZATION_SCHEMES => (
33 all_lower => {
34 regex => $ALL_LOWER_REGEX,
35 description => 'is not all lower case',
36 },
37 all_upper => {
38 regex => $ALL_UPPER_REGEX,
39 description => 'is not all upper case',
40 },
41 starts_with_lower => {
42 regex => $STARTS_WITH_LOWER_REGEX,
43 description => 'does not start with a lower case letter',
44 },
45 starts_with_upper => {
46 regex => $STARTS_WITH_UPPER_REGEX,
47 description => 'does not start with a upper case letter',
48 },
49 no_restriction => {
50 regex => $NO_RESTRICTION_REGEX,
51 description => 'there is a bug in Perl::Critic if you are reading this',
52 },
53);
54
55Readonly::Scalar my $PACKAGE_REGEX => qr/ :: | ' /xms;
56
57Readonly::Scalar my $EXPL => [ 45 ];
1a33d0ae
ES
58
59#-----------------------------------------------------------------------------
60
78afb6d4
ES
61# Can't handle named parameters yet.
62sub supported_parameters {
63 return (
64 {
65 name => 'packages',
66 description => 'How package names should be capitalized.',
67 default_string => 'starts_with_upper',
68 behavior => 'enumeration',
69 enumeration_values => [ sort keys %CAPITALIZATION_SCHEMES ],
70 enumeration_allow_multiple_values => 0,
71 },
72 {
73 name => 'subroutines',
74 description => 'How subroutine names should be capitalized.',
75 default_string => 'all_lower',
76 behavior => 'enumeration',
77 enumeration_values => [ sort keys %CAPITALIZATION_SCHEMES ],
78 enumeration_allow_multiple_values => 0,
79 },
80 {
81 name => 'local_lexical_variables',
82 description => 'How local lexical variables names should be capitalized.',
83 default_string => 'all_lower',
84 behavior => 'enumeration',
85 enumeration_values => [ sort keys %CAPITALIZATION_SCHEMES ],
86 enumeration_allow_multiple_values => 0,
87 },
88 {
89 name => 'non_subroutine_lexical_variables',
90 description => 'How lexical variables outside of subroutines should be capitalized.',
91 default_string => 'all_lower',
92 behavior => 'enumeration',
93 enumeration_values => [ sort keys %CAPITALIZATION_SCHEMES ],
94 enumeration_allow_multiple_values => 0,
95 },
96 {
97 name => 'global_variables',
98 description => 'How global (package) variables should be capitalized.',
99 default_string => 'all_lower', # Matches ProhibitMixedCase*
100 behavior => 'enumeration',
101 enumeration_values => [ sort keys %CAPITALIZATION_SCHEMES ],
102 enumeration_allow_multiple_values => 0,
103 },
104 {
105 name => 'constants',
106 description => 'How constant names should be capitalized.',
107 default_string => 'all_upper',
108 behavior => 'enumeration',
109 enumeration_values => [ sort keys %CAPITALIZATION_SCHEMES ],
110 enumeration_allow_multiple_values => 0,
111 },
112 )
113}
114
1a33d0ae
ES
115sub default_severity { return $SEVERITY_LOWEST }
116sub default_themes { return qw( core pbp cosmetic ) }
117
118sub applies_to {
78afb6d4
ES
119 return
120 'PPI::Statement::Variable',
121 'PPI::Statement::Package',
122 'PPI::Statement::Sub';
1a33d0ae
ES
123}
124
125#-----------------------------------------------------------------------------
126
127sub violates {
128 my ( $self, $elem, undef ) = @_;
129
78afb6d4
ES
130 my @violations;
131 if ( $elem->isa('PPI::Statement::Variable') ) {
132 @violations = $self->_variable_capitalization($elem);
133 }
134 elsif ( $elem->isa('PPI::Statement::Package') ) {
135 @violations = $self->_package_capitalization($elem);
136 }
137 elsif ( $elem->isa('PPI::Statement::Sub') ) {
138 @violations = $self->_subroutine_capitalization($elem);
139 }
140 else {
141 throw_internal 'Should never reach this point';
142 }
1a33d0ae 143
78afb6d4 144 return @violations;
1a33d0ae
ES
145}
146
147sub _variable_capitalization {
78afb6d4 148 my ($self, $elem) = @_;
1a33d0ae 149
78afb6d4 150 my @violations;
1a33d0ae
ES
151 for my $name ( $elem->variables() ) {
152 # Fully qualified names are exempt because we can't be responsible for
153 # other people's sybols.
78afb6d4 154 next if $elem->type() eq 'local' && $name =~ m/$PACKAGE_REGEX/xms;
1a33d0ae 155
1a33d0ae
ES
156 }
157
78afb6d4 158 return @violations;
1a33d0ae
ES
159}
160
161sub _package_capitalization {
78afb6d4 162 my ($self, $elem) = @_;
1a33d0ae 163
78afb6d4
ES
164 my $namespace = $elem->namespace();
165 my @components = split m/::/xms, $namespace;
166
167 foreach my $component (@components) {
168 my $violation =
169 $self->_check_capitalization(
170 $component, $component, 'packages', $elem,
171 );
172 return $violation if $violation;
1a33d0ae
ES
173 }
174
175 return;
176}
177
78afb6d4
ES
178sub _subroutine_capitalization {
179 my ($self, $elem) = @_;
180
181 my $name = $elem->name();
182
183 return $self->_check_capitalization($name, $name, 'subroutines', $elem);
184}
185
186sub _check_capitalization {
187 my ($self, $to_match, $full_name, $name_type, $elem) = @_;
188
189 my $scheme_name = $self->{"_$name_type"};
190 my $scheme = $CAPITALIZATION_SCHEMES{$scheme_name};
191 my ($regex, $description) = @{$scheme}{ qw< regex description > };
192
193 if ($to_match !~ m/$regex/xms) {
194 return $self->violation("$full_name $description", $EXPL, $elem);
195 }
1a33d0ae 196
1a33d0ae
ES
197 return;
198}
199
2001;
201
202__END__
203
204#-----------------------------------------------------------------------------
205
206=head1 NAME
207
208Perl::Critic::Policy::NamingConventions::Capitalization - Distinguish different program components by case.
209
210
211=head1 AFFILIATION
212
213This Policy is part of the core L<Perl::Critic|Perl::Critic> distribution.
214
54cf6225 215
1a33d0ae
ES
216=head1 DESCRIPTION
217
218Conway recommends to distinguish different program components by case.
219
220Normal subroutines, methods and variables are all in lower case.
221
222 my $foo; # ok
223 my $foo_bar; # ok
224 sub foo {} # ok
225 sub foo_bar {} # ok
226
227 my $Foo; # not ok
228 my $foo_Bar; # not ok
229 sub Foo {} # not ok
230 sub foo_Bar {} # not ok
231
232Package and class names are capitalized.
233
234 package IO::Thing; # ok
235 package Web::FooBar # ok
236
237 package foo; # not ok
238 package foo::Bar; # not ok
239
240Constants are in all-caps.
241
242 Readonly::Scalar my $FOO = 42; # ok
243
244 Readonly::Scalar my $foo = 42; # not ok
245
54cf6225 246
1a33d0ae
ES
247=head1 CONFIGURATION
248
249This Policy is not configurable except for the standard options.
250
251
252=head1 BUGS
253
254The policy cannot currently tell that a variable is being declared as
255a constant, thus any variable may be made all-caps.
256
257
258=head1 SEE ALSO
259
54cf6225
ES
260To control use of camelCase see
261L<Perl::Critic::Policy::NamingConventions::ProhibitMixedCaseSubs|Perl::Critic::Policy::NamingConventions::ProhibitMixedCaseSubs>
262and
263L<Perl::Critic::Policy::NamingConventions::ProhibitMixedCaseVars|Perl::Critic::Policy::NamingConventions::ProhibitMixedCaseVars>.
264
265
266=head1 AUTHOR
267
268Michael G Schwern <schwern@pobox.com>
269
270
271=head1 COPYRIGHT
272
273Copyright (c) 2008 Michael G Schwern. All rights reserved.
274
275This program is free software; you can redistribute it and/or modify
276it under the same terms as Perl itself. The full text of this license
277can be found in the LICENSE file included with this module.
1a33d0ae
ES
278
279=cut
280
281# Local Variables:
282# mode: cperl
283# cperl-indent-level: 4
284# fill-column: 78
285# indent-tabs-mode: nil
286# c-indentation-style: bsd
287# End:
288# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :