Login
RT #79289: False Postive in Perl::Critic::Utils::is_in_void_context()
[gknop/Perl-Critic.git] / lib / Perl / Critic / Utils.pm
CommitLineData
6036a254 1##############################################################################
39cd321a
JRT
2# $URL$
3# $Date$
4# $Author$
5# $Revision$
6036a254 6##############################################################################
39cd321a 7
9f12283e
ES
8# NOTE: This module is way too large. Please think about adding new
9# functionality into a P::C::Utils::* module instead.
10
59b05e08
JRT
11package Perl::Critic::Utils;
12
df6dee2b 13use 5.006001;
59b05e08
JRT
14use strict;
15use warnings;
c680a9c9 16use Readonly;
c948abe5 17
0fc740da
JRT
18use Carp qw( confess );
19use English qw(-no_match_vars);
410cf90b 20use File::Spec qw();
c948abe5 21use Scalar::Util qw( blessed );
e2d4c0f0 22use B::Keywords qw();
cbb58756 23use PPI::Token::Quote::Single;
c948abe5 24
4b1bd955 25use Perl::Critic::Exception::Fatal::Generic qw{ throw_generic };
329eea9a
ES
26use Perl::Critic::Utils::PPI qw< is_ppi_expression_or_generic_statement >;
27
5c601ed5 28use Exporter 'import';
59b05e08 29
8bb7c398 30our $VERSION = '1.118';
59b05e08 31
6036a254 32#-----------------------------------------------------------------------------
bbf4108c 33# Exportable symbols here.
1fe8e187 34
c680a9c9 35Readonly::Array our @EXPORT_OK => qw(
dc93df4f
JRT
36 $TRUE
37 $FALSE
38
e2d4c0f0
JRT
39 $POLICY_NAMESPACE
40
dc93df4f
JRT
41 $SEVERITY_HIGHEST
42 $SEVERITY_HIGH
43 $SEVERITY_MEDIUM
44 $SEVERITY_LOW
45 $SEVERITY_LOWEST
0bcb38c0 46 @SEVERITY_NAMES
dc93df4f 47
738830ba
ES
48 $DEFAULT_VERBOSITY
49 $DEFAULT_VERBOSITY_WITH_FILE_NAME
50
dc93df4f
JRT
51 $COLON
52 $COMMA
53 $DQUOTE
54 $EMPTY
196ecfa2 55 $EQUAL
dc93df4f
JRT
56 $FATCOMMA
57 $PERIOD
58 $PIPE
59 $QUOTE
68a933bc 60 $BACKTICK
dc93df4f
JRT
61 $SCOLON
62 $SPACE
a609ec83
ES
63 $SLASH
64 $BSLASH
310e7cf9
ES
65 $LEFT_PAREN
66 $RIGHT_PAREN
6f31806e 67
70f3f307
ES
68 all_perl_files
69 find_keywords
70 first_arg
71 hashify
72 interpolate
73 is_class_name
74 is_function_call
75 is_hash_key
76 is_in_void_context
77 is_included_module_name
78 is_integer
79 is_label_pointer
80 is_method_call
81 is_package_declaration
82 is_perl_bareword
83 is_perl_builtin
84 is_perl_builtin_with_list_context
85 is_perl_builtin_with_multiple_arguments
86 is_perl_builtin_with_no_arguments
87 is_perl_builtin_with_one_argument
88 is_perl_builtin_with_optional_argument
89 is_perl_builtin_with_zero_and_or_one_arguments
90 is_perl_filehandle
91 is_perl_global
92 is_qualified_name
93 is_script
94 is_subroutine_name
95 is_unchecked_call
96 is_valid_numeric_verbosity
97 parse_arg_list
98 policy_long_name
99 policy_short_name
100 precedence_of
101 severity_to_number
102 shebang_line
103 split_nodes_on_comma
104 verbosity_to_format
105 words_from_string
bbf4108c
ES
106);
107
7cb05702 108
d5835ca8
JRT
109# Note: this is deprecated. This should also violate ProhibitAutomaticExportation,
110# but at the moment, we aren't smart enough to deal with Readonly variables.
111Readonly::Array our @EXPORT => @EXPORT_OK;
7cb05702 112
5feaec1d 113
c680a9c9 114Readonly::Hash our %EXPORT_TAGS => (
bbf4108c
ES
115 all => [ @EXPORT_OK ],
116 booleans => [ qw{ $TRUE $FALSE } ],
117 severities => [
118 qw{
119 $SEVERITY_HIGHEST
120 $SEVERITY_HIGH
121 $SEVERITY_MEDIUM
122 $SEVERITY_LOW
123 $SEVERITY_LOWEST
124 @SEVERITY_NAMES
125 }
126 ],
127 characters => [
128 qw{
129 $COLON
130 $COMMA
131 $DQUOTE
132 $EMPTY
196ecfa2 133 $EQUAL
bbf4108c
ES
134 $FATCOMMA
135 $PERIOD
136 $PIPE
137 $QUOTE
68a933bc 138 $BACKTICK
bbf4108c
ES
139 $SCOLON
140 $SPACE
141 $SLASH
142 $BSLASH
310e7cf9
ES
143 $LEFT_PAREN
144 $RIGHT_PAREN
bbf4108c
ES
145 }
146 ],
147 classification => [
148 qw{
70f3f307
ES
149 is_class_name
150 is_function_call
151 is_hash_key
152 is_included_module_name
153 is_integer
154 is_label_pointer
155 is_method_call
156 is_package_declaration
157 is_perl_bareword
158 is_perl_builtin
159 is_perl_filehandle
160 is_perl_global
161 is_perl_builtin_with_list_context
162 is_perl_builtin_with_multiple_arguments
163 is_perl_builtin_with_no_arguments
164 is_perl_builtin_with_one_argument
165 is_perl_builtin_with_optional_argument
166 is_perl_builtin_with_zero_and_or_one_arguments
167 is_qualified_name
168 is_script
169 is_subroutine_name
170 is_unchecked_call
171 is_valid_numeric_verbosity
bbf4108c
ES
172 }
173 ],
70f3f307
ES
174 data_conversion => [ qw{ hashify words_from_string interpolate } ],
175 ppi => [ qw{ first_arg parse_arg_list } ],
176 internal_lookup => [ qw{ severity_to_number verbosity_to_format } ],
177 language => [ qw{ precedence_of } ],
178 deprecated => [ qw{ find_keywords } ],
59b05e08
JRT
179);
180
6036a254 181#-----------------------------------------------------------------------------
59b05e08 182
c680a9c9 183Readonly::Scalar our $POLICY_NAMESPACE => 'Perl::Critic::Policy';
1fe8e187 184
6036a254 185#-----------------------------------------------------------------------------
1fe8e187 186
c680a9c9
ES
187Readonly::Scalar our $SEVERITY_HIGHEST => 5;
188Readonly::Scalar our $SEVERITY_HIGH => 4;
189Readonly::Scalar our $SEVERITY_MEDIUM => 3;
190Readonly::Scalar our $SEVERITY_LOW => 2;
191Readonly::Scalar our $SEVERITY_LOWEST => 1;
dff08b70 192
6036a254 193#-----------------------------------------------------------------------------
6b4a61e9 194
c680a9c9 195Readonly::Scalar our $COMMA => q{,};
196ecfa2 196Readonly::Scalar our $EQUAL => q{=};
c680a9c9
ES
197Readonly::Scalar our $FATCOMMA => q{=>};
198Readonly::Scalar our $COLON => q{:};
199Readonly::Scalar our $SCOLON => q{;};
200Readonly::Scalar our $QUOTE => q{'};
201Readonly::Scalar our $DQUOTE => q{"};
202Readonly::Scalar our $BACKTICK => q{`};
203Readonly::Scalar our $PERIOD => q{.};
204Readonly::Scalar our $PIPE => q{|};
205Readonly::Scalar our $SPACE => q{ };
206Readonly::Scalar our $SLASH => q{/};
207Readonly::Scalar our $BSLASH => q{\\};
208Readonly::Scalar our $LEFT_PAREN => q{(};
209Readonly::Scalar our $RIGHT_PAREN => q{)};
210Readonly::Scalar our $EMPTY => q{};
211Readonly::Scalar our $TRUE => 1;
212Readonly::Scalar our $FALSE => 0;
59b05e08 213
6036a254 214#-----------------------------------------------------------------------------
6b4a61e9 215
8d6b89b3
JRT
216#TODO: Should this include punctuations vars?
217
59b05e08 218
8d6b89b3 219
6036a254 220#-----------------------------------------------------------------------------
dc93df4f 221## no critic (ProhibitNoisyQuotes);
57973330 222
c680a9c9 223Readonly::Hash my %PRECEDENCE_OF => (
99d1720a
JRT
224 '->' => 1,
225 '++' => 2,
226 '--' => 2,
227 '**' => 3,
228 '!' => 4,
229 '~' => 4,
230 '\\' => 4,
231 '=~' => 5,
232 '!~' => 5,
233 '*' => 6,
234 '/' => 6,
235 '%' => 6,
236 'x' => 6,
237 '+' => 7,
238 '-' => 7,
239 '.' => 7,
240 '<<' => 8,
241 '>>' => 8,
7a527aba
JRT
242 '-R' => 9,
243 '-W' => 9,
244 '-X' => 9,
245 '-r' => 9,
246 '-w' => 9,
247 '-x' => 9,
248 '-e' => 9,
249 '-O' => 9,
250 '-o' => 9,
251 '-z' => 9,
252 '-s' => 9,
253 '-M' => 9,
254 '-A' => 9,
255 '-C' => 9,
256 '-S' => 9,
257 '-c' => 9,
258 '-b' => 9,
259 '-f' => 9,
260 '-d' => 9,
261 '-p' => 9,
262 '-l' => 9,
263 '-u' => 9,
264 '-g' => 9,
265 '-k' => 9,
266 '-t' => 9,
267 '-T' => 9,
268 '-B' => 9,
99d1720a
JRT
269 '<' => 10,
270 '>' => 10,
271 '<=' => 10,
272 '>=' => 10,
273 'lt' => 10,
274 'gt' => 10,
275 'le' => 10,
276 'ge' => 10,
277 '==' => 11,
278 '!=' => 11,
279 '<=>' => 11,
280 'eq' => 11,
281 'ne' => 11,
282 'cmp' => 11,
514b51ad 283 '~~' => 11,
99d1720a
JRT
284 '&' => 12,
285 '|' => 13,
286 '^' => 13,
287 '&&' => 14,
288 '//' => 15,
289 '||' => 15,
290 '..' => 16,
291 '...' => 17,
292 '?' => 18,
293 ':' => 18,
294 '=' => 19,
295 '+=' => 19,
296 '-=' => 19,
297 '*=' => 19,
298 '/=' => 19,
299 '%=' => 19,
300 '||=' => 19,
301 '&&=' => 19,
302 '|=' => 19,
303 '&=' => 19,
304 '**=' => 19,
305 'x=' => 19,
306 '.=' => 19,
307 '^=' => 19,
308 '<<=' => 19,
309 '>>=' => 19,
0c009758 310 '//=' => 19,
99d1720a
JRT
311 ',' => 20,
312 '=>' => 20,
313 'not' => 22,
314 'and' => 23,
315 'or' => 24,
316 'xor' => 24,
8d6b89b3
JRT
317);
318
57973330 319## use critic
c927e488
ES
320
321Readonly::Scalar my $MIN_PRECEDENCE_TO_TERMINATE_PARENLESS_ARG_LIST =>
322 precedence_of( 'not' );
323
7b84ff16 324#-----------------------------------------------------------------------------
8d6b89b3 325
c0631e45 326sub hashify { ## no critic (ArgUnpacking)
3ffdaa3b
AL
327 return map { $_ => 1 } @_;
328}
329
7b84ff16
JRT
330#-----------------------------------------------------------------------------
331
332sub interpolate {
333 my ( $literal ) = @_;
0fc740da 334 return eval "\"$literal\"" or confess $EVAL_ERROR; ## no critic (StringyEval);
7b84ff16
JRT
335}
336
337#-----------------------------------------------------------------------------
3ffdaa3b 338
59b05e08
JRT
339sub find_keywords {
340 my ( $doc, $keyword ) = @_;
45acb16b
CD
341 my $nodes_ref = $doc->find('PPI::Token::Word');
342 return if !$nodes_ref;
59b05e08
JRT
343 my @matches = grep { $_ eq $keyword } @{$nodes_ref};
344 return @matches ? \@matches : undef;
345}
346
7b84ff16 347#-----------------------------------------------------------------------------
c948abe5
ES
348
349sub _name_for_sub_or_stringified_element {
350 my $elem = shift;
351
352 if ( blessed $elem and $elem->isa('PPI::Statement::Sub') ) {
353 return $elem->name();
354 }
355
356 return "$elem";
357}
358
359#-----------------------------------------------------------------------------
207c8eb0 360## no critic (ProhibitPackageVars)
dff08b70 361
c680a9c9 362Readonly::Hash my %BUILTINS => hashify( @B::Keywords::Functions );
e2d4c0f0 363
8d6b89b3 364sub is_perl_builtin {
45acb16b
CD
365 my $elem = shift;
366 return if !$elem;
c948abe5
ES
367
368 return exists $BUILTINS{ _name_for_sub_or_stringified_element($elem) };
8d6b89b3 369}
36f7994c 370
7b84ff16 371#-----------------------------------------------------------------------------
8d6b89b3 372
c680a9c9 373Readonly::Hash my %BAREWORDS => hashify( @B::Keywords::Barewords );
3ca95ec9
JRT
374
375sub is_perl_bareword {
376 my $elem = shift;
377 return if !$elem;
378
379 return exists $BAREWORDS{ _name_for_sub_or_stringified_element($elem) };
380}
381
382#-----------------------------------------------------------------------------
383
093d3a00 384sub _build_globals_without_sigils {
e2877dc2 385 # B::Keywords as of 1.08 forgot $\
4476b7a7
ES
386 my @globals =
387 map { substr $_, 1 }
388 @B::Keywords::Arrays,
389 @B::Keywords::Hashes,
390 @B::Keywords::Scalars,
391 '$\\'; ## no critic (RequireInterpolationOfMetachars)
093d3a00
ES
392
393 # Not all of these have sigils
394 foreach my $filehandle (@B::Keywords::Filehandles) {
395 (my $stripped = $filehandle) =~ s< \A [*] ><>xms;
396 push @globals, $stripped;
397 }
398
399 return @globals;
400}
401
402Readonly::Array my @GLOBALS_WITHOUT_SIGILS => _build_globals_without_sigils();
e2d4c0f0 403
c680a9c9 404Readonly::Hash my %GLOBALS => hashify( @GLOBALS_WITHOUT_SIGILS );
e2d4c0f0 405
8d6b89b3 406sub is_perl_global {
45acb16b
CD
407 my $elem = shift;
408 return if !$elem;
3c71d40c 409 my $var_name = "$elem"; #Convert Token::Symbol to string
f135623f 410 $var_name =~ s{\A [\$@%*] }{}xms; #Chop off the sigil
3c71d40c 411 return exists $GLOBALS{ $var_name };
8d6b89b3
JRT
412}
413
2c30044d
JRT
414#-----------------------------------------------------------------------------
415
c680a9c9 416Readonly::Hash my %FILEHANDLES => hashify( @B::Keywords::Filehandles );
2c30044d
JRT
417
418sub is_perl_filehandle {
419 my $elem = shift;
420 return if !$elem;
421
422 return exists $FILEHANDLES{ _name_for_sub_or_stringified_element($elem) };
423}
424
207c8eb0 425## use critic
7b84ff16 426#-----------------------------------------------------------------------------
8d6b89b3 427
c948abe5 428# egrep '=item.*LIST' perlfunc.pod
c680a9c9 429Readonly::Hash my %BUILTINS_WHICH_PROVIDE_LIST_CONTEXT =>
c948abe5
ES
430 hashify(
431 qw{
432 chmod
433 chown
434 die
435 exec
436 formline
437 grep
438 import
439 join
440 kill
441 map
442 no
443 open
444 pack
445 print
446 printf
447 push
448 reverse
19d26f4f 449 say
c948abe5
ES
450 sort
451 splice
452 sprintf
453 syscall
454 system
455 tie
456 unlink
457 unshift
458 use
459 utime
460 warn
27ac78c7 461 },
c948abe5
ES
462 );
463
464sub is_perl_builtin_with_list_context {
465 my $elem = shift;
466
467 return
468 exists
469 $BUILTINS_WHICH_PROVIDE_LIST_CONTEXT{
470 _name_for_sub_or_stringified_element($elem)
471 };
472}
473
474#-----------------------------------------------------------------------------
475
476# egrep '=item.*[A-Z],' perlfunc.pod
c680a9c9 477Readonly::Hash my %BUILTINS_WHICH_TAKE_MULTIPLE_ARGUMENTS =>
c948abe5
ES
478 hashify(
479 qw{
480 accept
481 atan2
482 bind
483 binmode
484 bless
485 connect
486 crypt
487 dbmopen
488 fcntl
489 flock
490 gethostbyaddr
491 getnetbyaddr
492 getpriority
493 getservbyname
494 getservbyport
495 getsockopt
496 index
497 ioctl
498 link
499 listen
500 mkdir
501 msgctl
502 msgget
503 msgrcv
504 msgsnd
505 open
506 opendir
507 pipe
508 read
509 recv
510 rename
511 rindex
512 seek
513 seekdir
514 select
515 semctl
516 semget
517 semop
518 send
519 setpgrp
520 setpriority
521 setsockopt
522 shmctl
523 shmget
524 shmread
525 shmwrite
526 shutdown
527 socket
528 socketpair
529 splice
530 split
531 substr
532 symlink
533 sysopen
534 sysread
535 sysseek
536 syswrite
537 truncate
538 unpack
539 vec
540 waitpid
541 },
542 keys %BUILTINS_WHICH_PROVIDE_LIST_CONTEXT
543 );
544
545sub is_perl_builtin_with_multiple_arguments {
546 my $elem = shift;
547
548 return
549 exists
550 $BUILTINS_WHICH_TAKE_MULTIPLE_ARGUMENTS{
551 _name_for_sub_or_stringified_element($elem)
552 };
553}
554
555#-----------------------------------------------------------------------------
556
c680a9c9 557Readonly::Hash my %BUILTINS_WHICH_TAKE_NO_ARGUMENTS =>
27ac78c7
ES
558 hashify(
559 qw{
560 endgrent
561 endhostent
562 endnetent
563 endprotoent
564 endpwent
565 endservent
566 fork
567 format
568 getgrent
569 gethostent
570 getlogin
571 getnetent
572 getppid
573 getprotoent
574 getpwent
575 getservent
576 setgrent
577 setpwent
578 split
579 time
580 times
581 wait
582 wantarray
583 }
584 );
585
586sub is_perl_builtin_with_no_arguments {
587 my $elem = shift;
588
589 return
590 exists
591 $BUILTINS_WHICH_TAKE_NO_ARGUMENTS{
592 _name_for_sub_or_stringified_element($elem)
593 };
594}
595
596#-----------------------------------------------------------------------------
597
c680a9c9 598Readonly::Hash my %BUILTINS_WHICH_TAKE_ONE_ARGUMENT =>
27ac78c7
ES
599 hashify(
600 qw{
601 closedir
602 dbmclose
603 delete
604 each
605 exists
606 fileno
607 getgrgid
608 getgrnam
609 gethostbyname
610 getnetbyname
611 getpeername
612 getpgrp
613 getprotobyname
614 getprotobynumber
615 getpwnam
616 getpwuid
617 getsockname
618 goto
619 keys
620 local
621 prototype
622 readdir
623 readline
624 readpipe
625 rewinddir
626 scalar
627 sethostent
628 setnetent
629 setprotoent
630 setservent
631 telldir
632 tied
633 untie
634 values
635 }
636 );
637
638sub is_perl_builtin_with_one_argument {
639 my $elem = shift;
640
641 return
642 exists
643 $BUILTINS_WHICH_TAKE_ONE_ARGUMENT{
644 _name_for_sub_or_stringified_element($elem)
645 };
646}
647
648#-----------------------------------------------------------------------------
649
650## no critic (ProhibitPackageVars)
c680a9c9 651Readonly::Hash my %BUILTINS_WHICH_TAKE_OPTIONAL_ARGUMENT =>
27ac78c7
ES
652 hashify(
653 grep { not exists $BUILTINS_WHICH_TAKE_ONE_ARGUMENT{ $_ } }
654 grep { not exists $BUILTINS_WHICH_TAKE_NO_ARGUMENTS{ $_ } }
655 grep { not exists $BUILTINS_WHICH_TAKE_MULTIPLE_ARGUMENTS{ $_ } }
656 @B::Keywords::Functions
657 );
658## use critic
659
660sub is_perl_builtin_with_optional_argument {
661 my $elem = shift;
662
663 return
664 exists
665 $BUILTINS_WHICH_TAKE_OPTIONAL_ARGUMENT{
666 _name_for_sub_or_stringified_element($elem)
667 };
668}
669
670#-----------------------------------------------------------------------------
671
672sub is_perl_builtin_with_zero_and_or_one_arguments {
673 my $elem = shift;
8e2aefdb 674
27ac78c7
ES
675 return if not $elem;
676
677 my $name = _name_for_sub_or_stringified_element($elem);
678
679 return (
680 exists $BUILTINS_WHICH_TAKE_ONE_ARGUMENT{ $name }
681 or exists $BUILTINS_WHICH_TAKE_NO_ARGUMENTS{ $name }
682 or exists $BUILTINS_WHICH_TAKE_OPTIONAL_ARGUMENT{ $name }
683 );
684}
685
686#-----------------------------------------------------------------------------
687
ee3a2f51
ES
688sub is_qualified_name {
689 my $name = shift;
690
691 return if not $name;
692
693 return index ( $name, q{::} ) >= 0;
694}
695
696#-----------------------------------------------------------------------------
697
8d6b89b3 698sub precedence_of {
45acb16b
CD
699 my $elem = shift;
700 return if !$elem;
3c71d40c 701 return $PRECEDENCE_OF{ ref $elem ? "$elem" : $elem };
8d6b89b3
JRT
702}
703
7b84ff16 704#-----------------------------------------------------------------------------
8d6b89b3 705
59b05e08
JRT
706sub is_hash_key {
707 my $elem = shift;
45acb16b 708 return if !$elem;
59b05e08 709
47a710b9
JRT
710 #If followed by an argument list, then its a function call, not a literal
711 return if _is_followed_by_parens($elem);
712
59b05e08 713 #Check curly-brace style: $hash{foo} = bar;
45acb16b
CD
714 my $parent = $elem->parent();
715 return if !$parent;
716 my $grandparent = $parent->parent();
717 return if !$grandparent;
59b05e08
JRT
718 return 1 if $grandparent->isa('PPI::Structure::Subscript');
719
720
721 #Check declarative style: %hash = (foo => bar);
45acb16b
CD
722 my $sib = $elem->snext_sibling();
723 return if !$sib;
59b05e08
JRT
724 return 1 if $sib->isa('PPI::Token::Operator') && $sib eq '=>';
725
45acb16b 726 return;
59b05e08
JRT
727}
728
7b84ff16 729#-----------------------------------------------------------------------------
dff08b70 730
47a710b9
JRT
731sub _is_followed_by_parens {
732 my $elem = shift;
733 return if !$elem;
734
735 my $sibling = $elem->snext_sibling() || return;
736 return $sibling->isa('PPI::Structure::List');
737}
738
739#-----------------------------------------------------------------------------
740
0893757b
ES
741sub is_included_module_name {
742 my $elem = shift;
743 return if !$elem;
744 my $stmnt = $elem->statement();
745 return if !$stmnt;
746 return if !$stmnt->isa('PPI::Statement::Include');
747 return $stmnt->schild(1) == $elem;
748}
749
750#-----------------------------------------------------------------------------
751
2e0f1c94 752sub is_integer {
6e7d6c9f
CD
753 my ($value) = @_;
754 return 0 if not defined $value;
2e0f1c94 755
f135623f 756 return $value =~ m{ \A [+-]? \d+ \z }xms;
2e0f1c94
ES
757}
758
759#-----------------------------------------------------------------------------
760
aa0d7c6e
JRT
761sub is_label_pointer {
762 my $elem = shift;
763 return if !$elem;
764
765 my $statement = $elem->statement();
766 return if !$statement;
767
768 my $psib = $elem->sprevious_sibling();
769 return if !$psib;
770
771 return $statement->isa('PPI::Statement::Break')
f135623f 772 && $psib =~ m/(?:redo|goto|next|last)/xmso;
aa0d7c6e
JRT
773}
774
775#-----------------------------------------------------------------------------
776
59b05e08
JRT
777sub is_method_call {
778 my $elem = shift;
45acb16b 779 return if !$elem;
8053d374 780
f7a00b57
JRT
781 return _is_dereference_operator( $elem->sprevious_sibling() );
782}
783
784#-----------------------------------------------------------------------------
785
786sub is_class_name {
787 my $elem = shift;
788 return if !$elem;
789
334c45ee
JRT
790 return _is_dereference_operator( $elem->snext_sibling() )
791 && !_is_dereference_operator( $elem->sprevious_sibling() );
8053d374
JRT
792}
793
794#-----------------------------------------------------------------------------
795
796sub _is_dereference_operator {
797 my $elem = shift;
798 return if !$elem;
799
800 return $elem->isa('PPI::Token::Operator') && $elem eq q{->};
59b05e08
JRT
801}
802
7b84ff16 803#-----------------------------------------------------------------------------
dff08b70 804
bdaf4dac
ES
805sub is_package_declaration {
806 my $elem = shift;
807 return if !$elem;
808 my $stmnt = $elem->statement();
809 return if !$stmnt;
810 return if !$stmnt->isa('PPI::Statement::Package');
811 return $stmnt->schild(1) == $elem;
812}
813
814#-----------------------------------------------------------------------------
815
0c377685
JRT
816sub is_subroutine_name {
817 my $elem = shift;
45acb16b
CD
818 return if !$elem;
819 my $sib = $elem->sprevious_sibling();
820 return if !$sib;
821 my $stmnt = $elem->statement();
822 return if !$stmnt;
0c377685
JRT
823 return $stmnt->isa('PPI::Statement::Sub') && $sib eq 'sub';
824}
825
7b84ff16 826#-----------------------------------------------------------------------------
0c377685 827
dc118d1b
JRT
828sub is_function_call {
829 my $elem = shift;
47a710b9 830 return if !$elem;
3ca95ec9
JRT
831
832 return if is_hash_key($elem);
833 return if is_method_call($elem);
f7a00b57 834 return if is_class_name($elem);
3ca95ec9
JRT
835 return if is_subroutine_name($elem);
836 return if is_included_module_name($elem);
837 return if is_package_declaration($elem);
838 return if is_perl_bareword($elem);
2c30044d 839 return if is_perl_filehandle($elem);
aa0d7c6e 840 return if is_label_pointer($elem);
3ca95ec9
JRT
841
842 return 1;
dc118d1b
JRT
843}
844
7b84ff16 845#-----------------------------------------------------------------------------
dc118d1b 846
dff08b70
JRT
847sub is_script {
848 my $doc = shift;
e992086d 849
d533eee5
ES
850 warnings::warnif(
851 'deprecated',
1b936936 852 'Perl::Critic::Utils::is_script($doc) deprecated, use $doc->is_program() instead.', ## no critic (ValuesAndExpressions::RequireInterpolationOfMetachars)
d533eee5
ES
853 );
854
1b936936 855 return $doc->is_program()
d533eee5 856 if blessed($doc) && $doc->isa('Perl::Critic::Document');
1b936936 857
deb58212
JRT
858 return 1 if shebang_line($doc);
859 return 1 if _is_PL_file($doc);
860 return 0;
861}
862
863#-----------------------------------------------------------------------------
864
739ac776 865sub _is_PL_file { ## no critic (NamingConventions::Capitalization)
deb58212
JRT
866 my ($doc) = @_;
867 return if not $doc->can('filename');
868 my $filename = $doc->filename() || return;
f135623f 869 return 1 if $filename =~ m/[.] PL \z/xms;
deb58212 870 return 0;
dff08b70
JRT
871}
872
7b84ff16 873#-----------------------------------------------------------------------------
dff08b70 874
464d4c66
ES
875sub is_in_void_context {
876 my ($token) = @_;
877
878 # If part of a collective, can't be void.
879 return if $token->sprevious_sibling();
880
881 my $parent = $token->statement()->parent();
882 if ($parent) {
883 return if $parent->isa('PPI::Structure::List');
83872ba5 884 return if $parent->isa('PPI::Structure::For');
464d4c66
ES
885 return if $parent->isa('PPI::Structure::Condition');
886 return if $parent->isa('PPI::Structure::Constructor');
b946a486 887 return if $parent->isa('PPI::Structure::Subscript');
464d4c66
ES
888
889 my $grand_parent = $parent->parent();
890 if ($grand_parent) {
891 return if
892 $parent->isa('PPI::Structure::Block')
893 and not $grand_parent->isa('PPI::Statement::Compound');
894 }
895 }
896
897 return $TRUE;
898}
899
900#-----------------------------------------------------------------------------
901
dc93df4f 902sub policy_long_name {
1fe8e187 903 my ( $policy_name ) = @_;
f135623f 904 if ( $policy_name !~ m{ \A $POLICY_NAMESPACE }xms ) {
1fe8e187 905 $policy_name = $POLICY_NAMESPACE . q{::} . $policy_name;
dc93df4f
JRT
906 }
907 return $policy_name;
908}
909
7b84ff16 910#-----------------------------------------------------------------------------
dc93df4f
JRT
911
912sub policy_short_name {
1fe8e187 913 my ( $policy_name ) = @_;
f135623f 914 $policy_name =~ s{\A $POLICY_NAMESPACE ::}{}xms;
dc93df4f
JRT
915 return $policy_name;
916}
917
7b84ff16 918#-----------------------------------------------------------------------------
dc93df4f 919
14a6a3ef
CD
920sub first_arg {
921 my $elem = shift;
922 my $sib = $elem->snext_sibling();
923 return if !$sib;
924
925 if ( $sib->isa('PPI::Structure::List') ) {
926
927 my $expr = $sib->schild(0);
928 return if !$expr;
929 return $expr->isa('PPI::Statement') ? $expr->schild(0) : $expr;
930 }
931
932 return $sib;
933}
934
935#-----------------------------------------------------------------------------
936
59b05e08
JRT
937sub parse_arg_list {
938 my $elem = shift;
45acb16b
CD
939 my $sib = $elem->snext_sibling();
940 return if !$sib;
59b05e08
JRT
941
942 if ( $sib->isa('PPI::Structure::List') ) {
943
0a6f07d0 944 #Pull siblings from list
329eea9a
ES
945 my @list_contents = $sib->schildren();
946 return if not @list_contents;
947
948 my @list_expressions;
949 foreach my $item (@list_contents) {
950 if (
951 is_ppi_expression_or_generic_statement($item)
952 ) {
953 push
954 @list_expressions,
955 split_nodes_on_comma( $item->schildren() );
956 }
957 else {
958 push @list_expressions, $item;
959 }
960 }
961
962 return @list_expressions;
59b05e08
JRT
963 }
964 else {
965
0a6f07d0
AL
966 #Gather up remaining nodes in the statement
967 my $iter = $elem;
968 my @arg_list = ();
59b05e08 969
0a6f07d0
AL
970 while ($iter = $iter->snext_sibling() ) {
971 last if $iter->isa('PPI::Token::Structure') and $iter eq $SCOLON;
c927e488
ES
972 last if $iter->isa('PPI::Token::Operator')
973 and $MIN_PRECEDENCE_TO_TERMINATE_PARENLESS_ARG_LIST <=
974 precedence_of( $iter );
0a6f07d0
AL
975 push @arg_list, $iter;
976 }
2b6293b2 977 return split_nodes_on_comma( @arg_list );
59b05e08
JRT
978 }
979}
980
dff08b70
JRT
981#---------------------------------
982
c6e19b74 983sub split_nodes_on_comma {
6e7d6c9f
CD
984 my @nodes = @_;
985
59b05e08 986 my $i = 0;
6e7d6c9f
CD
987 my @node_stacks;
988 for my $node (@nodes) {
329eea9a
ES
989 if (
990 $node->isa('PPI::Token::Operator')
991 and ($node eq $COMMA or $node eq $FATCOMMA)
992 ) {
993 if (@node_stacks) {
994 $i++; #Move forward to next 'node stack'
995 }
0a6f07d0 996 next;
2b6293b2
CD
997 } elsif ( $node->isa('PPI::Token::QuoteLike::Words' )) {
998 my $section = $node->{sections}->[0];
999 my @words = words_from_string(substr $node->content, $section->{position}, $section->{size});
1000 my $loc = $node->location;
1001 for my $word (@words) {
1002 my $token = PPI::Token::Quote::Single->new(q{'} . $word . q{'});
1003 $token->{_location} = $loc;
1004 push @{ $node_stacks[$i++] }, $token;
1005 }
1006 next;
0a6f07d0 1007 }
6e7d6c9f 1008 push @{ $node_stacks[$i] }, $node;
59b05e08 1009 }
6e7d6c9f 1010 return @node_stacks;
59b05e08 1011}
bf159007 1012
8645eb2c
JRT
1013#-----------------------------------------------------------------------------
1014
23952868
JJ
1015# XXX: You must keep the regular expressions in extras/perlcritic.el in sync
1016# if you change these.
c680a9c9 1017Readonly::Hash my %FORMAT_OF => (
4268e673
JRT
1018 1 => "%f:%l:%c:%m\n",
1019 2 => "%f: (%l:%c) %m\n",
b57cebc1
JRT
1020 3 => "%m at %f line %l\n",
1021 4 => "%m at line %l, column %c. %e. (Severity: %s)\n",
1022 5 => "%f: %m at line %l, column %c. %e. (Severity: %s)\n",
1023 6 => "%m at line %l, near '%r'. (Severity: %s)\n",
1024 7 => "%f: %m at line %l near '%r'. (Severity: %s)\n",
1025 8 => "[%p] %m at line %l, column %c. (Severity: %s)\n",
1026 9 => "[%p] %m at line %l, near '%r'. (Severity: %s)\n",
1027 10 => "%m at line %l, column %c.\n %p (Severity: %s)\n%d\n",
1028 11 => "%m at line %l, near '%r'.\n %p (Severity: %s)\n%d\n",
4268e673
JRT
1029);
1030
c680a9c9
ES
1031Readonly::Scalar our $DEFAULT_VERBOSITY => 4;
1032Readonly::Scalar our $DEFAULT_VERBOSITY_WITH_FILE_NAME => 5;
1033Readonly::Scalar my $DEFAULT_FORMAT => $FORMAT_OF{$DEFAULT_VERBOSITY};
9f6df1c1 1034
2e0f1c94
ES
1035sub is_valid_numeric_verbosity {
1036 my ($verbosity) = @_;
1037
1038 return exists $FORMAT_OF{$verbosity};
1039}
1040
4268e673 1041sub verbosity_to_format {
9f6df1c1
JRT
1042 my ($verbosity) = @_;
1043 return $DEFAULT_FORMAT if not defined $verbosity;
2e0f1c94 1044 return $FORMAT_OF{abs int $verbosity} || $DEFAULT_FORMAT if is_integer($verbosity);
9f6df1c1 1045 return interpolate( $verbosity ); #Otherwise, treat as a format spec
4268e673
JRT
1046}
1047
1048#-----------------------------------------------------------------------------
1049
c680a9c9 1050Readonly::Hash my %SEVERITY_NUMBER_OF => (
0bcb38c0
JRT
1051 gentle => 5,
1052 stern => 4,
1053 harsh => 3,
1054 cruel => 2,
1055 brutal => 1,
1056);
1057
c680a9c9
ES
1058Readonly::Array our @SEVERITY_NAMES => #This is exported!
1059 sort
1060 { $SEVERITY_NUMBER_OF{$a} <=> $SEVERITY_NUMBER_OF{$b} }
1061 keys %SEVERITY_NUMBER_OF;
0bcb38c0
JRT
1062
1063sub severity_to_number {
1064 my ($severity) = @_;
2e0f1c94 1065 return _normalize_severity( $severity ) if is_integer( $severity );
0bcb38c0 1066 my $severity_number = $SEVERITY_NUMBER_OF{lc $severity};
4b1bd955
ES
1067
1068 if ( not defined $severity_number ) {
1069 throw_generic qq{Invalid severity: "$severity"};
1070 }
1071
0bcb38c0
JRT
1072 return $severity_number;
1073}
1074
1075sub _normalize_severity {
1076 my $s = shift || return $SEVERITY_HIGHEST;
1077 $s = $s > $SEVERITY_HIGHEST ? $SEVERITY_HIGHEST : $s;
1078 $s = $s < $SEVERITY_LOWEST ? $SEVERITY_LOWEST : $s;
1079 return $s;
1080}
1081
1082#-----------------------------------------------------------------------------
1083
739ac776
ES
1084Readonly::Array my @SKIP_DIR => qw( CVS RCS .svn _darcs {arch} .bzr .cdv .git .hg .pc _build blib );
1085Readonly::Hash my %SKIP_DIR => hashify( @SKIP_DIR );
a91b8a46 1086
8645eb2c
JRT
1087sub all_perl_files {
1088
1089 # Recursively searches a list of directories and returns the paths
1090 # to files that seem to be Perl source code. This subroutine was
1091 # poached from Test::Perl::Critic.
1092
8645eb2c
JRT
1093 my @queue = @_;
1094 my @code_files = ();
1095
1096 while (@queue) {
1097 my $file = shift @queue;
1098 if ( -d $file ) {
1099 opendir my ($dh), $file or next;
1100 my @newfiles = sort readdir $dh;
1101 closedir $dh;
1102
1103 @newfiles = File::Spec->no_upwards(@newfiles);
739ac776 1104 @newfiles = grep { not $SKIP_DIR{$_} } @newfiles;
8645eb2c
JRT
1105 push @queue, map { File::Spec->catfile($file, $_) } @newfiles;
1106 }
1107
1108 if ( (-f $file) && ! _is_backup($file) && _is_perl($file) ) {
1109 push @code_files, $file;
1110 }
1111 }
1112 return @code_files;
1113}
1114
1115
1116#-----------------------------------------------------------------------------
1117# Decide if it's some sort of backup file
1118
1119sub _is_backup {
1120 my ($file) = @_;
f135623f
ES
1121 return 1 if $file =~ m{ [.] swp \z}xms;
1122 return 1 if $file =~ m{ [.] bak \z}xms;
1123 return 1 if $file =~ m{ ~ \z}xms;
1124 return 1 if $file =~ m{ \A [#] .+ [#] \z}xms;
8645eb2c
JRT
1125 return;
1126}
1127
1128#-----------------------------------------------------------------------------
1129# Returns true if the argument ends with a perl-ish file
1130# extension, or if it has a shebang-line containing 'perl' This
1131# subroutine was also poached from Test::Perl::Critic
1132
1133sub _is_perl {
1134 my ($file) = @_;
1135
1136 #Check filename extensions
f135623f
ES
1137 return 1 if $file =~ m{ [.] PL \z}xms;
1138 return 1 if $file =~ m{ [.] p[lm] \z}xms;
1139 return 1 if $file =~ m{ [.] t \z}xms;
8645eb2c
JRT
1140
1141 #Check for shebang
2889349f 1142 open my $fh, '<', $file or return;
8645eb2c 1143 my $first = <$fh>;
bca91e04 1144 close $fh or throw_generic "unable to close $file: $OS_ERROR";
8645eb2c 1145
f135623f 1146 return 1 if defined $first && ( $first =~ m{ \A [#]!.*perl }xms );
8645eb2c
JRT
1147 return;
1148}
1149
6036a254 1150#-----------------------------------------------------------------------------
bf159007 1151
e2e7b907
CD
1152sub shebang_line {
1153 my $doc = shift;
b9b8ed18
ES
1154 my $first_element = $doc->first_element();
1155 return if not $first_element;
1156 return if not $first_element->isa('PPI::Token::Comment');
1157 my $location = $first_element->location();
e2e7b907
CD
1158 return if !$location;
1159 # The shebang must be the first two characters in the file, according to
1160 # http://en.wikipedia.org/wiki/Shebang_(Unix)
1161 return if $location->[0] != 1; # line number
1162 return if $location->[1] != 1; # column number
b9b8ed18 1163 my $shebang = $first_element->content;
f135623f 1164 return if $shebang !~ m{ \A [#]! }xms;
e2e7b907
CD
1165 return $shebang;
1166}
1167
6036a254 1168#-----------------------------------------------------------------------------
e2e7b907 1169
4a7a7227
AL
1170sub words_from_string {
1171 my $str = shift;
1172
38e3d924 1173 return split q{ }, $str; # This must be a literal space, not $SPACE
4a7a7227
AL
1174}
1175
9fb2d1dc
AM
1176#-----------------------------------------------------------------------------
1177
1178sub is_unchecked_call {
1179 my $elem = shift;
1180
1181 return if not is_function_call( $elem );
1182
1183 # check to see if there's an '=' or 'unless' or something before this.
1184 if( my $sib = $elem->sprevious_sibling() ){
1185 return if $sib;
1186 }
1187
1188
1189 if( my $statement = $elem->statement() ){
1190
1191 # "open or die" is OK.
1192 # We can't check snext_sibling for 'or' since the next siblings are an
1193 # unknown number of arguments to the system call. Instead, check all of
40647aca
JRT
1194 # the elements to this statement to see if we find 'or' or '||'.
1195
1196 my $or_operators = sub {
5603748e 1197 my (undef, $elem) = @_; ## no critic(Variables::ProhibitReusedNames)
40647aca 1198 return if not $elem->isa('PPI::Token::Operator');
0f1f4df7 1199 return if $elem ne q{or} && $elem ne q{||};
40647aca
JRT
1200 return 1;
1201 };
1202
1203 return if $statement->find( $or_operators );
1204
9fb2d1dc
AM
1205
1206 if( my $parent = $elem->statement()->parent() ){
1207
40647aca 1208 # Check if we're in an if( open ) {good} else {bad} condition
9fb2d1dc
AM
1209 return if $parent->isa('PPI::Structure::Condition');
1210
40647aca 1211 # Return val could be captured in data structure and checked later
9fb2d1dc
AM
1212 return if $parent->isa('PPI::Structure::Constructor');
1213
1214 # "die if not ( open() )" - It's in list context.
1215 if ( $parent->isa('PPI::Structure::List') ) {
1216 if( my $uncle = $parent->sprevious_sibling() ){
1217 return if $uncle;
1218 }
1219 }
1220 }
1221 }
1222
2b6293b2
CD
1223 return if _is_fatal($elem);
1224
9fb2d1dc
AM
1225 # Otherwise, return. this system call is unchecked.
1226 return 1;
1227}
1228
24196707 1229# Based upon autodie 2.10.
6386d95c
ES
1230Readonly::Hash my %AUTODIE_PARAMETER_TO_AFFECTED_BUILTINS_MAP => (
1231 # Map builtins to themselves.
84ed32d9
ES
1232 (
1233 map { $_ => { hashify( $_ ) } }
1234 qw<
24196707
ES
1235 accept bind binmode chdir chmod close closedir connect
1236 dbmclose dbmopen exec fcntl fileno flock fork getsockopt ioctl
1237 link listen mkdir msgctl msgget msgrcv msgsnd open opendir
1238 pipe read readlink recv rename rmdir seek semctl semget semop
1239 send setsockopt shmctl shmget shmread shutdown socketpair
1240 symlink sysopen sysread sysseek system syswrite truncate umask
1241 unlink
84ed32d9
ES
1242 >
1243 ),
1244
1245 # Generate these using tools/dump-autodie-tag-contents
1246 ':threads' => { hashify( qw< fork > ) },
1247 ':system' => { hashify( qw< exec system > ) },
1248 ':dbm' => { hashify( qw< dbmclose dbmopen > ) },
1249 ':semaphore' => { hashify( qw< semctl semget semop > ) },
1250 ':shm' => { hashify( qw< shmctl shmget shmread > ) },
1251 ':msg' => { hashify( qw< msgctl msgget msgrcv msgsnd > ) },
1252 ':file' => {
1253 hashify(
1254 qw<
24196707
ES
1255 binmode chmod close fcntl fileno flock ioctl open sysopen
1256 truncate
84ed32d9
ES
1257 >
1258 )
1259 },
1260 ':filesys' => {
6386d95c
ES
1261 hashify(
1262 qw<
84ed32d9
ES
1263 chdir closedir link mkdir opendir readlink rename rmdir
1264 symlink umask unlink
6386d95c
ES
1265 >
1266 )
1267 },
84ed32d9 1268 ':ipc' => {
6386d95c
ES
1269 hashify(
1270 qw<
84ed32d9
ES
1271 msgctl msgget msgrcv msgsnd pipe semctl semget semop shmctl
1272 shmget shmread
6386d95c
ES
1273 >
1274 )
1275 },
84ed32d9 1276 ':socket' => {
6386d95c
ES
1277 hashify(
1278 qw<
1279 accept bind connect getsockopt listen recv send setsockopt
1280 shutdown socketpair
1281 >
1282 )
1283 },
84ed32d9 1284 ':io' => {
6386d95c
ES
1285 hashify(
1286 qw<
24196707
ES
1287 accept bind binmode chdir chmod close closedir connect
1288 dbmclose dbmopen fcntl fileno flock getsockopt ioctl link
1289 listen mkdir msgctl msgget msgrcv msgsnd open opendir pipe
1290 read readlink recv rename rmdir seek semctl semget semop send
1291 setsockopt shmctl shmget shmread shutdown socketpair symlink
1292 sysopen sysread sysseek syswrite truncate umask unlink
6386d95c
ES
1293 >
1294 )
1295 },
84ed32d9 1296 ':default' => {
6386d95c
ES
1297 hashify(
1298 qw<
24196707
ES
1299 accept bind binmode chdir chmod close closedir connect
1300 dbmclose dbmopen fcntl fileno flock fork getsockopt ioctl link
1301 listen mkdir msgctl msgget msgrcv msgsnd open opendir pipe
1302 read readlink recv rename rmdir seek semctl semget semop send
84ed32d9
ES
1303 setsockopt shmctl shmget shmread shutdown socketpair symlink
1304 sysopen sysread sysseek syswrite truncate umask unlink
6386d95c
ES
1305 >
1306 )
1307 },
84ed32d9 1308 ':all' => {
6386d95c
ES
1309 hashify(
1310 qw<
24196707
ES
1311 accept bind binmode chdir chmod close closedir connect
1312 dbmclose dbmopen exec fcntl fileno flock fork getsockopt ioctl
1313 link listen mkdir msgctl msgget msgrcv msgsnd open opendir
1314 pipe read readlink recv rename rmdir seek semctl semget semop
1315 send setsockopt shmctl shmget shmread shutdown socketpair
1316 symlink sysopen sysread sysseek system syswrite truncate umask
1317 unlink
6386d95c
ES
1318 >
1319 )
1320 },
1321);
1322
2b6293b2
CD
1323sub _is_fatal {
1324 my ($elem) = @_;
1325
6386d95c
ES
1326 my $top = $elem->top();
1327 return if not $top->isa('PPI::Document');
1328
2b6293b2 1329 my $includes = $top->find('PPI::Statement::Include');
6386d95c
ES
1330 return if not $includes;
1331
2b6293b2 1332 for my $include (@{$includes}) {
6386d95c
ES
1333 next if 'use' ne $include->type();
1334
1335 if ('Fatal' eq $include->module()) {
2b6293b2 1336 my @args = parse_arg_list($include->schild(1));
6386d95c
ES
1337 foreach my $arg (@args) {
1338 return $TRUE if $arg->[0]->isa('PPI::Token::Quote') && $elem eq $arg->[0]->string();
2b6293b2 1339 }
6386d95c
ES
1340 }
1341 elsif ('Fatal::Exception' eq $include->module()) {
2b6293b2
CD
1342 my @args = parse_arg_list($include->schild(1));
1343 shift @args; # skip exception class name
6386d95c
ES
1344 foreach my $arg (@args) {
1345 return $TRUE if $arg->[0]->isa('PPI::Token::Quote') && $elem eq $arg->[0]->string();
1346 }
1347 }
1348 elsif ('autodie' eq $include->pragma()) {
84ed32d9
ES
1349 return _is_covered_by_autodie($elem, $include);
1350 }
1351 }
6386d95c 1352
84ed32d9
ES
1353 return;
1354}
6386d95c 1355
84ed32d9
ES
1356sub _is_covered_by_autodie {
1357 my ($elem, $include) = @_;
6386d95c 1358
84ed32d9
ES
1359 my @args = parse_arg_list($include->schild(1));
1360
1361 if (@args) {
1362 foreach my $arg (@args) {
1363 my $builtins =
1364 $AUTODIE_PARAMETER_TO_AFFECTED_BUILTINS_MAP{
1365 $arg->[0]->string
1366 };
1367
1368 return $TRUE if $builtins and $builtins->{$elem->content()};
2b6293b2
CD
1369 }
1370 }
84ed32d9
ES
1371 else {
1372 my $builtins =
1373 $AUTODIE_PARAMETER_TO_AFFECTED_BUILTINS_MAP{':default'};
1374
1375 return $TRUE if $builtins and $builtins->{$elem->content()};
1376 }
6386d95c 1377
2b6293b2
CD
1378 return;
1379}
4a7a7227 1380
59b05e08
JRT
13811;
1382
1383__END__
1384
dff08b70
JRT
1385=pod
1386
59b05e08
JRT
1387=head1 NAME
1388
c728943a 1389Perl::Critic::Utils - General utility subroutines and constants for Perl::Critic and derivative distributions.
59b05e08 1390
11f53956 1391
59b05e08
JRT
1392=head1 DESCRIPTION
1393
11f53956
ES
1394This module provides several static subs and variables that are useful
1395for developing L<Perl::Critic::Policy|Perl::Critic::Policy>
1396subclasses. Unless you are writing Policy modules, you probably don't
1397care about this package.
1398
59b05e08 1399
4444d94d
ES
1400=head1 INTERFACE SUPPORT
1401
1402This is considered to be a public module. Any changes to its
1403interface will go through a deprecation cycle.
1404
1405
bbf4108c 1406=head1 IMPORTABLE SUBS
59b05e08 1407
8bd925c8 1408=over
59b05e08 1409
6d9feae6 1410=item C<find_keywords( $doc, $keyword )>
59b05e08 1411
11f53956
ES
1412B<DEPRECATED:> Since version 0.11, every Policy is evaluated at each
1413element of the document. So you shouldn't need to go looking for a
1414particular keyword. If you I<do> want to use this, please import it
1415via the C<:deprecated> tag, rather than directly, to mark the module
1416as needing updating.
1417
1418Given a L<PPI::Document|PPI::Document> as C<$doc>, returns a reference
1419to an array containing all the L<PPI::Token::Word|PPI::Token::Word>
1420elements that match C<$keyword>. This can be used to find any
1421built-in function, method call, bareword, or reserved keyword. It
1422will not match variables, subroutine names, literal strings, numbers,
1423or symbols. If the document doesn't contain any matches, returns
bbf4108c 1424undef.
59b05e08 1425
11f53956 1426
8d6b89b3
JRT
1427=item C<is_perl_global( $element )>
1428
11f53956
ES
1429Given a L<PPI::Token::Symbol|PPI::Token::Symbol> or a string, returns
1430true if that token represents one of the global variables provided by
1431the L<English|English> module, or one of the builtin global variables
1432like C<%SIG>, C<%ENV>, or C<@ARGV>. The sigil on the symbol is
1433ignored, so things like C<$ARGV> or C<$ENV> will still return true.
1434
8d6b89b3
JRT
1435
1436=item C<is_perl_builtin( $element )>
1437
11f53956
ES
1438Given a L<PPI::Token::Word|PPI::Token::Word>,
1439L<PPI::Statement::Sub|PPI::Statement::Sub>, or string, returns true if
1440that token represents a call to any of the builtin functions defined
1441in Perl 5.8.8.
1442
c948abe5 1443
3ca95ec9
JRT
1444=item C<is_perl_bareword( $element )>
1445
11f53956
ES
1446Given a L<PPI::Token::Word|PPI::Token::Word>,
1447L<PPI::Statement::Sub|PPI::Statement::Sub>, or string, returns true if
1448that token represents a bareword (e.g. "if", "else", "sub", "package")
3ca95ec9
JRT
1449defined in Perl 5.8.8.
1450
11f53956 1451
2c30044d
JRT
1452=item C<is_perl_filehandle( $element )>
1453
11f53956
ES
1454Given a L<PPI::Token::Word|PPI::Token::Word>, or string, returns true
1455if that token represents one of the global filehandles (e.g. C<STDIN>,
1456C<STDERR>, C<STDOUT>, C<ARGV>) that are defined in Perl 5.8.8. Note
1457that this function will return false if given a filehandle that is
1458represented as a typeglob (e.g. C<*STDIN>)
1459
2c30044d 1460
c948abe5
ES
1461=item C<is_perl_builtin_with_list_context( $element )>
1462
11f53956
ES
1463Given a L<PPI::Token::Word|PPI::Token::Word>,
1464L<PPI::Statement::Sub|PPI::Statement::Sub>, or string, returns true if
1465that token represents a call to any of the builtin functions defined
1466in Perl 5.8.8 that provide a list context to the following tokens.
1467
c948abe5
ES
1468
1469=item C<is_perl_builtin_with_multiple_arguments( $element )>
1470
11f53956
ES
1471Given a L<PPI::Token::Word|PPI::Token::Word>,
1472L<PPI::Statement::Sub|PPI::Statement::Sub>, or string, returns true if
1473that token represents a call to any of the builtin functions defined
1474in Perl 5.8.8 that B<can> take multiple arguments.
1475
27ac78c7
ES
1476
1477=item C<is_perl_builtin_with_no_arguments( $element )>
1478
11f53956
ES
1479Given a L<PPI::Token::Word|PPI::Token::Word>,
1480L<PPI::Statement::Sub|PPI::Statement::Sub>, or string, returns true if
1481that token represents a call to any of the builtin functions defined
1482in Perl 5.8.8 that B<cannot> take any arguments.
1483
27ac78c7
ES
1484
1485=item C<is_perl_builtin_with_one_argument( $element )>
1486
11f53956
ES
1487Given a L<PPI::Token::Word|PPI::Token::Word>,
1488L<PPI::Statement::Sub|PPI::Statement::Sub>, or string, returns true if
1489that token represents a call to any of the builtin functions defined
1490in Perl 5.8.8 that takes B<one and only one> argument.
1491
27ac78c7
ES
1492
1493=item C<is_perl_builtin_with_optional_argument( $element )>
1494
11f53956
ES
1495Given a L<PPI::Token::Word|PPI::Token::Word>,
1496L<PPI::Statement::Sub|PPI::Statement::Sub>, or string, returns true if
1497that token represents a call to any of the builtin functions defined
1498in Perl 5.8.8 that takes B<no more than one> argument.
27ac78c7 1499
11f53956
ES
1500The sets of values for which
1501C<is_perl_builtin_with_multiple_arguments()>,
27ac78c7
ES
1502C<is_perl_builtin_with_no_arguments()>,
1503C<is_perl_builtin_with_one_argument()>, and
11f53956
ES
1504C<is_perl_builtin_with_optional_argument()> return true are disjoint
1505and their union is precisely the set of values that
1506C<is_perl_builtin()> will return true for.
1507
27ac78c7
ES
1508
1509=item C<is_perl_builtin_with_zero_and_or_one_arguments( $element )>
1510
11f53956
ES
1511Given a L<PPI::Token::Word|PPI::Token::Word>,
1512L<PPI::Statement::Sub|PPI::Statement::Sub>, or string, returns true if
1513that token represents a call to any of the builtin functions defined
1514in Perl 5.8.8 that takes no and/or one argument.
27ac78c7
ES
1515
1516Returns true if any of C<is_perl_builtin_with_no_arguments()>,
1517C<is_perl_builtin_with_one_argument()>, and
1518C<is_perl_builtin_with_optional_argument()> returns true.
8d6b89b3 1519
11f53956 1520
ee3a2f51
ES
1521=item C<is_qualified_name( $name )>
1522
11f53956
ES
1523Given a string, L<PPI::Token::Word|PPI::Token::Word>, or
1524L<PPI::Token::Symbol|PPI::Token::Symbol>, answers whether it has a
1525module component, i.e. contains "::".
1526
ee3a2f51 1527
8d6b89b3
JRT
1528=item C<precedence_of( $element )>
1529
11f53956
ES
1530Given a L<PPI::Token::Operator|PPI::Token::Operator> or a string,
1531returns the precedence of the operator, where 1 is the highest
1532precedence. Returns undef if the precedence can't be determined
1533(which is usually because it is not an operator).
1534
8d6b89b3 1535
6d9feae6 1536=item C<is_hash_key( $element )>
59b05e08 1537
11f53956
ES
1538Given a L<PPI::Element|PPI::Element>, returns true if the element is a
1539literal hash key. PPI doesn't distinguish between regular barewords
1540(like keywords or subroutine calls) and barewords in hash subscripts
1541(which are considered literal). So this subroutine is useful if your
1542Policy is searching for L<PPI::Token::Word|PPI::Token::Word> elements
1543and you want to filter out the hash subscript variety. In both of the
1544following examples, "foo" is considered a hash key:
1545
1546 $hash1{foo} = 1;
1547 %hash2 = (foo => 1);
59b05e08 1548
11f53956
ES
1549But if the bareword is followed by an argument list, then perl treats
1550it as a function call. So in these examples, "foo" is B<not>
1551considered a hash key:
59b05e08 1552
11f53956
ES
1553 $hash1{ foo() } = 1;
1554 &hash2 = (foo() => 1);
47a710b9 1555
47a710b9 1556
bdaf4dac
ES
1557=item C<is_included_module_name( $element )>
1558
11f53956
ES
1559Given a L<PPI::Token::Word|PPI::Token::Word>, returns true if the
1560element is the name of a module that is being included via C<use>,
1561C<require>, or C<no>.
1562
bdaf4dac 1563
2e0f1c94
ES
1564=item C<is_integer( $value )>
1565
11f53956
ES
1566Answers whether the parameter, as a string, looks like an integral
1567value.
1568
2e0f1c94 1569
f7a00b57
JRT
1570=item C<is_class_name( $element )>
1571
11f53956
ES
1572Given a L<PPI::Token::Word|PPI::Token::Word>, returns true if the
1573element that immediately follows this element is the dereference
1574operator "->". When a bareword has a "->" on the B<right> side, it
1575usually means that it is the name of the class (from which a method is
1576being called).
1577
f7a00b57 1578
aa0d7c6e
JRT
1579=item C<is_label_pointer( $element )>
1580
11f53956
ES
1581Given a L<PPI::Token::Word|PPI::Token::Word>, returns true if the
1582element is the label in a C<next>, C<last>, C<redo>, or C<goto>
1583statement. Note this is not the same thing as the label declaration.
1584
aa0d7c6e 1585
6d9feae6 1586=item C<is_method_call( $element )>
59b05e08 1587
11f53956
ES
1588Given a L<PPI::Token::Word|PPI::Token::Word>, returns true if the
1589element that immediately precedes this element is the dereference
1590operator "->". When a bareword has a "->" on the B<left> side, it
1591usually means that it is the name of a method (that is being called
1592from a class).
1593
59b05e08 1594
bdaf4dac 1595=item C<is_package_declaration( $element )>
0c377685 1596
11f53956
ES
1597Given a L<PPI::Token::Word|PPI::Token::Word>, returns true if the
1598element is the name of a package that is being declared.
1599
0c377685 1600
bdaf4dac 1601=item C<is_subroutine_name( $element )>
0893757b 1602
11f53956
ES
1603Given a L<PPI::Token::Word|PPI::Token::Word>, returns true if the
1604element is the name of a subroutine declaration. This is useful for
1605distinguishing barewords and from function calls from subroutine
1606declarations.
1607
0893757b 1608
dc118d1b
JRT
1609=item C<is_function_call( $element )>
1610
11f53956
ES
1611Given a L<PPI::Token::Word|PPI::Token::Word> returns true if the
1612element appears to be call to a static function. Specifically, this
1613function returns true if C<is_hash_key>, C<is_method_call>,
ee4f4d20 1614C<is_subroutine_name>, C<is_included_module_name>,
11f53956
ES
1615C<is_package_declaration>, C<is_perl_bareword>, C<is_perl_filehandle>,
1616C<is_label_pointer> and C<is_subroutine_name> all return false for the
1617given element.
1618
dc118d1b 1619
14a6a3ef
CD
1620=item C<first_arg( $element )>
1621
11f53956
ES
1622Given a L<PPI::Element|PPI::Element> that is presumed to be a function
1623call (which is usually a L<PPI::Token::Word|PPI::Token::Word>), return
1624the first argument. This is similar of C<parse_arg_list()> and
1625follows the same logic. Note that for the code:
1626
1627 int($x + 0.5)
14a6a3ef 1628
11f53956
ES
1629this function will return just the C<$x>, not the whole expression.
1630This is different from the behavior of C<parse_arg_list()>. Another
1631caveat is:
14a6a3ef 1632
11f53956 1633 int(($x + $y) + 0.5)
14a6a3ef 1634
11f53956
ES
1635which returns C<($x + $y)> as a
1636L<PPI::Structure::List|PPI::Structure::List> instance.
14a6a3ef 1637
14a6a3ef 1638
6d9feae6 1639=item C<parse_arg_list( $element )>
59b05e08 1640
11f53956
ES
1641Given a L<PPI::Element|PPI::Element> that is presumed to be a function
1642call (which is usually a L<PPI::Token::Word|PPI::Token::Word>), splits
1643the argument expressions into arrays of tokens. Returns a list
1644containing references to each of those arrays. This is useful because
1645parentheses are optional when calling a function, and PPI parses them
1646very differently. So this method is a poor-man's parse tree of PPI
1647nodes. It's not bullet-proof because it doesn't respect precedence.
1648In general, I don't like the way this function works, so don't count
1649on it to be stable (or even present).
1650
59b05e08 1651
c6e19b74
CD
1652=item C<split_nodes_on_comma( @nodes )>
1653
11f53956
ES
1654This has the same return type as C<parse_arg_list()> but expects to be
1655passed the nodes that represent the interior of a list, like:
1656
1657 'foo', 1, 2, 'bar'
c6e19b74 1658
c6e19b74 1659
6d9feae6 1660=item C<is_script( $document )>
bf159007 1661
1b936936
ES
1662B<This subroutine is deprecated and will be removed in a future release.> You
1663should use the L<Perl::Critic::Document/"is_program()"> method instead.
d533eee5 1664
bf159007 1665
464d4c66
ES
1666=item C<is_in_void_context( $token )>
1667
11f53956
ES
1668Given a L<PPI::Token|PPI::Token>, answer whether it appears to be in a
1669void context.
1670
464d4c66 1671
9f12283e 1672=item C<policy_long_name( $policy_name )>
dc93df4f 1673
bbf4108c
ES
1674Given a policy class name in long or short form, return the long form.
1675
11f53956 1676
9f12283e 1677=item C<policy_short_name( $policy_name )>
bbf4108c 1678
11f53956
ES
1679Given a policy class name in long or short form, return the short
1680form.
1681
dc93df4f 1682
8645eb2c
JRT
1683=item C<all_perl_files( @directories )>
1684
11f53956
ES
1685Given a list of directories, recursively searches through all the
1686directories (depth first) and returns a list of paths for all the
1687files that are Perl code files. Any administrative files for CVS or
1688Subversion are skipped, as are things that look like temporary or
1689backup files.
8645eb2c
JRT
1690
1691A Perl code file is:
1692
8bd925c8 1693=over
8645eb2c
JRT
1694
1695=item * Any file that ends in F<.PL>, F<.pl>, F<.pm>, or F<.t>
1696
1697=item * Any file that has a first line with a shebang containing 'perl'
1698
1699=back
1700
11f53956 1701
0bcb38c0
JRT
1702=item C<severity_to_number( $severity )>
1703
11f53956
ES
1704If C<$severity> is given as an integer, this function returns
1705C<$severity> but normalized to lie between C<$SEVERITY_LOWEST> and
1706C<$SEVERITY_HIGHEST>. If C<$severity> is given as a string, this
1707function returns the corresponding severity number. If the string
1708doesn't have a corresponding number, this function will throw an
1709exception.
1710
0bcb38c0 1711
2e0f1c94
ES
1712=item C<is_valid_numeric_verbosity( $severity )>
1713
1714Answers whether the argument has a translation to a Violation format.
1715
11f53956 1716
4268e673
JRT
1717=item C<verbosity_to_format( $verbosity_level )>
1718
11f53956
ES
1719Given a verbosity level between 1 and 10, returns the corresponding
1720predefined format string. These formats are suitable for passing to
1721the C<set_format> method in
1722L<Perl::Critic::Violation|Perl::Critic::Violation>. See the
1723L<perlcritic|perlcritic> documentation for a listing of the predefined
1724formats.
1725
4268e673 1726
3ffdaa3b
AL
1727=item C<hashify( @list )>
1728
11f53956
ES
1729Given C<@list>, return a hash where C<@list> is in the keys and each
1730value is 1. Duplicate values in C<@list> are silently squished.
1731
7b84ff16
JRT
1732
1733=item C<interpolate( $literal )>
1734
11f53956
ES
1735Given a C<$literal> string that may contain control characters (e.g..
1736'\t' '\n'), this function does a double interpolation on the string
1737and returns it as if it had been declared in double quotes. For
1738example:
1739
1740 'foo \t bar \n' ...becomes... "foo \t bar \n"
7b84ff16 1741
3ffdaa3b 1742
e2e7b907
CD
1743=item C<shebang_line( $document )>
1744
11f53956
ES
1745Given a L<PPI::Document|PPI::Document>, test if it starts with C<#!>.
1746If so, return that line. Otherwise return undef.
1747
e2e7b907 1748
4a7a7227
AL
1749=item C<words_from_string( $str )>
1750
11f53956
ES
1751Given config string I<$str>, return all the words from the string.
1752This is safer than splitting on whitespace.
1753
4a7a7227 1754
9fb2d1dc
AM
1755=item C<is_unchecked_call( $element )>
1756
11f53956
ES
1757Given a L<PPI::Element|PPI::Element>, test to see if it contains a
1758function call whose return value is not checked.
1759
9fb2d1dc 1760
59b05e08
JRT
1761=back
1762
11f53956 1763
bbf4108c 1764=head1 IMPORTABLE VARIABLES
59b05e08 1765
8bd925c8 1766=over
59b05e08 1767
6d9feae6 1768=item C<$COMMA>
59b05e08 1769
a3adb7a9
AL
1770=item C<$FATCOMMA>
1771
6d9feae6 1772=item C<$COLON>
59b05e08 1773
6d9feae6 1774=item C<$SCOLON>
59b05e08 1775
6d9feae6 1776=item C<$QUOTE>
59b05e08 1777
6d9feae6 1778=item C<$DQUOTE>
59b05e08 1779
68a933bc
ES
1780=item C<$BACKTICK>
1781
6d9feae6 1782=item C<$PERIOD>
59b05e08 1783
6d9feae6 1784=item C<$PIPE>
59b05e08 1785
6d9feae6 1786=item C<$EMPTY>
59b05e08 1787
0fc740da
JRT
1788=item C<$EQUAL>
1789
6d9feae6 1790=item C<$SPACE>
59b05e08 1791
a609ec83
ES
1792=item C<$SLASH>
1793
1794=item C<$BSLASH>
1795
310e7cf9
ES
1796=item C<$LEFT_PAREN>
1797
1798=item C<$RIGHT_PAREN>
1799
11f53956
ES
1800These character constants give clear names to commonly-used strings
1801that can be hard to read when surrounded by quotes and other
1802punctuation. Can be imported in one go via the C<:characters> tag.
dff08b70 1803
6d9feae6 1804=item C<$SEVERITY_HIGHEST>
dff08b70 1805
6d9feae6 1806=item C<$SEVERITY_HIGH>
dff08b70 1807
6d9feae6 1808=item C<$SEVERITY_MEDIUM>
dff08b70 1809
6d9feae6 1810=item C<$SEVERITY_LOW>
dff08b70 1811
6d9feae6 1812=item C<$SEVERITY_LOWEST>
dff08b70 1813
7e86d49a 1814These numeric constants define the relative severity of violating each
11f53956
ES
1815L<Perl::Critic::Policy|Perl::Critic::Policy>. The C<get_severity> and
1816C<default_severity> methods of every Policy subclass must return one
1817of these values. Can be imported via the C<:severities> tag.
dff08b70 1818
738830ba
ES
1819=item C<$DEFAULT_VERBOSITY>
1820
1821The default numeric verbosity.
1822
1823=item C<$DEFAULT_VERBOSITY_WITH_FILE_NAME>
1824
1825The numeric verbosity that corresponds to the format indicated by
1826C<$DEFAULT_VERBOSITY>, but with the file name prefixed to it.
1827
6d9feae6 1828=item C<$TRUE>
59b05e08 1829
6d9feae6 1830=item C<$FALSE>
59b05e08 1831
11f53956
ES
1832These are simple booleans. 1 and 0 respectively. Be mindful of using
1833these with string equality. C<$FALSE ne $EMPTY>. Can be imported via
1834the C<:booleans> tag.
1835
bbf4108c
ES
1836
1837=back
1838
11f53956 1839
bbf4108c
ES
1840=head1 IMPORT TAGS
1841
11f53956
ES
1842The following groups of functions and constants are available as
1843parameters to a C<use Perl::Critic::Util> statement.
bbf4108c
ES
1844
1845=over
1846
1847=item C<:all>
1848
1849The lot.
1850
11f53956 1851
bbf4108c
ES
1852=item C<:booleans>
1853
1854Includes:
1855C<$TRUE>, C<$FALSE>
1856
11f53956 1857
bbf4108c
ES
1858=item C<:severities>
1859
1860Includes:
1861C<$SEVERITY_HIGHEST>,
1862C<$SEVERITY_HIGH>,
1863C<$SEVERITY_MEDIUM>,
1864C<$SEVERITY_LOW>,
1865C<$SEVERITY_LOWEST>,
1866C<@SEVERITY_NAMES>
1867
11f53956 1868
bbf4108c
ES
1869=item C<:characters>
1870
1871Includes:
1872C<$COLON>,
1873C<$COMMA>,
1874C<$DQUOTE>,
1875C<$EMPTY>,
1876C<$FATCOMMA>,
1877C<$PERIOD>,
1878C<$PIPE>,
1879C<$QUOTE>,
68a933bc 1880C<$BACKTICK>,
bbf4108c
ES
1881C<$SCOLON>,
1882C<$SPACE>,
1883C<$SLASH>,
1884C<$BSLASH>
310e7cf9
ES
1885C<$LEFT_PAREN>
1886C<$RIGHT_PAREN>
bbf4108c 1887
11f53956 1888
bbf4108c
ES
1889=item C<:classification>
1890
1891Includes:
70f3f307
ES
1892C<is_function_call>,
1893C<is_hash_key>,
1894C<is_included_module_name>,
1895C<is_integer>,
1896C<is_method_call>,
1897C<is_package_declaration>,
1898C<is_perl_builtin>,
1899C<is_perl_global>,
1900C<is_perl_builtin_with_list_context>
1901C<is_perl_builtin_with_multiple_arguments>
1902C<is_perl_builtin_with_no_arguments>
1903C<is_perl_builtin_with_one_argument>
1904C<is_perl_builtin_with_optional_argument>
1905C<is_perl_builtin_with_zero_and_or_one_arguments>
1906C<is_script>,
1907C<is_subroutine_name>,
1908C<is_unchecked_call>
1909C<is_valid_numeric_verbosity>
bbf4108c 1910
11f53956
ES
1911See also L<Perl::Critic::Utils::PPI|Perl::Critic::Utils::PPI>.
1912
9f12283e 1913
bbf4108c
ES
1914=item C<:data_conversion>
1915
11f53956
ES
1916Generic manipulation, not having anything specific to do with
1917Perl::Critic.
bbf4108c
ES
1918
1919Includes:
70f3f307
ES
1920C<hashify>,
1921C<words_from_string>,
1922C<interpolate>
bbf4108c 1923
11f53956 1924
bbf4108c
ES
1925=item C<:ppi>
1926
11f53956 1927Things for dealing with L<PPI|PPI>, other than classification.
bbf4108c
ES
1928
1929Includes:
70f3f307
ES
1930C<first_arg>,
1931C<parse_arg_list>
bbf4108c 1932
11f53956
ES
1933See also L<Perl::Critic::Utils::PPI|Perl::Critic::Utils::PPI>.
1934
9f12283e 1935
bbf4108c
ES
1936=item C<:internal_lookup>
1937
1938Translations between internal representations.
1939
1940Includes:
70f3f307
ES
1941C<severity_to_number>,
1942C<verbosity_to_format>
bbf4108c 1943
11f53956 1944
bbf4108c
ES
1945=item C<:language>
1946
1947Information about Perl not programmatically available elsewhere.
1948
1949Includes:
70f3f307 1950C<precedence_of>
bbf4108c 1951
11f53956 1952
bbf4108c
ES
1953=item C<:deprecated>
1954
11f53956
ES
1955Not surprisingly, things that are deprecated. It is preferred to use
1956this tag to get to these functions, rather than the function names
1957themselves, so as to mark any module using them as needing cleanup.
bbf4108c
ES
1958
1959Includes:
70f3f307 1960C<find_keywords>
59b05e08 1961
11f53956 1962
59b05e08
JRT
1963=back
1964
11f53956 1965
9f12283e
ES
1966=head1 SEE ALSO
1967
11f53956
ES
1968L<Perl::Critic::Utils::Constants|Perl::Critic::Utils::Constants>,
1969L<Perl::Critic::Utils::McCabe|Perl::Critic::Utils::McCabe>,
1970L<Perl::Critic::Utils::PPI|Perl::Critic::Utils::PPI>,
1971
9f12283e 1972
59b05e08
JRT
1973=head1 AUTHOR
1974
03887e5e 1975Jeffrey Ryan Thalhammer <jeff@imaginative-software.com>
59b05e08 1976
11f53956 1977
59b05e08
JRT
1978=head1 COPYRIGHT
1979
53b8903f 1980Copyright (c) 2005-2011 Imaginative Software Systems. All rights reserved.
59b05e08
JRT
1981
1982This program is free software; you can redistribute it and/or modify
1983it under the same terms as Perl itself. The full text of this license
1984can be found in the LICENSE file included with this module.
dff08b70
JRT
1985
1986=cut
737d3b65
CD
1987
1988# Local Variables:
1989# mode: cperl
1990# cperl-indent-level: 4
1991# fill-column: 78
1992# indent-tabs-mode: nil
1993# c-indentation-style: bsd
1994# End:
96fed375 1995# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :