File Coverage

blib/lib/Perl/Critic/Policy/NamingConventions/Capitalization.pm
Criterion Covered Total %
statement 170 182 93.4
branch 65 86 75.5
condition 8 13 61.5
subroutine 32 32 100.0
pod 5 6 83.3
total 280 319 87.7


line stmt bran cond sub pod time code
1             package Perl::Critic::Policy::NamingConventions::Capitalization;
2              
3 40     40   30825 use 5.010001;
  40         240  
4 40     40   284 use strict;
  40         118  
  40         954  
5 40     40   271 use warnings;
  40         123  
  40         1401  
6              
7 40     40   308 use English qw< -no_match_vars >;
  40         124  
  40         297  
8 40     40   15924 use Readonly;
  40         139  
  40         2133  
9              
10 40     40   344 use List::SomeUtils qw( any );
  40         127  
  40         2184  
11              
12 40     40   344 use Perl::Critic::Exception::AggregateConfiguration;
  40         191  
  40         2157  
13 40     40   360 use Perl::Critic::Exception::Configuration::Option::Policy::ParameterValue;
  40         114  
  40         2269  
14 40         2045 use Perl::Critic::Utils qw<
15             :booleans :characters :severities
16             hashify is_perl_global
17 40     40   317 >;
  40         192  
18 40     40   31769 use Perl::Critic::Utils::Perl qw< symbol_without_sigil >;
  40         136  
  40         2535  
19 40         1991 use Perl::Critic::Utils::PPI qw<
20             is_in_subroutine
21 40     40   351 >;
  40         112  
22 40         2391 use PPIx::Utilities::Statement qw<
23             get_constant_name_elements_from_declaring_statement
24 40     40   19973 >;
  40         38870  
25              
26 40     40   390 use parent 'Perl::Critic::Policy';
  40         142  
  40         289  
27              
28             our $VERSION = '1.146';
29              
30             #-----------------------------------------------------------------------------
31              
32             # Don't worry about leading digits-- let perl/PPI do that.
33             Readonly::Scalar my $ALL_ONE_CASE_REGEX =>
34             qr< \A [@%\$]? (?: [[:lower:]_\d]+ | [[:upper:]_\d]+ ) \z >xms;
35             Readonly::Scalar my $ALL_LOWER_REGEX => qr< \A [[:lower:]_\d]+ \z >xms;
36             Readonly::Scalar my $ALL_UPPER_REGEX => qr< \A [[:upper:]_\d]+ \z >xms;
37             Readonly::Scalar my $STARTS_WITH_LOWER_REGEX => qr< \A _* [[:lower:]\d] >xms;
38             Readonly::Scalar my $STARTS_WITH_UPPER_REGEX => qr< \A _* [[:upper:]\d] >xms;
39             Readonly::Scalar my $NO_RESTRICTION_REGEX => qr< . >xms;
40              
41             Readonly::Hash my %CAPITALIZATION_SCHEME_TAGS => (
42             ':single_case' => {
43             regex => $ALL_ONE_CASE_REGEX,
44             regex_violation => 'is not all lower case or all upper case',
45             },
46             ':all_lower' => {
47             regex => $ALL_LOWER_REGEX,
48             regex_violation => 'is not all lower case',
49             },
50             ':all_upper' => {
51             regex => $ALL_UPPER_REGEX,
52             regex_violation => 'is not all upper case',
53             },
54             ':starts_with_lower' => {
55             regex => $STARTS_WITH_LOWER_REGEX,
56             regex_violation => 'does not start with a lower case letter',
57             },
58             ':starts_with_upper' => {
59             regex => $STARTS_WITH_UPPER_REGEX,
60             regex_violation => 'does not start with a upper case letter',
61             },
62             ':no_restriction' => {
63             regex => $NO_RESTRICTION_REGEX,
64             regex_violation => 'there is a bug in Perl::Critic if you are reading this',
65             },
66             );
67              
68             Readonly::Scalar my $PACKAGE_REGEX => qr/ :: | ' /xms;
69              
70             Readonly::Hash my %NAME_FOR_TYPE => (
71             package => 'Package',
72             subroutine => 'Subroutine',
73             local_lexical_variable => 'Local lexical variable',
74             scoped_lexical_variable => 'Scoped lexical variable',
75             file_lexical_variable => 'File lexical variable',
76             global_variable => 'Global variable',
77             constant => 'Constant',
78             label => 'Label',
79             );
80              
81             Readonly::Hash my %IS_COMMA => hashify( $COMMA, $FATCOMMA );
82              
83             Readonly::Scalar my $EXPL => [ 45, 46 ];
84              
85             #-----------------------------------------------------------------------------
86              
87             # Can't handle named parameters yet.
88             sub supported_parameters {
89             return (
90             {
91 1206     1206 0 36361 name => 'packages',
92             description => 'How package name components should be capitalized. Valid values are :single_case, :all_lower, :all_upper:, :starts_with_lower, :starts_with_upper, :no_restriction, or a regex.',
93             default_string => ':starts_with_upper',
94             behavior => 'string',
95             },
96             {
97             name => 'package_exemptions',
98             description => 'Package names that are exempt from capitalization rules. The values here are regexes that will be surrounded by \A and \z.',
99             default_string => 'main',
100             behavior => 'string list',
101             },
102             {
103             name => 'subroutines',
104             description => 'How subroutine names should be capitalized. Valid values are :single_case, :all_lower, :all_upper, :starts_with_lower, :starts_with_upper, :no_restriction, or a regex.',
105             default_string => ':single_case', # Matches ProhibitMixedCaseSubs
106             behavior => 'string',
107             },
108             {
109             name => 'subroutine_exemptions',
110             description => 'Subroutine names that are exempt from capitalization rules. The values here are regexes that will be surrounded by \A and \z.',
111             default_string =>
112             join (
113             $SPACE,
114             qw<
115              
116             AUTOLOAD BUILD BUILDARGS CLEAR CLOSE
117             DELETE DEMOLISH DESTROY EXISTS EXTEND
118             FETCH FETCHSIZE FIRSTKEY GETC NEXTKEY
119             POP PRINT PRINTF PUSH READ
120             READLINE SCALAR SHIFT SPLICE STORE
121             STORESIZE TIEARRAY TIEHANDLE TIEHASH TIESCALAR
122             UNSHIFT UNTIE WRITE
123              
124             >,
125             ),
126             behavior => 'string list',
127             },
128             {
129             name => 'local_lexical_variables',
130             description => 'How local lexical variables names should be capitalized. Valid values are :single_case, :all_lower, :all_upper, :starts_with_lower, :starts_with_upper, :no_restriction, or a regex.',
131             default_string => ':single_case', # Matches ProhibitMixedCaseVars
132             behavior => 'string',
133             },
134             {
135             name => 'local_lexical_variable_exemptions',
136             description => 'Local lexical variable names that are exempt from capitalization rules. The values here are regexes that will be surrounded by \A and \z.',
137             default_string => $EMPTY,
138             behavior => 'string list',
139             },
140             {
141             name => 'scoped_lexical_variables',
142             description => 'How lexical variables that are scoped to a subset of subroutines, should be capitalized. Valid values are :single_case, :all_lower, :all_upper, :starts_with_lower, :starts_with_upper, :no_restriction, or a regex.',
143             default_string => ':single_case', # Matches ProhibitMixedCaseVars
144             behavior => 'string',
145             },
146             {
147             name => 'scoped_lexical_variable_exemptions',
148             description => 'Names for variables in anonymous blocks that are exempt from capitalization rules. The values here are regexes that will be surrounded by \A and \z.',
149             default_string => $EMPTY,
150             behavior => 'string list',
151             },
152             {
153             name => 'file_lexical_variables',
154             description => 'How lexical variables at the file level should be capitalized. Valid values are :single_case, :all_lower, :all_upper, :starts_with_lower, :starts_with_upper, :no_restriction, or a regex.',
155             default_string => ':single_case', # Matches ProhibitMixedCaseVars
156             behavior => 'string',
157             },
158             {
159             name => 'file_lexical_variable_exemptions',
160             description => 'File-scope lexical variable names that are exempt from capitalization rules. The values here are regexes that will be surrounded by \A and \z.',
161             default_string => $EMPTY,
162             behavior => 'string list',
163             },
164             {
165             name => 'global_variables',
166             description => 'How global (package) variables should be capitalized. Valid values are :single_case, :all_lower, :all_upper, :starts_with_lower, :starts_with_upper, :no_restriction, or a regex.',
167             default_string => ':single_case', # Matches ProhibitMixedCaseVars
168             behavior => 'string',
169             },
170             {
171             name => 'global_variable_exemptions',
172             description => 'Global variable names that are exempt from capitalization rules. The values here are regexes that will be surrounded by \A and \z.',
173             default_string => '\$VERSION @ISA @EXPORT(?:_OK)? %EXPORT_TAGS \$AUTOLOAD %ENV %SIG \$TODO', ## no critic (RequireInterpolation)
174             behavior => 'string list',
175             },
176             {
177             name => 'constants',
178             description => 'How constant names should be capitalized. Valid values are :single_case, :all_lower, :all_upper, :starts_with_lower, :starts_with_upper, :no_restriction, or a regex.',
179             default_string => ':all_upper',
180             behavior => 'string',
181             },
182             {
183             name => 'constant_exemptions',
184             description => 'Constant names that are exempt from capitalization rules. The values here are regexes that will be surrounded by \A and \z.',
185             default_string => $EMPTY,
186             behavior => 'string list',
187             },
188             {
189             name => 'labels',
190             description => 'How labels should be capitalized. Valid values are :single_case, :all_lower, :all_upper, :starts_with_lower, :starts_with_upper, :no_restriction, or a regex.',
191             default_string => ':all_upper',
192             behavior => 'string',
193             },
194             {
195             name => 'label_exemptions',
196             description => 'Labels that are exempt from capitalization rules. The values here are regexes that will be surrounded by \A and \z.',
197             default_string => $EMPTY,
198             behavior => 'string list',
199             },
200             );
201             }
202              
203 338     338 1 1350 sub default_severity { return $SEVERITY_LOWEST }
204 84     84 1 391 sub default_themes { return qw< core pbp cosmetic > }
205 1131     1131 1 3522 sub applies_to { return qw< PPI::Statement PPI::Token::Label > }
206              
207             #-----------------------------------------------------------------------------
208              
209             sub initialize_if_enabled {
210 1166     1166 1 3294 my ($self, $config) = @_;
211              
212 1166         4364 my $configuration_exceptions =
213             Perl::Critic::Exception::AggregateConfiguration->new();
214              
215             KIND:
216 1166         998262 foreach my $kind_of_name ( qw<
217             package subroutine
218             local_lexical_variable scoped_lexical_variable
219             file_lexical_variable global_variable
220             constant label
221             > ) {
222 9328         24040 my ($capitalization_regex, $message) =
223             $self->_derive_capitalization_test_regex_and_message(
224             $kind_of_name, $configuration_exceptions,
225             );
226 9328         119904 my $exemption_regexes =
227             $self->_derive_capitalization_exemption_test_regexes(
228             $kind_of_name, $configuration_exceptions,
229             );
230              
231             # Keep going, despite problems, so that all problems can be reported
232             # at one go, rather than the user fixing one problem, receiving a new
233             # error, etc..
234 9328 50       26285 next KIND if $configuration_exceptions->has_exceptions();
235              
236             $self->{"_${kind_of_name}_test"} = sub {
237 1272     1272   2542 my ($name) = @_;
238              
239 1272 100       3170 return if _name_is_exempt($name, $exemption_regexes);
240              
241 997 100       8112 return $message if $name !~ m/$capitalization_regex/xms;
242 733         2337 return;
243             }
244 9328         102649 }
245              
246 1166 50       3915 if ( $configuration_exceptions->has_exceptions() ) {
247 0         0 $configuration_exceptions->throw();
248             }
249              
250 1166         33703 return $TRUE;
251             }
252              
253             sub _derive_capitalization_test_regex_and_message {
254 9328     9328   22341 my ($self, $kind_of_name, $configuration_exceptions) = @_;
255              
256 9328         20998 my $capitalization_option = "${kind_of_name}s";
257 9328         22909 my $capitalization = $self->{"_$capitalization_option"};
258              
259 9328 100       40870 if ( my $tag_properties = $CAPITALIZATION_SCHEME_TAGS{$capitalization} ) {
    50          
260 9236         65468 return @{$tag_properties}{ qw< regex regex_violation > };
  9236         37031  
261             }
262             elsif ($capitalization =~ m< \A : >xms) {
263 0         0 $configuration_exceptions->add_exception(
264             Perl::Critic::Exception::Configuration::Option::Policy::ParameterValue->new(
265             policy => $self,
266             option_name => $capitalization_option,
267             option_value => $capitalization,
268             message_suffix =>
269             'is not a known capitalization scheme tag. Valid tags are: '
270             . (join q<, >, sort keys %CAPITALIZATION_SCHEME_TAGS)
271             . $PERIOD,
272             )
273             );
274 0         0 return;
275             }
276              
277 92         1062 my $regex;
278 92         785 eval { $regex = qr< \A $capitalization \z >xms; }
279 92 50       221 or do {
280 0         0 $configuration_exceptions->add_exception(
281             Perl::Critic::Exception::Configuration::Option::Policy::ParameterValue->new(
282             policy => $self,
283             option_name => $capitalization_option,
284             option_value => $capitalization,
285             message_suffix =>
286             "is not a valid regular expression: $EVAL_ERROR",
287             )
288             );
289 0         0 return;
290             };
291              
292 92         483 return $regex, qq<does not match "\\A$capitalization\\z".>;
293             }
294              
295             sub _derive_capitalization_exemption_test_regexes {
296 9328     9328   18094 my ($self, $kind_of_name, $configuration_exceptions) = @_;
297              
298 9328         18251 my $exemptions_option = "${kind_of_name}_exemptions";
299 9328         21157 my $exemptions = $self->{"_$exemptions_option"};
300              
301 9328         14274 my @regexes;
302              
303             PATTERN:
304 9328         13919 foreach my $pattern ( keys %{$exemptions} ) {
  9328         33300  
305 47530         68589 my $regex;
306 47530         423209 eval { $regex = qr< \A $pattern \z >xms; }
307 47530 50       68089 or do {
308 0         0 $configuration_exceptions->add_exception(
309             Perl::Critic::Exception::Configuration::Option::Policy::ParameterValue->new(
310             policy => $self,
311             option_name => $exemptions_option,
312             option_value => $pattern,
313             message_suffix =>
314             "is not a valid regular expression: $EVAL_ERROR",
315             )
316             );
317 0         0 next PATTERN;
318             };
319              
320 47530         111006 push @regexes, $regex;
321             }
322              
323 9328         23933 return \@regexes;
324             }
325              
326             sub _name_is_exempt {
327 1272     1272   2783 my ($name, $exemption_regexes) = @_;
328              
329 1272         2130 foreach my $regex ( @{$exemption_regexes} ) {
  1272         2969  
330 8036 100       25887 return $TRUE if $name =~ m/$regex/xms;
331             }
332              
333 997         3073 return $FALSE;
334             }
335              
336             #-----------------------------------------------------------------------------
337              
338             sub violates {
339 3002     3002 1 7360 my ( $self, $elem, undef ) = @_;
340              
341             # Want given. Want 5.10. Gimme gimme gimme. :]
342 3002 100       12260 if ( $elem->isa('PPI::Statement::Variable') ) {
343 795         2900 return $self->_variable_capitalization($elem);
344             }
345              
346 2207 100       7516 if ( $elem->isa('PPI::Statement::Sub') ) {
347 250         1062 return $self->_subroutine_capitalization($elem);
348             }
349              
350 1957 100       5858 if (
351             my @names = get_constant_name_elements_from_declaring_statement($elem)
352             ) {
353 3         17 return ( grep { $_ }
354 9         1274 map { $self->_constant_capitalization( $elem, $_ ) } @names )
  11         40  
355             }
356              
357 1948 100       79710 if ( $elem->isa('PPI::Statement::Package') ) {
358 139         537 return $self->_package_capitalization($elem);
359             }
360              
361 1809 100 100     7264 if (
362             $elem->isa('PPI::Statement::Compound') and $elem->type() eq 'foreach'
363             ) {
364 142         8897 return $self->_foreach_variable_capitalization($elem);
365             }
366              
367 1667 100       29282 if ( $elem->isa('PPI::Token::Label') ) {
368 70         393 return $self->_label_capitalization($elem);
369             }
370              
371 1597         4998 return;
372             }
373              
374             sub _variable_capitalization {
375 795     795   1940 my ($self, $elem) = @_;
376              
377 795         1556 my @violations;
378              
379             NAME:
380 795         3197 for my $name ( map { $_->symbol() } $elem->symbols() ) {
  798         29203  
381 798 100       47747 if ($elem->type() eq 'local') {
    100          
382             # Fully qualified names are exempt because we can't be responsible
383             # for other people's symbols.
384 242 100       10659 next NAME if $name =~ m/$PACKAGE_REGEX/xms;
385 206 100       1076 next NAME if is_perl_global($name);
386              
387 102         1477 push
388             @violations,
389             $self->_check_capitalization(
390             symbol_without_sigil($name),
391             $name,
392             'global_variable',
393             $elem,
394             );
395             }
396             elsif ($elem->type() eq 'our') {
397 140         9647 push
398             @violations,
399             $self->_check_capitalization(
400             symbol_without_sigil($name),
401             $name,
402             'global_variable',
403             $elem,
404             );
405             }
406             else {
407             # Got my or state
408 416         26835 my $parent = $elem->parent();
409 416 100 66     4746 if ( not $parent or $parent->isa('PPI::Document') ) {
410 133         531 push
411             @violations,
412             $self->_check_capitalization(
413             symbol_without_sigil($name),
414             $name,
415             'file_lexical_variable',
416             $elem,
417             );
418             }
419             else {
420 283 100       1675 if ( _is_directly_in_scope_block($elem) ) {
421 68         348 push
422             @violations,
423             $self->_check_capitalization(
424             symbol_without_sigil($name),
425             $name,
426             'scoped_lexical_variable',
427             $elem,
428             );
429             }
430             else {
431 215         1655 push
432             @violations,
433             $self->_check_capitalization(
434             symbol_without_sigil($name),
435             $name,
436             'local_lexical_variable',
437             $elem,
438             );
439             }
440             }
441             }
442             }
443              
444 795         4820 return @violations;
445             }
446              
447             sub _subroutine_capitalization {
448 250     250   641 my ($self, $elem) = @_;
449              
450             # These names are fixed and you've got no choice what to call them.
451 250 100       1173 return if $elem->isa('PPI::Statement::Scheduled');
452              
453 216         968 my $name = $elem->name();
454 216         15394 $name =~ s{ .* :: }{}smx; # Allow for "sub Some::Package::foo {}"
455              
456 216         803 return $self->_check_capitalization($name, $name, 'subroutine', $elem);
457             }
458              
459             sub _constant_capitalization {
460 11     11   25 my ($self, $elem, $name) = @_;
461              
462 11         32 return $self->_check_capitalization(
463             symbol_without_sigil($name), $name, 'constant', $elem,
464             );
465             }
466              
467             sub _package_capitalization {
468 139     139   383 my ($self, $elem) = @_;
469              
470 139         556 my $namespace = $elem->namespace();
471 139         4671 my @components = split m/::/xms, $namespace;
472              
473 139         436 foreach my $component (@components) {
474 177         545 my $violation =
475             $self->_check_capitalization(
476             $component, $namespace, 'package', $elem,
477             );
478 177 100       651 return $violation if $violation;
479             }
480              
481 112         552 return;
482             }
483              
484             sub _foreach_variable_capitalization {
485 142     142   478 my ($self, $elem) = @_;
486              
487 142         349 my $type;
488             my $symbol;
489 142         437 my $second_element = $elem->schild(1);
490 142 50       2405 return if not $second_element;
491              
492 142 100       713 if ($second_element->isa('PPI::Token::Word')) {
493 108         356 $type = $second_element->content();
494 108         832 $symbol = $second_element->snext_sibling();
495             } else {
496 34         154 $type = 'my';
497 34         166 $symbol = $second_element;
498             }
499              
500 142 50       3789 return if not $symbol;
501 142 50       659 return if not $symbol->isa('PPI::Token::Symbol');
502              
503 142         603 my $name = $symbol->symbol();
504              
505 142 50       16761 if ($type eq 'local') {
    100          
506             # Fully qualified names are exempt because we can't be responsible
507             # for other people's symbols.
508 0 0       0 return if $name =~ m/$PACKAGE_REGEX/xms;
509 0 0       0 return if is_perl_global($name);
510              
511 0         0 return $self->_check_capitalization(
512             symbol_without_sigil($name), $name, 'global_variable', $elem,
513             );
514             }
515             elsif ($type eq 'our') {
516 34         227 return $self->_check_capitalization(
517             symbol_without_sigil($name), $name, 'global_variable', $elem,
518             );
519             }
520              
521             # Got my or state: treat as local lexical variable
522 108         526 return $self->_check_capitalization(
523             symbol_without_sigil($name), $name, 'local_lexical_variable', $elem,
524             );
525             }
526              
527             sub _label_capitalization {
528 70     70   206 my ($self, $elem, $name) = @_;
529              
530 70 100       314 return if _is_not_real_label($elem);
531 68         1913 ( my $label = $elem->content() ) =~ s< \s* : \z ><>xms;
532 68         751 return $self->_check_capitalization($label, $label, 'label', $elem);
533             }
534              
535             sub _check_capitalization {
536 1272     1272   3994 my ($self, $to_match, $full_name, $name_type, $elem) = @_;
537              
538 1272         3952 my $test = $self->{"_${name_type}_test"};
539 1272 100       3478 if ( my $message = $test->($to_match) ) {
540 264         1866 return $self->violation(
541             qq<$NAME_FOR_TYPE{$name_type} "$full_name" $message>,
542             $EXPL,
543             $elem,
544             );
545             }
546              
547 1008         3685 return;
548             }
549              
550              
551             # { my $x } parses as
552             # PPI::Document
553             # PPI::Statement::Compound
554             # PPI::Structure::Block { ... }
555             # PPI::Statement::Variable
556             # PPI::Token::Word 'my'
557             # PPI::Token::Symbol '$x'
558             # PPI::Token::Structure ';'
559             #
560             # Also, type() on the PPI::Statement::Compound returns "continue". *sigh*
561             #
562             # The parameter is expected to be the PPI::Statement::Variable.
563             sub _is_directly_in_scope_block {
564 283     283   803 my ($elem) = @_;
565              
566              
567 283 100       1515 return if is_in_subroutine($elem);
568              
569 145         593 my $parent = $elem->parent();
570 145 100       903 return if not $parent->isa('PPI::Structure::Block');
571              
572 77         212 my $grand_parent = $parent->parent();
573 77 50       457 return $TRUE if not $grand_parent;
574 77 50       350 return $TRUE if $grand_parent->isa('PPI::Document');
575              
576 77 50       264 return if not $grand_parent->isa('PPI::Statement::Compound');
577              
578 77         245 my $type = $grand_parent->type();
579 77 50       6302 return if not $type;
580 77 100       296 return if $type ne 'continue';
581              
582 68         227 my $great_grand_parent = $grand_parent->parent();
583             return if
584 68 50 33     747 $great_grand_parent and not $great_grand_parent->isa('PPI::Document');
585              
586             # Make sure we aren't really in a continue block.
587 68         308 my $prior_to_grand_parent = $grand_parent->sprevious_sibling();
588 68 50       2225 return $TRUE if not $prior_to_grand_parent;
589 0 0       0 return $TRUE if not $prior_to_grand_parent->isa('PPI::Token::Word');
590 0         0 return $prior_to_grand_parent->content() ne 'continue';
591             }
592              
593             sub _is_not_real_label {
594 70     70   208 my $elem = shift;
595              
596             # PPI misparses part of a ternary expression as a label
597             # when the token to the left of the ":" is a bareword.
598             # See http://rt.cpan.org/Ticket/Display.html?id=41170
599             # For example...
600             #
601             # $foo = $condition ? undef : 1;
602             #
603             # PPI thinks that "undef" is a label. To workaround this,
604             # I'm going to check that whatever PPI thinks is the label,
605             # actually is the first token in the statement. I believe
606             # this should be true for all real labels.
607              
608 70   50     322 my $stmnt = $elem->statement() || return;
609 70   50     1661 my $first_child = $stmnt->schild(0) || return;
610 70         1253 return $first_child ne $elem;
611             }
612              
613             1;
614              
615             __END__
616              
617             #-----------------------------------------------------------------------------
618              
619             =pod
620              
621             =for stopwords pbp perlstyle Schwern THINGY
622              
623             =head1 NAME
624              
625             Perl::Critic::Policy::NamingConventions::Capitalization - Distinguish different program components by case.
626              
627              
628             =head1 AFFILIATION
629              
630             This Policy is part of the core L<Perl::Critic|Perl::Critic> distribution.
631              
632              
633             =head1 DESCRIPTION
634              
635             Conway recommends to distinguish different program components by case.
636              
637             Normal subroutines, methods and variables are all in lower case.
638              
639             my $foo; # ok
640             my $foo_bar; # ok
641             sub foo {} # ok
642             sub foo_bar {} # ok
643              
644             my $Foo; # not ok
645             my $foo_Bar; # not ok
646             sub Foo {} # not ok
647             sub foo_Bar {} # not ok
648              
649             Package and class names are capitalized.
650              
651             package IO::Thing; # ok
652             package Web::FooBar # ok
653              
654             package foo; # not ok
655             package foo::Bar; # not ok
656              
657             Constants are in all-caps.
658              
659             Readonly::Scalar my $FOO = 42; # ok
660              
661             Readonly::Scalar my $foo = 42; # not ok
662              
663             There are other opinions on the specifics, for example, in
664             L<perlstyle|perlstyle>. This
665             policy can be configured to match almost any style that you can think of.
666              
667              
668             =head1 CONFIGURATION
669              
670             You can specify capitalization rules for the following things:
671             C<packages>, C<subroutines>, C<local_lexical_variables>,
672             C<scoped_lexical_variables>, C<file_lexical_variables>,
673             C<global_variables>, C<constants>, and C<labels>.
674              
675             C<constants> are things declared via L<constant|constant> or
676             L<Readonly|Readonly>.
677              
678             use constant FOO => 193;
679             Readonly::Array my @BAR => qw< a b c >;
680              
681             C<global_variables> are anything declared using C<local>, C<our>, or
682             L<vars|vars>. C<file_lexical_variables> are variables declared at the
683             file scope.
684              
685             C<scoped_lexical_variables> are variables declared inside bare blocks
686             that are outside of any subroutines or other control structures; these
687             are usually created to limit scope of variables to a given subset of
688             subroutines. E.g.
689              
690             sub foo { ... }
691              
692             {
693             my $thingy;
694              
695             sub bar { ... $thingy ... }
696             sub baz { ... $thingy ... }
697             }
698              
699             All other variable declarations are considered
700             C<local_lexical_variables>.
701              
702             Each of the C<packages>, C<subroutines>, C<local_lexical_variables>,
703             C<scoped_lexical_variables>, C<file_lexical_variables>,
704             C<global_variables>, C<constants>, and C<labels> options can be
705             specified as one of C<:single_case>, C<:all_lower>, C<:all_upper:>,
706             C<:starts_with_lower>, C<:starts_with_upper>, or C<:no_restriction> or
707             a regular expression; any value that does not start with a colon,
708             C<:>, is considered to be a regular expression. The C<:single_case>
709             tag means a name can be all lower case or all upper case. If a
710             regular expression is specified, it is surrounded by C<\A> and C<\z>.
711              
712             C<packages> defaults to C<:starts_with_upper>. C<subroutines>,
713             C<local_lexical_variables>, C<scoped_lexical_variables>,
714             C<file_lexical_variables>, and C<global_variables> default to
715             C<:single_case>. And C<constants> and C<labels> default to
716             C<:all_upper>.
717              
718             There are corresponding C<package_exemptions>,
719             C<subroutine_exemptions>, C<local_lexical_variable_exemptions>,
720             C<scoped_lexical_variable_exemptions>,
721             C<file_lexical_variable_exemptions>, C<global_variable_exemptions>,
722             C<constant_exemptions>, and C<label_exemptions> options that are lists
723             of regular expressions to exempt from the corresponding capitalization
724             rule. These values also end up being surrounded by C<\A> and C<\z>.
725              
726             C<package_exemptions> defaults to C<main>. C<global_variable_exemptions>
727             defaults to
728             C<\$VERSION @ISA @EXPORT(?:_OK)? %EXPORT_TAGS \$AUTOLOAD %ENV %SIG \$TODO>.
729             C<subroutine_exemptions> defaults to
730             C<AUTOLOAD BUILD BUILDARGS CLEAR CLOSE DELETE DEMOLISH DESTROY EXISTS EXTEND FETCH FETCHSIZE FIRSTKEY GETC NEXTKEY POP PRINT PRINTF PUSH READ READLINE SCALAR SHIFT SPLICE STORE STORESIZE TIEARRAY TIEHANDLE TIEHASH TIESCALAR UNSHIFT UNTIE WRITE>
731             which should cover all the standard Perl subroutines plus those from
732             L<Moose|Moose>.
733              
734             For example, if you want all local variables to be in all lower-case
735             and global variables to start with "G_" and otherwise not contain
736             underscores, but exempt any variable with a name that contains
737             "THINGY", you could put the following in your F<.perlcriticrc>:
738              
739             [NamingConventions::Capitalization]
740             local_lexical_variables = :all_lower
741             global_variables = G_(?:(?!_)\w)+
742             global_variable_exemptions = .*THINGY.*
743              
744              
745             =head1 TODO
746              
747             Handle C<use vars>. Treat constant subroutines like constant
748             variables. Handle bareword file handles. There needs to be "schemes"
749             or ways of specifying "perlstyle" or "pbp". Differentiate lexical
750             L<Readonly|Readonly> constants in scopes.
751              
752              
753             =head1 BUGS
754              
755             This policy won't catch problems with the declaration of C<$y> below:
756              
757             for (my $x = 3, my $y = 5; $x < 57; $x += 3) {
758             ...
759             }
760              
761              
762             =head1 AUTHOR
763              
764             Multiple people
765              
766              
767             =head1 COPYRIGHT
768              
769             Copyright (c) 2008-2021 Michael G Schwern. All rights reserved.
770              
771             This program is free software; you can redistribute it and/or modify
772             it under the same terms as Perl itself. The full text of this license
773             can be found in the LICENSE file included with this module.
774              
775             =cut
776              
777             # Local Variables:
778             # mode: cperl
779             # cperl-indent-level: 4
780             # fill-column: 78
781             # indent-tabs-mode: nil
782             # c-indentation-style: bsd
783             # End:
784             # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :