File Coverage

blib/lib/Perl/Critic/Policy/NamingConventions/Capitalization.pm
Criterion Covered Total %
statement 167 179 93.3
branch 63 84 75.0
condition 8 13 61.5
subroutine 31 31 100.0
pod 5 6 83.3
total 274 313 87.5


line stmt bran cond sub pod time code
1             package Perl::Critic::Policy::NamingConventions::Capitalization;
2              
3 40     40   30935 use 5.010001;
  40         203  
4 40     40   299 use strict;
  40         121  
  40         859  
5 40     40   260 use warnings;
  40         114  
  40         1329  
6              
7 40     40   324 use English qw< -no_match_vars >;
  40         127  
  40         347  
8 40     40   15279 use Readonly;
  40         152  
  40         2162  
9              
10 40     40   349 use List::SomeUtils qw( any );
  40         134  
  40         2090  
11              
12 40     40   322 use Perl::Critic::Exception::AggregateConfiguration;
  40         163  
  40         2167  
13 40     40   363 use Perl::Critic::Exception::Configuration::Option::Policy::ParameterValue;
  40         178  
  40         2194  
14 40         2050 use Perl::Critic::Utils qw<
15             :booleans :characters :severities
16             hashify is_perl_global
17 40     40   353 >;
  40         146  
18 40     40   30581 use Perl::Critic::Utils::Perl qw< symbol_without_sigil >;
  40         156  
  40         2502  
19 40         1975 use Perl::Critic::Utils::PPI qw<
20             is_in_subroutine
21 40     40   322 >;
  40         132  
22 40         2311 use PPIx::Utilities::Statement qw<
23             get_constant_name_elements_from_declaring_statement
24 40     40   19833 >;
  40         38411  
25              
26 40     40   336 use parent 'Perl::Critic::Policy';
  40         143  
  40         256  
27              
28             our $VERSION = '1.148';
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 an 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 36251 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 1416 sub default_severity { return $SEVERITY_LOWEST }
204 84     84 1 351 sub default_themes { return qw< core pbp cosmetic > }
205 1131     1131 1 3661 sub applies_to { return qw< PPI::Statement PPI::Token::Label > }
206              
207             #-----------------------------------------------------------------------------
208              
209             sub initialize_if_enabled {
210 1166     1166 1 3405 my ($self, $config) = @_;
211              
212 1166         4137 my $configuration_exceptions =
213             Perl::Critic::Exception::AggregateConfiguration->new();
214              
215             KIND:
216 1166         980919 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         24139 my ($capitalization_regex, $message) =
223             $self->_derive_capitalization_test_regex_and_message(
224             $kind_of_name, $configuration_exceptions,
225             );
226 9328         117516 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       25625 next KIND if $configuration_exceptions->has_exceptions();
235              
236             $self->{"_${kind_of_name}_test"} = sub {
237 1272     1272   2589 my ($name) = @_;
238              
239 1272 100       4991 return if any { $name =~ m/$_/xms } @{$exemption_regexes};
  8036         22741  
  1272         4657  
240 997 100       8568 return $message if $name !~ m/$capitalization_regex/xms;
241 733         2565 return;
242             }
243 9328         98101 }
244              
245 1166 50       3723 if ( $configuration_exceptions->has_exceptions() ) {
246 0         0 $configuration_exceptions->throw();
247             }
248              
249 1166         32163 return $TRUE;
250             }
251              
252             sub _derive_capitalization_test_regex_and_message {
253 9328     9328   19968 my ($self, $kind_of_name, $configuration_exceptions) = @_;
254              
255 9328         20528 my $capitalization_option = "${kind_of_name}s";
256 9328         21647 my $capitalization = $self->{"_$capitalization_option"};
257              
258 9328 100       38791 if ( my $tag_properties = $CAPITALIZATION_SCHEME_TAGS{$capitalization} ) {
    50          
259 9236         64167 return @{$tag_properties}{ qw< regex regex_violation > };
  9236         37980  
260             }
261             elsif ($capitalization =~ m< \A : >xms) {
262 0         0 $configuration_exceptions->add_exception(
263             Perl::Critic::Exception::Configuration::Option::Policy::ParameterValue->new(
264             policy => $self,
265             option_name => $capitalization_option,
266             option_value => $capitalization,
267             message_suffix =>
268             'is not a known capitalization scheme tag. Valid tags are: '
269             . (join q<, >, sort keys %CAPITALIZATION_SCHEME_TAGS)
270             . $PERIOD,
271             )
272             );
273 0         0 return;
274             }
275              
276 92         947 my $regex;
277 92         592 eval { $regex = qr< \A $capitalization \z >xms; }
278 92 50       197 or do {
279 0         0 $configuration_exceptions->add_exception(
280             Perl::Critic::Exception::Configuration::Option::Policy::ParameterValue->new(
281             policy => $self,
282             option_name => $capitalization_option,
283             option_value => $capitalization,
284             message_suffix =>
285             "is not a valid regular expression: $EVAL_ERROR",
286             )
287             );
288 0         0 return;
289             };
290              
291 92         392 return $regex, qq<does not match "\\A$capitalization\\z".>;
292             }
293              
294             sub _derive_capitalization_exemption_test_regexes {
295 9328     9328   18854 my ($self, $kind_of_name, $configuration_exceptions) = @_;
296              
297 9328         19345 my $exemptions_option = "${kind_of_name}_exemptions";
298 9328         21618 my $exemptions = $self->{"_$exemptions_option"};
299              
300 9328         14831 my @regexes;
301              
302             PATTERN:
303 9328         14178 foreach my $pattern ( keys %{$exemptions} ) {
  9328         32876  
304 47530         69299 my $regex;
305 47530         410346 eval { $regex = qr< \A $pattern \z >xms; }
306 47530 50       67266 or do {
307 0         0 $configuration_exceptions->add_exception(
308             Perl::Critic::Exception::Configuration::Option::Policy::ParameterValue->new(
309             policy => $self,
310             option_name => $exemptions_option,
311             option_value => $pattern,
312             message_suffix =>
313             "is not a valid regular expression: $EVAL_ERROR",
314             )
315             );
316 0         0 next PATTERN;
317             };
318              
319 47530         113329 push @regexes, $regex;
320             }
321              
322 9328         23938 return \@regexes;
323             }
324              
325             #-----------------------------------------------------------------------------
326              
327             sub violates {
328 3002     3002 1 6461 my ( $self, $elem, undef ) = @_;
329              
330 3002 100       11792 if ( $elem->isa('PPI::Statement::Variable') ) {
331 795         3017 return $self->_variable_capitalization($elem);
332             }
333              
334 2207 100       7641 if ( $elem->isa('PPI::Statement::Sub') ) {
335 250         1027 return $self->_subroutine_capitalization($elem);
336             }
337              
338 1957 100       5711 if (
339             my @names = get_constant_name_elements_from_declaring_statement($elem)
340             ) {
341 3         11 return ( grep { $_ }
342 9         1193 map { $self->_constant_capitalization( $elem, $_ ) } @names )
  11         34  
343             }
344              
345 1948 100       78730 if ( $elem->isa('PPI::Statement::Package') ) {
346 139         668 return $self->_package_capitalization($elem);
347             }
348              
349 1809 100 100     6869 if (
350             $elem->isa('PPI::Statement::Compound') and $elem->type() eq 'foreach'
351             ) {
352 142         8331 return $self->_foreach_variable_capitalization($elem);
353             }
354              
355 1667 100       28464 if ( $elem->isa('PPI::Token::Label') ) {
356 70         358 return $self->_label_capitalization($elem);
357             }
358              
359 1597         4709 return;
360             }
361              
362             sub _variable_capitalization {
363 795     795   1901 my ($self, $elem) = @_;
364              
365 795         1729 my @violations;
366              
367             NAME:
368 795         3075 for my $name ( map { $_->symbol() } $elem->symbols() ) {
  798         27977  
369 798 100       46871 if ($elem->type() eq 'local') {
    100          
370             # Fully qualified names are exempt because we can't be responsible
371             # for other people's symbols.
372 242 100       10917 next NAME if $name =~ m/$PACKAGE_REGEX/xms;
373 206 100       1072 next NAME if is_perl_global($name);
374              
375 102         1434 push
376             @violations,
377             $self->_check_capitalization(
378             symbol_without_sigil($name),
379             $name,
380             'global_variable',
381             $elem,
382             );
383             }
384             elsif ($elem->type() eq 'our') {
385 140         9769 push
386             @violations,
387             $self->_check_capitalization(
388             symbol_without_sigil($name),
389             $name,
390             'global_variable',
391             $elem,
392             );
393             }
394             else {
395             # Got my or state
396 416         28618 my $parent = $elem->parent();
397 416 100 66     4693 if ( not $parent or $parent->isa('PPI::Document') ) {
398 133         553 push
399             @violations,
400             $self->_check_capitalization(
401             symbol_without_sigil($name),
402             $name,
403             'file_lexical_variable',
404             $elem,
405             );
406             }
407             else {
408 283 100       1588 if ( _is_directly_in_scope_block($elem) ) {
409 68         322 push
410             @violations,
411             $self->_check_capitalization(
412             symbol_without_sigil($name),
413             $name,
414             'scoped_lexical_variable',
415             $elem,
416             );
417             }
418             else {
419 215         1546 push
420             @violations,
421             $self->_check_capitalization(
422             symbol_without_sigil($name),
423             $name,
424             'local_lexical_variable',
425             $elem,
426             );
427             }
428             }
429             }
430             }
431              
432 795         4527 return @violations;
433             }
434              
435             sub _subroutine_capitalization {
436 250     250   655 my ($self, $elem) = @_;
437              
438             # These names are fixed and you've got no choice what to call them.
439 250 100       1115 return if $elem->isa('PPI::Statement::Scheduled');
440              
441 216         850 my $name = $elem->name();
442 216         14749 $name =~ s{ .* :: }{}smx; # Allow for "sub Some::Package::foo {}"
443              
444 216         789 return $self->_check_capitalization($name, $name, 'subroutine', $elem);
445             }
446              
447             sub _constant_capitalization {
448 11     11   24 my ($self, $elem, $name) = @_;
449              
450 11         35 return $self->_check_capitalization(
451             symbol_without_sigil($name), $name, 'constant', $elem,
452             );
453             }
454              
455             sub _package_capitalization {
456 139     139   388 my ($self, $elem) = @_;
457              
458 139         497 my $namespace = $elem->namespace();
459 139         4430 my @components = split m/::/xms, $namespace;
460              
461 139         373 foreach my $component (@components) {
462 177         585 my $violation =
463             $self->_check_capitalization(
464             $component, $namespace, 'package', $elem,
465             );
466 177 100       619 return $violation if $violation;
467             }
468              
469 112         569 return;
470             }
471              
472             sub _foreach_variable_capitalization {
473 142     142   393 my ($self, $elem) = @_;
474              
475 142         365 my $type;
476             my $symbol;
477 142         464 my $second_element = $elem->schild(1);
478 142 50       2485 return if not $second_element;
479              
480 142 100       718 if ($second_element->isa('PPI::Token::Word')) {
481 108         392 $type = $second_element->content();
482 108         691 $symbol = $second_element->snext_sibling();
483             } else {
484 34         169 $type = 'my';
485 34         100 $symbol = $second_element;
486             }
487              
488 142 50       3724 return if not $symbol;
489 142 50       687 return if not $symbol->isa('PPI::Token::Symbol');
490              
491 142         507 my $name = $symbol->symbol();
492              
493 142 50       16492 if ($type eq 'local') {
    100          
494             # Fully qualified names are exempt because we can't be responsible
495             # for other people's symbols.
496 0 0       0 return if $name =~ m/$PACKAGE_REGEX/xms;
497 0 0       0 return if is_perl_global($name);
498              
499 0         0 return $self->_check_capitalization(
500             symbol_without_sigil($name), $name, 'global_variable', $elem,
501             );
502             }
503             elsif ($type eq 'our') {
504 34         195 return $self->_check_capitalization(
505             symbol_without_sigil($name), $name, 'global_variable', $elem,
506             );
507             }
508              
509             # Got my or state: treat as local lexical variable
510 108         479 return $self->_check_capitalization(
511             symbol_without_sigil($name), $name, 'local_lexical_variable', $elem,
512             );
513             }
514              
515             sub _label_capitalization {
516 70     70   224 my ($self, $elem, $name) = @_;
517              
518 70 100       227 return if _is_not_real_label($elem);
519 68         1770 ( my $label = $elem->content() ) =~ s< \s* : \z ><>xms;
520 68         820 return $self->_check_capitalization($label, $label, 'label', $elem);
521             }
522              
523             sub _check_capitalization {
524 1272     1272   3777 my ($self, $to_match, $full_name, $name_type, $elem) = @_;
525              
526 1272         4107 my $test = $self->{"_${name_type}_test"};
527 1272 100       3585 if ( my $message = $test->($to_match) ) {
528 264         1699 return $self->violation(
529             qq<$NAME_FOR_TYPE{$name_type} "$full_name" $message>,
530             $EXPL,
531             $elem,
532             );
533             }
534              
535 1008         3909 return;
536             }
537              
538              
539             # { my $x } parses as
540             # PPI::Document
541             # PPI::Statement::Compound
542             # PPI::Structure::Block { ... }
543             # PPI::Statement::Variable
544             # PPI::Token::Word 'my'
545             # PPI::Token::Symbol '$x'
546             # PPI::Token::Structure ';'
547             #
548             # Also, type() on the PPI::Statement::Compound returns "continue". *sigh*
549             #
550             # The parameter is expected to be the PPI::Statement::Variable.
551             sub _is_directly_in_scope_block {
552 283     283   850 my ($elem) = @_;
553              
554              
555 283 100       1371 return if is_in_subroutine($elem);
556              
557 145         500 my $parent = $elem->parent();
558 145 100       862 return if not $parent->isa('PPI::Structure::Block');
559              
560 77         196 my $grand_parent = $parent->parent();
561 77 50       460 return $TRUE if not $grand_parent;
562 77 50       385 return $TRUE if $grand_parent->isa('PPI::Document');
563              
564 77 50       329 return if not $grand_parent->isa('PPI::Statement::Compound');
565              
566 77         267 my $type = $grand_parent->type();
567 77 50       5594 return if not $type;
568 77 100       286 return if $type ne 'continue';
569              
570 68         203 my $great_grand_parent = $grand_parent->parent();
571             return if
572 68 50 33     697 $great_grand_parent and not $great_grand_parent->isa('PPI::Document');
573              
574             # Make sure we aren't really in a continue block.
575 68         273 my $prior_to_grand_parent = $grand_parent->sprevious_sibling();
576 68 50       2335 return $TRUE if not $prior_to_grand_parent;
577 0 0       0 return $TRUE if not $prior_to_grand_parent->isa('PPI::Token::Word');
578 0         0 return $prior_to_grand_parent->content() ne 'continue';
579             }
580              
581             sub _is_not_real_label {
582 70     70   152 my $elem = shift;
583              
584             # PPI misparses part of a ternary expression as a label
585             # when the token to the left of the ":" is a bareword.
586             # See http://rt.cpan.org/Ticket/Display.html?id=41170
587             # For example...
588             #
589             # $foo = $condition ? undef : 1;
590             #
591             # PPI thinks that "undef" is a label. To workaround this,
592             # I'm going to check that whatever PPI thinks is the label,
593             # actually is the first token in the statement. I believe
594             # this should be true for all real labels.
595              
596 70   50     287 my $stmnt = $elem->statement() || return;
597 70   50     1674 my $first_child = $stmnt->schild(0) || return;
598 70         1222 return $first_child ne $elem;
599             }
600              
601             1;
602              
603             __END__
604              
605             #-----------------------------------------------------------------------------
606              
607             =pod
608              
609             =for stopwords pbp perlstyle Schwern THINGY
610              
611             =head1 NAME
612              
613             Perl::Critic::Policy::NamingConventions::Capitalization - Distinguish different program components by case.
614              
615              
616             =head1 AFFILIATION
617              
618             This Policy is part of the core L<Perl::Critic|Perl::Critic> distribution.
619              
620              
621             =head1 DESCRIPTION
622              
623             Conway recommends to distinguish different program components by case.
624              
625             Normal subroutines, methods and variables are all in lower case.
626              
627             my $foo; # ok
628             my $foo_bar; # ok
629             sub foo {} # ok
630             sub foo_bar {} # ok
631              
632             my $Foo; # not ok
633             my $foo_Bar; # not ok
634             sub Foo {} # not ok
635             sub foo_Bar {} # not ok
636              
637             Package and class names are capitalized.
638              
639             package IO::Thing; # ok
640             package Web::FooBar # ok
641              
642             package foo; # not ok
643             package foo::Bar; # not ok
644              
645             Constants are in all-caps.
646              
647             Readonly::Scalar my $FOO = 42; # ok
648              
649             Readonly::Scalar my $foo = 42; # not ok
650              
651             There are other opinions on the specifics, for example, in
652             L<perlstyle|perlstyle>. This
653             policy can be configured to match almost any style that you can think of.
654              
655              
656             =head1 CONFIGURATION
657              
658             You can specify capitalization rules for the following things:
659             C<packages>, C<subroutines>, C<local_lexical_variables>,
660             C<scoped_lexical_variables>, C<file_lexical_variables>,
661             C<global_variables>, C<constants>, and C<labels>.
662              
663             C<constants> are things declared via L<constant|constant> or
664             L<Readonly|Readonly>.
665              
666             use constant FOO => 193;
667             Readonly::Array my @BAR => qw< a b c >;
668              
669             C<global_variables> are anything declared using C<local>, C<our>, or
670             L<vars|vars>. C<file_lexical_variables> are variables declared at the
671             file scope.
672              
673             C<scoped_lexical_variables> are variables declared inside bare blocks
674             that are outside of any subroutines or other control structures; these
675             are usually created to limit scope of variables to a given subset of
676             subroutines. E.g.
677              
678             sub foo { ... }
679              
680             {
681             my $thingy;
682              
683             sub bar { ... $thingy ... }
684             sub baz { ... $thingy ... }
685             }
686              
687             All other variable declarations are considered
688             C<local_lexical_variables>.
689              
690             Each of the C<packages>, C<subroutines>, C<local_lexical_variables>,
691             C<scoped_lexical_variables>, C<file_lexical_variables>,
692             C<global_variables>, C<constants>, and C<labels> options can be
693             specified as one of C<:single_case>, C<:all_lower>, C<:all_upper:>,
694             C<:starts_with_lower>, C<:starts_with_upper>, or C<:no_restriction> or
695             a regular expression; any value that does not start with a colon,
696             C<:>, is considered to be a regular expression. The C<:single_case>
697             tag means a name can be all lower case or all upper case. If a
698             regular expression is specified, it is surrounded by C<\A> and C<\z>.
699              
700             C<packages> defaults to C<:starts_with_upper>. C<subroutines>,
701             C<local_lexical_variables>, C<scoped_lexical_variables>,
702             C<file_lexical_variables>, and C<global_variables> default to
703             C<:single_case>. And C<constants> and C<labels> default to
704             C<:all_upper>.
705              
706             There are corresponding C<package_exemptions>,
707             C<subroutine_exemptions>, C<local_lexical_variable_exemptions>,
708             C<scoped_lexical_variable_exemptions>,
709             C<file_lexical_variable_exemptions>, C<global_variable_exemptions>,
710             C<constant_exemptions>, and C<label_exemptions> options that are lists
711             of regular expressions to exempt from the corresponding capitalization
712             rule. These values also end up being surrounded by C<\A> and C<\z>.
713              
714             C<package_exemptions> defaults to C<main>. C<global_variable_exemptions>
715             defaults to
716             C<\$VERSION @ISA @EXPORT(?:_OK)? %EXPORT_TAGS \$AUTOLOAD %ENV %SIG \$TODO>.
717             C<subroutine_exemptions> defaults to
718             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>
719             which should cover all the standard Perl subroutines plus those from
720             L<Moose|Moose>.
721              
722             For example, if you want all local variables to be in all lower-case
723             and global variables to start with "G_" and otherwise not contain
724             underscores, but exempt any variable with a name that contains
725             "THINGY", you could put the following in your F<.perlcriticrc>:
726              
727             [NamingConventions::Capitalization]
728             local_lexical_variables = :all_lower
729             global_variables = G_(?:(?!_)\w)+
730             global_variable_exemptions = .*THINGY.*
731              
732              
733             =head1 TODO
734              
735             Handle C<use vars>. Treat constant subroutines like constant
736             variables. Handle bareword file handles. There needs to be "schemes"
737             or ways of specifying "perlstyle" or "pbp". Differentiate lexical
738             L<Readonly|Readonly> constants in scopes.
739              
740              
741             =head1 BUGS
742              
743             This policy won't catch problems with the declaration of C<$y> below:
744              
745             for (my $x = 3, my $y = 5; $x < 57; $x += 3) {
746             ...
747             }
748              
749              
750             =head1 AUTHOR
751              
752             Multiple people
753              
754              
755             =head1 COPYRIGHT
756              
757             Copyright (c) 2008-2023 Michael G Schwern.
758              
759             This program is free software; you can redistribute it and/or modify
760             it under the same terms as Perl itself. The full text of this license
761             can be found in the LICENSE file included with this module.
762              
763             =cut
764              
765             # Local Variables:
766             # mode: cperl
767             # cperl-indent-level: 4
768             # fill-column: 78
769             # indent-tabs-mode: nil
770             # c-indentation-style: bsd
771             # End:
772             # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :