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   30275 use 5.010001;
  40         209  
4 40     40   273 use strict;
  40         131  
  40         846  
5 40     40   262 use warnings;
  40         115  
  40         1213  
6              
7 40     40   322 use English qw< -no_match_vars >;
  40         154  
  40         295  
8 40     40   15125 use Readonly;
  40         138  
  40         2397  
9              
10 40     40   323 use List::SomeUtils qw( any );
  40         122  
  40         2103  
11              
12 40     40   340 use Perl::Critic::Exception::AggregateConfiguration;
  40         126  
  40         2058  
13 40     40   349 use Perl::Critic::Exception::Configuration::Option::Policy::ParameterValue;
  40         109  
  40         2238  
14 40     40   330 use Perl::Critic::Utils qw( :booleans :characters :severities is_perl_global );
  40         121  
  40         2125  
15 40     40   30607 use Perl::Critic::Utils::Perl qw< symbol_without_sigil >;
  40         152  
  40         2515  
16 40         2051 use Perl::Critic::Utils::PPI qw<
17             is_in_subroutine
18 40     40   396 >;
  40         108  
19 40         2662 use PPIx::Utils::Traversal qw<
20             get_constant_name_elements_from_declaring_statement
21 40     40   20687 >;
  40         164979  
22              
23 40     40   386 use parent 'Perl::Critic::Policy';
  40         124  
  40         422  
24              
25             our $VERSION = '1.150';
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 105     105 0 5677 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 74     74 1 350 sub default_severity { return $SEVERITY_LOWEST }
199 84     84 1 361 sub default_themes { return qw< core pbp cosmetic > }
200 30     30 1 91 sub applies_to { return qw< PPI::Statement PPI::Token::Label > }
201              
202             #-----------------------------------------------------------------------------
203              
204             sub initialize_if_enabled {
205 65     65 1 203 my ($self, $config) = @_;
206              
207 65         382 my $configuration_exceptions =
208             Perl::Critic::Exception::AggregateConfiguration->new();
209              
210             KIND:
211 65         59872 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 520         1389 my ($capitalization_regex, $message) =
218             $self->_derive_capitalization_test_regex_and_message(
219             $kind_of_name, $configuration_exceptions,
220             );
221 520         6670 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 520 50       1445 next KIND if $configuration_exceptions->has_exceptions();
230              
231             $self->{"_${kind_of_name}_test"} = sub {
232 124     124   227 my ($name) = @_;
233              
234 124 50       425 return if any { $name =~ m/$_/xms } @{$exemption_regexes};
  409         1194  
  124         371  
235 124 50       934 return $message if $name !~ m/$capitalization_regex/xms;
236 124         293 return;
237 520         5826 };
238             }
239              
240 65 50       296 if ( $configuration_exceptions->has_exceptions() ) {
241 0         0 $configuration_exceptions->throw();
242             }
243              
244 65         1754 return $TRUE;
245             }
246              
247             sub _derive_capitalization_test_regex_and_message {
248 520     520   1087 my ($self, $kind_of_name, $configuration_exceptions) = @_;
249              
250 520         1114 my $capitalization_option = "${kind_of_name}s";
251 520         1530 my $capitalization = $self->{"_$capitalization_option"};
252              
253 520 50       2212 if ( my $tag_properties = $CAPITALIZATION_SCHEME_TAGS{$capitalization} ) {
    0          
254 520         3420 return @{$tag_properties}{ qw< regex regex_violation > };
  520         2543  
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 520     520   977 my ($self, $kind_of_name, $configuration_exceptions) = @_;
291              
292 520         1002 my $exemptions_option = "${kind_of_name}_exemptions";
293 520         1581 my $exemptions = $self->{"_$exemptions_option"};
294              
295 520         798 my @regexes;
296              
297             PATTERN:
298 520         798 foreach my $pattern ( keys %{$exemptions} ) {
  520         2570  
299 2730         3754 my $regex;
300 2730         28940 eval { $regex = qr< \A $pattern \z >xms; }
301 2730 50       3700 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 2730         6202 push @regexes, $regex;
315             }
316              
317 520         1418 return \@regexes;
318             }
319              
320             #-----------------------------------------------------------------------------
321              
322             sub violates {
323 281     281 1 549 my ( $self, $elem, undef ) = @_;
324              
325 281 100       876 if ( $elem->isa('PPI::Statement::Variable') ) {
326 85         258 return $self->_variable_capitalization($elem);
327             }
328              
329 196 100       539 if ( $elem->isa('PPI::Statement::Sub') ) {
330 5         41 return $self->_subroutine_capitalization($elem);
331             }
332              
333 191 50       460 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 191 100       7484 if ( $elem->isa('PPI::Statement::Package') ) {
341 28         145 return $self->_package_capitalization($elem);
342             }
343              
344 163 100 100     540 if (
345             $elem->isa('PPI::Statement::Compound') and $elem->type() eq 'foreach'
346             ) {
347 6         331 return $self->_foreach_variable_capitalization($elem);
348             }
349              
350 157 50       728 if ( $elem->isa('PPI::Token::Label') ) {
351 0         0 return $self->_label_capitalization($elem);
352             }
353              
354 157         364 return;
355             }
356              
357             sub _variable_capitalization {
358 85     85   162 my ($self, $elem) = @_;
359              
360 85         123 my @violations;
361              
362             NAME:
363 85         225 for my $name ( map { $_->symbol() } $elem->symbols() ) {
  85         2490  
364 85 50       3756 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         1828 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         3127 my $parent = $elem->parent();
392 58 100 66     469 if ( not $parent or $parent->isa('PPI::Document') ) {
393 48         150 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       29 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         29 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         272 return @violations;
428             }
429              
430             sub _subroutine_capitalization {
431 5     5   19 my ($self, $elem) = @_;
432              
433             # These names are fixed and you've got no choice what to call them.
434 5 50       28 return if $elem->isa('PPI::Statement::Scheduled');
435              
436 5         19 my $name = $elem->name();
437 5         249 $name =~ s{ .* :: }{}smx; # Allow for "sub Some::Package::foo {}"
438              
439 5         15 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   103 my ($self, $elem) = @_;
452              
453 28         87 my $namespace = $elem->namespace();
454 28         717 my @components = split m/::/xms, $namespace;
455              
456 28         75 foreach my $component (@components) {
457 28         159 my $violation =
458             $self->_check_capitalization(
459             $component, $namespace, 'package', $elem,
460             );
461 28 50       114 return $violation if $violation;
462             }
463              
464 28         116 return;
465             }
466              
467             sub _foreach_variable_capitalization {
468 6     6   15 my ($self, $elem) = @_;
469              
470 6         15 my $type;
471             my $symbol;
472 6         20 my $second_element = $elem->schild(1);
473 6 50       101 return if not $second_element;
474              
475 6 50       27 if ($second_element->isa('PPI::Token::Word')) {
476 6         18 $type = $second_element->content();
477 6         36 $symbol = $second_element->snext_sibling();
478             } else {
479 0         0 $type = 'my';
480 0         0 $symbol = $second_element;
481             }
482              
483 6 50       146 return if not $symbol;
484 6 50       23 return if not $symbol->isa('PPI::Token::Symbol');
485              
486 6         20 my $name = $symbol->symbol();
487              
488 6 50       672 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         29 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, $name) = @_;
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   349 my ($self, $to_match, $full_name, $name_type, $elem) = @_;
520              
521 124         347 my $test = $self->{"_${name_type}_test"};
522 124 50       328 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         314 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   17 my ($elem) = @_;
548              
549              
550 10 100       32 return if is_in_subroutine($elem);
551              
552 8         17 my $parent = $elem->parent();
553 8 50       34 return if not $parent->isa('PPI::Structure::Block');
554              
555 8         11 my $grand_parent = $parent->parent();
556 8 50       39 return $TRUE if not $grand_parent;
557 8 50       24 return $TRUE if $grand_parent->isa('PPI::Document');
558              
559 8 50       20 return if not $grand_parent->isa('PPI::Statement::Compound');
560              
561 8         19 my $type = $grand_parent->type();
562 8 50       276 return if not $type;
563 8 50       24 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              
651             =head1 CONFIGURATION
652              
653             You can specify capitalization rules for the following things:
654             C<packages>, C<subroutines>, C<local_lexical_variables>,
655             C<scoped_lexical_variables>, C<file_lexical_variables>,
656             C<global_variables>, C<constants>, and C<labels>.
657              
658             C<constants> are things declared via L<constant|constant> or
659             L<Readonly|Readonly>.
660              
661             use constant FOO => 193;
662             Readonly::Array my @BAR => qw< a b c >;
663              
664             C<global_variables> are anything declared using C<local>, C<our>, or
665             L<vars|vars>. C<file_lexical_variables> are variables declared at the
666             file scope.
667              
668             C<scoped_lexical_variables> are variables declared inside bare blocks
669             that are outside of any subroutines or other control structures; these
670             are usually created to limit scope of variables to a given subset of
671             subroutines. E.g.
672              
673             sub foo { ... }
674              
675             {
676             my $thingy;
677              
678             sub bar { ... $thingy ... }
679             sub baz { ... $thingy ... }
680             }
681              
682             All other variable declarations are considered
683             C<local_lexical_variables>.
684              
685             Each of the C<packages>, C<subroutines>, C<local_lexical_variables>,
686             C<scoped_lexical_variables>, C<file_lexical_variables>,
687             C<global_variables>, C<constants>, and C<labels> options can be
688             specified as one of C<:single_case>, C<:all_lower>, C<:all_upper:>,
689             C<:starts_with_lower>, C<:starts_with_upper>, or C<:no_restriction> or
690             a regular expression; any value that does not start with a colon,
691             C<:>, is considered to be a regular expression. The C<:single_case>
692             tag means a name can be all lower case or all upper case. If a
693             regular expression is specified, it is surrounded by C<\A> and C<\z>.
694              
695             C<packages> defaults to C<:starts_with_upper>. C<subroutines>,
696             C<local_lexical_variables>, C<scoped_lexical_variables>,
697             C<file_lexical_variables>, and C<global_variables> default to
698             C<:single_case>. And C<constants> and C<labels> default to
699             C<:all_upper>.
700              
701             There are corresponding C<package_exemptions>,
702             C<subroutine_exemptions>, C<local_lexical_variable_exemptions>,
703             C<scoped_lexical_variable_exemptions>,
704             C<file_lexical_variable_exemptions>, C<global_variable_exemptions>,
705             C<constant_exemptions>, and C<label_exemptions> options that are lists
706             of regular expressions to exempt from the corresponding capitalization
707             rule. These values also end up being surrounded by C<\A> and C<\z>.
708              
709             C<package_exemptions> defaults to C<main>. C<global_variable_exemptions>
710             defaults to
711             C<\$VERSION @ISA @EXPORT(?:_OK)? %EXPORT_TAGS \$AUTOLOAD %ENV %SIG \$TODO>.
712             C<subroutine_exemptions> defaults to
713             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>
714             which should cover all the standard Perl subroutines plus those from
715             L<Moose|Moose>.
716              
717             For example, if you want all local variables to be in all lower-case
718             and global variables to start with "G_" and otherwise not contain
719             underscores, but exempt any variable with a name that contains
720             "THINGY", you could put the following in your F<.perlcriticrc>:
721              
722             [NamingConventions::Capitalization]
723             local_lexical_variables = :all_lower
724             global_variables = G_(?:(?!_)\w)+
725             global_variable_exemptions = .*THINGY.*
726              
727              
728             =head1 TODO
729              
730             Handle C<use vars>. Treat constant subroutines like constant
731             variables. Handle bareword file handles. There needs to be "schemes"
732             or ways of specifying "perlstyle" or "pbp". Differentiate lexical
733             L<Readonly|Readonly> constants in scopes.
734              
735              
736             =head1 BUGS
737              
738             This policy won't catch problems with the declaration of C<$y> below:
739              
740             for (my $x = 3, my $y = 5; $x < 57; $x += 3) {
741             ...
742             }
743              
744              
745             =head1 AUTHOR
746              
747             Multiple people
748              
749              
750             =head1 COPYRIGHT
751              
752             Copyright (c) 2008-2023 Michael G Schwern.
753              
754             This program is free software; you can redistribute it and/or modify
755             it under the same terms as Perl itself. The full text of this license
756             can be found in the LICENSE file included with this module.
757              
758             =cut
759              
760             # Local Variables:
761             # mode: cperl
762             # cperl-indent-level: 4
763             # fill-column: 78
764             # indent-tabs-mode: nil
765             # c-indentation-style: bsd
766             # End:
767             # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :