File Coverage

blib/lib/Perl/Critic/Policy/NamingConventions/Capitalization.pm
Criterion Covered Total %
statement 137 179 76.5
branch 39 84 46.4
condition 5 13 38.4
subroutine 28 31 90.3
pod 5 6 83.3
total 214 313 68.3


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