Login
Remove TODO for RequirePodSections.
[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
59b05e08
JRT
8package Perl::Critic::Utils;
9
10use strict;
11use warnings;
0bcb38c0 12use Carp qw(confess);
410cf90b 13use File::Spec qw();
e2d4c0f0 14use B::Keywords qw();
59b05e08
JRT
15use base 'Exporter';
16
7807e1bf 17our $VERSION = 1.03;
59b05e08 18
6036a254 19#-----------------------------------------------------------------------------
bbf4108c 20# Exportable symbols here.
1fe8e187 21
bbf4108c 22our @EXPORT_OK = qw(
dc93df4f
JRT
23 $TRUE
24 $FALSE
25
e2d4c0f0
JRT
26 $POLICY_NAMESPACE
27
dc93df4f
JRT
28 $SEVERITY_HIGHEST
29 $SEVERITY_HIGH
30 $SEVERITY_MEDIUM
31 $SEVERITY_LOW
32 $SEVERITY_LOWEST
0bcb38c0 33 @SEVERITY_NAMES
dc93df4f
JRT
34
35 $COLON
36 $COMMA
37 $DQUOTE
38 $EMPTY
39 $FATCOMMA
40 $PERIOD
41 $PIPE
42 $QUOTE
43 $SCOLON
44 $SPACE
a609ec83
ES
45 $SLASH
46 $BSLASH
310e7cf9
ES
47 $LEFT_PAREN
48 $RIGHT_PAREN
6f31806e 49
dc93df4f
JRT
50 &all_perl_files
51 &find_keywords
bbf4108c 52 &first_arg
dc93df4f 53 &hashify
7b84ff16 54 &interpolate
dc93df4f 55 &is_function_call
6f31806e 56 &is_hash_key
dc93df4f 57 &is_method_call
6f31806e
AL
58 &is_perl_builtin
59 &is_perl_global
dc93df4f 60 &is_script
6f31806e 61 &is_subroutine_name
bbf4108c 62 &is_unchecked_call
6f31806e 63 &parse_arg_list
dc93df4f
JRT
64 &policy_long_name
65 &policy_short_name
6f31806e 66 &precedence_of
0bcb38c0 67 &severity_to_number
bbf4108c 68 &shebang_line
dc93df4f 69 &verbosity_to_format
4a7a7227 70 &words_from_string
bbf4108c
ES
71);
72
7cb05702
JRT
73
74# Note: this is deprecated.
75our @EXPORT = @EXPORT_OK; ## no critic (ProhibitAutomaticExport)
76
5feaec1d 77
bbf4108c
ES
78our %EXPORT_TAGS = (
79 all => [ @EXPORT_OK ],
80 booleans => [ qw{ $TRUE $FALSE } ],
81 severities => [
82 qw{
83 $SEVERITY_HIGHEST
84 $SEVERITY_HIGH
85 $SEVERITY_MEDIUM
86 $SEVERITY_LOW
87 $SEVERITY_LOWEST
88 @SEVERITY_NAMES
89 }
90 ],
91 characters => [
92 qw{
93 $COLON
94 $COMMA
95 $DQUOTE
96 $EMPTY
97 $FATCOMMA
98 $PERIOD
99 $PIPE
100 $QUOTE
101 $SCOLON
102 $SPACE
103 $SLASH
104 $BSLASH
310e7cf9
ES
105 $LEFT_PAREN
106 $RIGHT_PAREN
bbf4108c
ES
107 }
108 ],
109 classification => [
110 qw{
111 &is_function_call
112 &is_hash_key
113 &is_method_call
114 &is_perl_builtin
115 &is_perl_global
116 &is_script
117 &is_subroutine_name
118 &is_unchecked_call
119 }
120 ],
121 data_conversion => [ qw{ &hashify &words_from_string &interpolate } ],
122 ppi => [ qw{ &first_arg &parse_arg_list } ],
123 internal_lookup => [ qw{ &severity_to_number &verbosity_to_format } ],
124 language => [ qw{ &precedence_of } ],
125 deprecated => [ qw{ &find_keywords } ],
59b05e08
JRT
126);
127
6036a254 128#-----------------------------------------------------------------------------
59b05e08 129
1fe8e187
JRT
130our $POLICY_NAMESPACE = 'Perl::Critic::Policy';
131
6036a254 132#-----------------------------------------------------------------------------
1fe8e187 133
7e86d49a
JRT
134our $SEVERITY_HIGHEST = 5;
135our $SEVERITY_HIGH = 4;
136our $SEVERITY_MEDIUM = 3;
137our $SEVERITY_LOW = 2;
138our $SEVERITY_LOWEST = 1;
dff08b70 139
6036a254 140#-----------------------------------------------------------------------------
6b4a61e9 141
310e7cf9
ES
142our $COMMA = q{,};
143our $FATCOMMA = q{=>};
144our $COLON = q{:};
145our $SCOLON = q{;};
146our $QUOTE = q{'};
147our $DQUOTE = q{"};
148our $PERIOD = q{.};
149our $PIPE = q{|};
150our $SPACE = q{ };
151our $SLASH = q{/};
152our $BSLASH = q{\\};
153our $LEFT_PAREN = q{(};
154our $RIGHT_PAREN = q{)};
155our $EMPTY = q{};
156our $TRUE = 1;
157our $FALSE = 0;
59b05e08 158
6036a254 159#-----------------------------------------------------------------------------
6b4a61e9 160
8d6b89b3
JRT
161#TODO: Should this include punctuations vars?
162
59b05e08 163
8d6b89b3 164
6036a254 165#-----------------------------------------------------------------------------
dc93df4f 166## no critic (ProhibitNoisyQuotes);
57973330 167
8d6b89b3 168my %PRECEDENCE_OF = (
d0dd0a1a
JRT
169 '->' => 1, '<' => 10, '//' => 15, '.=' => 19,
170 '++' => 2, '>' => 10, '||' => 15, '^=' => 19,
171 '--' => 2, '<=' => 10, '..' => 16, '<<=' => 19,
172 '**' => 3, '>=' => 10, '...' => 17, '>>=' => 19,
173 '!' => 4, 'lt' => 10, '?' => 18, ',' => 20,
174 '~' => 4, 'gt' => 10, ':' => 18, '=>' => 20,
175 '\\' => 4, 'le' => 10, '=' => 19, 'not' => 22,
176 '=~' => 5, 'ge' => 10, '+=' => 19, 'and' => 23,
177 '!~' => 5, '==' => 11, '-=' => 19, 'or' => 24,
178 '*' => 6, '!=' => 11, '*=' => 19, 'xor' => 24,
179 '/' => 6, '<=>' => 11, '/=' => 19,
180 '%' => 6, 'eq' => 11, '%=' => 19,
181 'x' => 6, 'ne' => 11, '||=' => 19,
182 '+' => 7, 'cmp' => 11, '&&=' => 19,
183 '-' => 7, '&' => 12, '|=' => 19,
184 '.' => 7, '|' => 13, '&=' => 19,
185 '<<' => 8, '^' => 13, '**=' => 19,
186 '>>' => 8, '&&' => 14, 'x=' => 19,
8d6b89b3
JRT
187);
188
57973330 189## use critic
7b84ff16 190#-----------------------------------------------------------------------------
8d6b89b3 191
3ffdaa3b
AL
192sub hashify {
193 return map { $_ => 1 } @_;
194}
195
7b84ff16
JRT
196#-----------------------------------------------------------------------------
197
198sub interpolate {
199 my ( $literal ) = @_;
200 return eval "\"$literal\""; ## no critic 'StringyEval';
201}
202
203#-----------------------------------------------------------------------------
3ffdaa3b 204
59b05e08
JRT
205sub find_keywords {
206 my ( $doc, $keyword ) = @_;
45acb16b
CD
207 my $nodes_ref = $doc->find('PPI::Token::Word');
208 return if !$nodes_ref;
59b05e08
JRT
209 my @matches = grep { $_ eq $keyword } @{$nodes_ref};
210 return @matches ? \@matches : undef;
211}
212
7b84ff16 213#-----------------------------------------------------------------------------
207c8eb0 214## no critic (ProhibitPackageVars)
dff08b70 215
e2d4c0f0
JRT
216my %BUILTINS = hashify( @B::Keywords::Functions );
217
8d6b89b3 218sub is_perl_builtin {
45acb16b
CD
219 my $elem = shift;
220 return if !$elem;
e2d4c0f0 221 my $name= eval {$elem->isa('PPI::Statement::Sub')} ? $elem->name() : $elem;
cf6f1e1f 222 return exists $BUILTINS{ $name };
8d6b89b3 223}
36f7994c 224
7b84ff16 225#-----------------------------------------------------------------------------
8d6b89b3 226
207c8eb0 227my @GLOBALS_WITHOUT_SIGILS = map { substr $_, 1 } @B::Keywords::Arrays,
e2d4c0f0
JRT
228 @B::Keywords::Hashes,
229 @B::Keywords::Scalars;
230
231my %GLOBALS= hashify( @GLOBALS_WITHOUT_SIGILS );
232
8d6b89b3 233sub is_perl_global {
45acb16b
CD
234 my $elem = shift;
235 return if !$elem;
3c71d40c
JRT
236 my $var_name = "$elem"; #Convert Token::Symbol to string
237 $var_name =~ s{\A [\$@%] }{}mx; #Chop off the sigil
238 return exists $GLOBALS{ $var_name };
8d6b89b3
JRT
239}
240
207c8eb0 241## use critic
7b84ff16 242#-----------------------------------------------------------------------------
8d6b89b3
JRT
243
244sub precedence_of {
45acb16b
CD
245 my $elem = shift;
246 return if !$elem;
3c71d40c 247 return $PRECEDENCE_OF{ ref $elem ? "$elem" : $elem };
8d6b89b3
JRT
248}
249
7b84ff16 250#-----------------------------------------------------------------------------
8d6b89b3 251
59b05e08
JRT
252sub is_hash_key {
253 my $elem = shift;
45acb16b 254 return if !$elem;
59b05e08
JRT
255
256 #Check curly-brace style: $hash{foo} = bar;
45acb16b
CD
257 my $parent = $elem->parent();
258 return if !$parent;
259 my $grandparent = $parent->parent();
260 return if !$grandparent;
59b05e08
JRT
261 return 1 if $grandparent->isa('PPI::Structure::Subscript');
262
263
264 #Check declarative style: %hash = (foo => bar);
45acb16b
CD
265 my $sib = $elem->snext_sibling();
266 return if !$sib;
59b05e08
JRT
267 return 1 if $sib->isa('PPI::Token::Operator') && $sib eq '=>';
268
45acb16b 269 return;
59b05e08
JRT
270}
271
7b84ff16 272#-----------------------------------------------------------------------------
dff08b70 273
59b05e08
JRT
274sub is_method_call {
275 my $elem = shift;
45acb16b
CD
276 return if !$elem;
277 my $sib = $elem->sprevious_sibling();
278 return if !$sib;
59b05e08
JRT
279 return $sib->isa('PPI::Token::Operator') && $sib eq q{->};
280}
281
7b84ff16 282#-----------------------------------------------------------------------------
dff08b70 283
0c377685
JRT
284sub is_subroutine_name {
285 my $elem = shift;
45acb16b
CD
286 return if !$elem;
287 my $sib = $elem->sprevious_sibling();
288 return if !$sib;
289 my $stmnt = $elem->statement();
290 return if !$stmnt;
0c377685
JRT
291 return $stmnt->isa('PPI::Statement::Sub') && $sib eq 'sub';
292}
293
7b84ff16 294#-----------------------------------------------------------------------------
0c377685 295
dc118d1b
JRT
296sub is_function_call {
297 my $elem = shift;
49131dfc
AL
298 return ! ( is_hash_key($elem) ||
299 is_method_call($elem) ||
beb9d1b5
CD
300 is_subroutine_name($elem) ||
301 $elem eq 'sub'
49131dfc 302 );
dc118d1b
JRT
303}
304
7b84ff16 305#-----------------------------------------------------------------------------
dc118d1b 306
dff08b70
JRT
307sub is_script {
308 my $doc = shift;
e992086d
AL
309
310 return shebang_line($doc) ? 1 : 0;
dff08b70
JRT
311}
312
7b84ff16 313#-----------------------------------------------------------------------------
dff08b70 314
dc93df4f 315sub policy_long_name {
1fe8e187
JRT
316 my ( $policy_name ) = @_;
317 if ( $policy_name !~ m{ \A $POLICY_NAMESPACE }mx ) {
318 $policy_name = $POLICY_NAMESPACE . q{::} . $policy_name;
dc93df4f
JRT
319 }
320 return $policy_name;
321}
322
7b84ff16 323#-----------------------------------------------------------------------------
dc93df4f
JRT
324
325sub policy_short_name {
1fe8e187
JRT
326 my ( $policy_name ) = @_;
327 $policy_name =~ s{\A $POLICY_NAMESPACE ::}{}mx;
dc93df4f
JRT
328 return $policy_name;
329}
330
7b84ff16 331#-----------------------------------------------------------------------------
dc93df4f 332
14a6a3ef
CD
333sub first_arg {
334 my $elem = shift;
335 my $sib = $elem->snext_sibling();
336 return if !$sib;
337
338 if ( $sib->isa('PPI::Structure::List') ) {
339
340 my $expr = $sib->schild(0);
341 return if !$expr;
342 return $expr->isa('PPI::Statement') ? $expr->schild(0) : $expr;
343 }
344
345 return $sib;
346}
347
348#-----------------------------------------------------------------------------
349
59b05e08
JRT
350sub parse_arg_list {
351 my $elem = shift;
45acb16b
CD
352 my $sib = $elem->snext_sibling();
353 return if !$sib;
59b05e08
JRT
354
355 if ( $sib->isa('PPI::Structure::List') ) {
356
0a6f07d0 357 #Pull siblings from list
45acb16b
CD
358 my $expr = $sib->schild(0);
359 return if !$expr;
0a6f07d0 360 return _split_nodes_on_comma( $expr->schildren() );
59b05e08
JRT
361 }
362 else {
363
0a6f07d0
AL
364 #Gather up remaining nodes in the statement
365 my $iter = $elem;
366 my @arg_list = ();
59b05e08 367
0a6f07d0
AL
368 while ($iter = $iter->snext_sibling() ) {
369 last if $iter->isa('PPI::Token::Structure') and $iter eq $SCOLON;
370 push @arg_list, $iter;
371 }
372 return _split_nodes_on_comma( @arg_list );
59b05e08
JRT
373 }
374}
375
dff08b70
JRT
376#---------------------------------
377
59b05e08
JRT
378sub _split_nodes_on_comma {
379 my @nodes = ();
380 my $i = 0;
381 for my $node (@_) {
6f31806e
AL
382 if ( $node->isa('PPI::Token::Operator') &&
383 (($node eq $COMMA) || ($node eq $FATCOMMA)) ) {
0a6f07d0
AL
384 $i++; #Move forward to next 'node stack'
385 next;
386 }
40ec8029 387 push @{ $nodes[$i] }, $node;
59b05e08
JRT
388 }
389 return @nodes;
390}
bf159007 391
8645eb2c
JRT
392#-----------------------------------------------------------------------------
393
4268e673
JRT
394my %FORMAT_OF = (
395 1 => "%f:%l:%c:%m\n",
396 2 => "%f: (%l:%c) %m\n",
b57cebc1
JRT
397 3 => "%m at %f line %l\n",
398 4 => "%m at line %l, column %c. %e. (Severity: %s)\n",
399 5 => "%f: %m at line %l, column %c. %e. (Severity: %s)\n",
400 6 => "%m at line %l, near '%r'. (Severity: %s)\n",
401 7 => "%f: %m at line %l near '%r'. (Severity: %s)\n",
402 8 => "[%p] %m at line %l, column %c. (Severity: %s)\n",
403 9 => "[%p] %m at line %l, near '%r'. (Severity: %s)\n",
404 10 => "%m at line %l, column %c.\n %p (Severity: %s)\n%d\n",
405 11 => "%m at line %l, near '%r'.\n %p (Severity: %s)\n%d\n",
4268e673
JRT
406);
407
9f6df1c1
JRT
408my $DEFAULT_FORMAT = $FORMAT_OF{4};
409
4268e673 410sub verbosity_to_format {
9f6df1c1
JRT
411 my ($verbosity) = @_;
412 return $DEFAULT_FORMAT if not defined $verbosity;
413 return $FORMAT_OF{abs int $verbosity} || $DEFAULT_FORMAT if _is_integer($verbosity);
414 return interpolate( $verbosity ); #Otherwise, treat as a format spec
4268e673
JRT
415}
416
9f6df1c1
JRT
417sub _is_integer { return $_[0] =~ m{ \A [+-]? \d+ \z }mx }
418
4268e673
JRT
419#-----------------------------------------------------------------------------
420
0bcb38c0
JRT
421my %SEVERITY_NUMBER_OF = (
422 gentle => 5,
423 stern => 4,
424 harsh => 3,
425 cruel => 2,
426 brutal => 1,
427);
428
429our @SEVERITY_NAMES = sort { $SEVERITY_NUMBER_OF{$a} <=> $SEVERITY_NUMBER_OF{$b} }
430 keys %SEVERITY_NUMBER_OF; #This is exported!
431
432sub severity_to_number {
433 my ($severity) = @_;
434 return _normalize_severity( $severity ) if _is_integer( $severity );
435 my $severity_number = $SEVERITY_NUMBER_OF{lc $severity};
436 confess qq{Invalid severity: "$severity"} if not defined $severity_number;
437 return $severity_number;
438}
439
440sub _normalize_severity {
441 my $s = shift || return $SEVERITY_HIGHEST;
442 $s = $s > $SEVERITY_HIGHEST ? $SEVERITY_HIGHEST : $s;
443 $s = $s < $SEVERITY_LOWEST ? $SEVERITY_LOWEST : $s;
444 return $s;
445}
446
447#-----------------------------------------------------------------------------
448
a91b8a46
AL
449my @skip_dir = qw( CVS RCS .svn _darcs {arch} .bzr _build blib );
450my %skip_dir = hashify( @skip_dir );
451
8645eb2c
JRT
452sub all_perl_files {
453
454 # Recursively searches a list of directories and returns the paths
455 # to files that seem to be Perl source code. This subroutine was
456 # poached from Test::Perl::Critic.
457
8645eb2c
JRT
458 my @queue = @_;
459 my @code_files = ();
460
461 while (@queue) {
462 my $file = shift @queue;
463 if ( -d $file ) {
464 opendir my ($dh), $file or next;
465 my @newfiles = sort readdir $dh;
466 closedir $dh;
467
468 @newfiles = File::Spec->no_upwards(@newfiles);
469 @newfiles = grep { !$skip_dir{$_} } @newfiles;
470 push @queue, map { File::Spec->catfile($file, $_) } @newfiles;
471 }
472
473 if ( (-f $file) && ! _is_backup($file) && _is_perl($file) ) {
474 push @code_files, $file;
475 }
476 }
477 return @code_files;
478}
479
480
481#-----------------------------------------------------------------------------
482# Decide if it's some sort of backup file
483
484sub _is_backup {
485 my ($file) = @_;
486 return 1 if $file =~ m{ [.] swp \z}mx;
487 return 1 if $file =~ m{ [.] bak \z}mx;
488 return 1 if $file =~ m{ ~ \z}mx;
489 return 1 if $file =~ m{ \A [#] .+ [#] \z}mx;
490 return;
491}
492
493#-----------------------------------------------------------------------------
494# Returns true if the argument ends with a perl-ish file
495# extension, or if it has a shebang-line containing 'perl' This
496# subroutine was also poached from Test::Perl::Critic
497
498sub _is_perl {
499 my ($file) = @_;
500
501 #Check filename extensions
502 return 1 if $file =~ m{ [.] PL \z}mx;
503 return 1 if $file =~ m{ [.] p (?: l|m ) \z}mx;
504 return 1 if $file =~ m{ [.] t \z}mx;
505
506 #Check for shebang
507 open my ($fh), '<', $file or return;
508 my $first = <$fh>;
9fb2d1dc 509 close $fh or confess "unable to close $file: $!";
8645eb2c 510
e2e7b907 511 return 1 if defined $first && ( $first =~ m{ \A \#![ ]*\S*perl }mx );
8645eb2c
JRT
512 return;
513}
514
6036a254 515#-----------------------------------------------------------------------------
bf159007 516
e2e7b907
CD
517sub shebang_line {
518 my $doc = shift;
519 my $first_comment = $doc->find_first('PPI::Token::Comment');
520 return if !$first_comment;
521 my $location = $first_comment->location();
522 return if !$location;
523 # The shebang must be the first two characters in the file, according to
524 # http://en.wikipedia.org/wiki/Shebang_(Unix)
525 return if $location->[0] != 1; # line number
526 return if $location->[1] != 1; # column number
527 my $shebang = $first_comment->content;
528 return if $shebang !~ m{ \A \#\! }mx;
529 return $shebang;
530}
531
6036a254 532#-----------------------------------------------------------------------------
e2e7b907 533
4a7a7227
AL
534sub words_from_string {
535 my $str = shift;
536
38e3d924 537 return split q{ }, $str; # This must be a literal space, not $SPACE
4a7a7227
AL
538}
539
9fb2d1dc
AM
540#-----------------------------------------------------------------------------
541
542sub is_unchecked_call {
543 my $elem = shift;
544
545 return if not is_function_call( $elem );
546
547 # check to see if there's an '=' or 'unless' or something before this.
548 if( my $sib = $elem->sprevious_sibling() ){
549 return if $sib;
550 }
551
552
553 if( my $statement = $elem->statement() ){
554
555 # "open or die" is OK.
556 # We can't check snext_sibling for 'or' since the next siblings are an
557 # unknown number of arguments to the system call. Instead, check all of
40647aca
JRT
558 # the elements to this statement to see if we find 'or' or '||'.
559
560 my $or_operators = sub {
561 my (undef, $elem) = @_;
562 return if not $elem->isa('PPI::Token::Operator');
0f1f4df7 563 return if $elem ne q{or} && $elem ne q{||};
40647aca
JRT
564 return 1;
565 };
566
567 return if $statement->find( $or_operators );
568
9fb2d1dc
AM
569
570 if( my $parent = $elem->statement()->parent() ){
571
40647aca 572 # Check if we're in an if( open ) {good} else {bad} condition
9fb2d1dc
AM
573 return if $parent->isa('PPI::Structure::Condition');
574
40647aca 575 # Return val could be captured in data structure and checked later
9fb2d1dc
AM
576 return if $parent->isa('PPI::Structure::Constructor');
577
578 # "die if not ( open() )" - It's in list context.
579 if ( $parent->isa('PPI::Structure::List') ) {
580 if( my $uncle = $parent->sprevious_sibling() ){
581 return if $uncle;
582 }
583 }
584 }
585 }
586
587 # Otherwise, return. this system call is unchecked.
588 return 1;
589}
590
4a7a7227 591
59b05e08
JRT
5921;
593
594__END__
595
dff08b70
JRT
596=pod
597
59b05e08
JRT
598=head1 NAME
599
600Perl::Critic::Utils - Utility subs and vars for Perl::Critic
601
602=head1 DESCRIPTION
603
bbf4108c
ES
604This module provides several static subs and variables that are useful for
605developing L<Perl::Critic::Policy> subclasses. Unless you are writing Policy
606modules, you probably don't care about this package.
59b05e08 607
bbf4108c 608=head1 IMPORTABLE SUBS
59b05e08
JRT
609
610=over 8
611
6d9feae6 612=item C<find_keywords( $doc, $keyword )>
59b05e08 613
bbf4108c
ES
614B<DEPRECATED:> Since version 0.11, every Policy is evaluated at each element
615of the document. So you shouldn't need to go looking for a particular
616keyword. If you I<do> want to use this, please import it via the
617C<:deprecated> tag, rather than directly, to mark the module as needing
618updating.
59b05e08 619
6d9feae6 620Given a L<PPI::Document> as C<$doc>, returns a reference to an array
bbf4108c
ES
621containing all the L<PPI::Token::Word> elements that match C<$keyword>. This
622can be used to find any built-in function, method call, bareword, or reserved
623keyword. It will not match variables, subroutine names, literal strings,
624numbers, or symbols. If the document doesn't contain any matches, returns
625undef.
59b05e08 626
8d6b89b3
JRT
627=item C<is_perl_global( $element )>
628
3c71d40c 629Given a L<PPI::Token::Symbol> or a string, returns true if that token
bbf4108c
ES
630represents one of the global variables provided by the L<English> module, or
631one of the builtin global variables like C<%SIG>, C<%ENV>, or C<@ARGV>. The
632sigil on the symbol is ignored, so things like C<$ARGV> or C<$ENV> will still
633return true.
8d6b89b3
JRT
634
635=item C<is_perl_builtin( $element )>
636
bbf4108c
ES
637Given a L<PPI::Token::Word> or a string, returns true if that token represents
638a call to any of the builtin functions defined in Perl 5.8.8
8d6b89b3
JRT
639
640=item C<precedence_of( $element )>
641
bbf4108c
ES
642Given a L<PPI::Token::Operator> or a string, returns the precedence of the
643operator, where 1 is the highest precedence. Returns undef if the precedence
644can't be determined (which is usually because it is not an operator).
8d6b89b3 645
6d9feae6 646=item C<is_hash_key( $element )>
59b05e08 647
bbf4108c
ES
648Given a L<PPI::Element>, returns true if the element is a hash key. PPI
649doesn't distinguish between regular barewords (like keywords or subroutine
650calls) and barewords in hash subscripts (which are considered literal). So
651this subroutine is useful if your Policy is searching for L<PPI::Token::Word>
652elements and you want to filter out the hash subscript variety. In both of
653the following examples, 'foo' is considered a hash key:
59b05e08
JRT
654
655 $hash1{foo} = 1;
656 %hash2 = (foo => 1);
657
6d9feae6 658=item C<is_method_call( $element )>
59b05e08 659
bbf4108c
ES
660Given a L<PPI::Element> that is presumed to be a function call (which is
661usually a L<PPI::Token::Word>), returns true if the function is a method being
662called on some reference. Basically, it just looks to see if the preceding
663operator is "->". This is useful for distinguishing static function calls
664from object method calls.
59b05e08 665
0c377685
JRT
666=item C<is_subroutine_name( $element )>
667
bbf4108c
ES
668Given a L<PPI::Token::Word>, returns true if the element is the name of a
669subroutine declaration. This is useful for distinguishing barewords and from
670function calls from subroutine declarations.
0c377685 671
dc118d1b
JRT
672=item C<is_function_call( $element )>
673
bbf4108c
ES
674Given a L<PPI::Token::Word> returns true if the element appears to be call to
675a static function. Specifically, this function returns true if
676C<is_hash_key>, C<is_method_call>, and C<is_subroutine_name> all return false
677for the given element.
dc118d1b 678
14a6a3ef
CD
679=item C<first_arg( $element )>
680
681Given a L<PPI::Element> that is presumed to be a function call (which is
bbf4108c
ES
682usually a L<PPI::Token::Word>), return the first argument. This is similar of
683C<parse_arg_list()> and follows the same logic. Note that for the code:
14a6a3ef
CD
684
685 int($x + 0.5)
686
687this function will return just the C<$x>, not the whole expression. This is
688different from the behavior of C<parse_arg_list()>. Another caveat is:
689
690 int(($x + $y) + 0.5)
691
692which returns C<($x + $y)> as a L<PPI::Structure::List> instance.
693
6d9feae6 694=item C<parse_arg_list( $element )>
59b05e08 695
bbf4108c
ES
696Given a L<PPI::Element> that is presumed to be a function call (which is
697usually a L<PPI::Token::Word>), splits the argument expressions into arrays of
698tokens. Returns a list containing references to each of those arrays. This
699is useful because parens are optional when calling a function, and PPI parses
700them very differently. So this method is a poor-man's parse tree of PPI
701nodes. It's not bullet-proof because it doesn't respect precedence. In
702general, I don't like the way this function works, so don't count on it to be
703stable (or even present).
59b05e08 704
6d9feae6 705=item C<is_script( $document )>
bf159007 706
bbf4108c
ES
707Given a L<PPI::Document>, test if it starts with C</#!.*/>. If so, it is
708judged to be a script instead of a module. See C<shebang_line()>.
bf159007 709
bbf4108c 710=item C< policy_long_name( $policy_name ) >
dc93df4f 711
bbf4108c
ES
712Given a policy class name in long or short form, return the long form.
713
714=item C< policy_short_name( $policy_name ) >
715
716Given a policy class name in long or short form, return the short form.
dc93df4f 717
8645eb2c
JRT
718=item C<all_perl_files( @directories )>
719
bbf4108c
ES
720Given a list of directories, recursively searches through all the directories
721(depth first) and returns a list of paths for all the files that are Perl code
722files. Any administrative files for CVS or Subversion are skipped, as are
723things that look like temporary or backup files.
8645eb2c
JRT
724
725A Perl code file is:
726
727=over 4
728
729=item * Any file that ends in F<.PL>, F<.pl>, F<.pm>, or F<.t>
730
731=item * Any file that has a first line with a shebang containing 'perl'
732
733=back
734
0bcb38c0
JRT
735=item C<severity_to_number( $severity )>
736
737If C<$severity> is given as an integer, this function returns C<$severity> but
738normalized to lie between C<$SEVERITY_LOWEST> and C<$SEVERITY_HIGHEST>. If
739C<$severity> is given as a string, this function returns the corresponding
740severity number. If the string doesn't have a corresponding number, this
741function will throw an exception.
742
4268e673
JRT
743=item C<verbosity_to_format( $verbosity_level )>
744
bbf4108c
ES
745Given a verbosity level between 1 and 10, returns the corresponding predefined
746format string. These formats are suitable for passing to the C<set_format>
747method in L<Perl::Critic::Violation>. See the L<perlcritic> documentation for
748a listing of the predefined formats.
4268e673 749
3ffdaa3b
AL
750=item C<hashify( @list )>
751
bbf4108c
ES
752Given C<@list>, return a hash where C<@list> is in the keys and each value is
7531. Duplicate values in C<@list> are silently squished.
7b84ff16
JRT
754
755=item C<interpolate( $literal )>
756
bbf4108c
ES
757Given a C<$literal> string that may contain control characters (e.g.. '\t'
758'\n'), this function does a double interpolation on the string and returns it
759as if it had been declared in double quotes. For example:
7b84ff16
JRT
760
761 'foo \t bar \n' ...becomes... "foo \t bar \n"
3ffdaa3b 762
e2e7b907
CD
763=item C<shebang_line( $document )>
764
bbf4108c
ES
765Given a L<PPI::Document>, test if it starts with C<#!>. If so, return that
766line. Otherwise return undef.
e2e7b907 767
4a7a7227
AL
768=item C<words_from_string( $str )>
769
bbf4108c
ES
770Given config string I<$str>, return all the words from the string. This is
771safer than splitting on whitespace.
4a7a7227 772
9fb2d1dc
AM
773=item C<is_unchecked_call( $element )>
774
775Given a L<PPI::Element>, test to see if it contains a function call whose
776return value is not checked.
777
59b05e08
JRT
778=back
779
bbf4108c 780=head1 IMPORTABLE VARIABLES
59b05e08
JRT
781
782=over 8
783
6d9feae6 784=item C<$COMMA>
59b05e08 785
a3adb7a9
AL
786=item C<$FATCOMMA>
787
6d9feae6 788=item C<$COLON>
59b05e08 789
6d9feae6 790=item C<$SCOLON>
59b05e08 791
6d9feae6 792=item C<$QUOTE>
59b05e08 793
6d9feae6 794=item C<$DQUOTE>
59b05e08 795
6d9feae6 796=item C<$PERIOD>
59b05e08 797
6d9feae6 798=item C<$PIPE>
59b05e08 799
6d9feae6 800=item C<$EMPTY>
59b05e08 801
6d9feae6 802=item C<$SPACE>
59b05e08 803
a609ec83
ES
804=item C<$SLASH>
805
806=item C<$BSLASH>
807
310e7cf9
ES
808=item C<$LEFT_PAREN>
809
810=item C<$RIGHT_PAREN>
811
bbf4108c
ES
812These character constants give clear names to commonly-used strings that can
813be hard to read when surrounded by quotes and other punctuation. Can be
814imported in one go via the C<:characters> tag.
dff08b70 815
6d9feae6 816=item C<$SEVERITY_HIGHEST>
dff08b70 817
6d9feae6 818=item C<$SEVERITY_HIGH>
dff08b70 819
6d9feae6 820=item C<$SEVERITY_MEDIUM>
dff08b70 821
6d9feae6 822=item C<$SEVERITY_LOW>
dff08b70 823
6d9feae6 824=item C<$SEVERITY_LOWEST>
dff08b70 825
7e86d49a 826These numeric constants define the relative severity of violating each
bbf4108c
ES
827L<Perl::Critic::Policy>. The C<get_severity> and C<default_severity> methods
828of every Policy subclass must return one of these values. Can be imported via
829the C<:severities> tag.
dff08b70 830
6d9feae6 831=item C<$TRUE>
59b05e08 832
6d9feae6 833=item C<$FALSE>
59b05e08
JRT
834
835These are simple booleans. 1 and 0 respectively. Be mindful of using these
bbf4108c
ES
836with string equality. C<$FALSE ne $EMPTY>. Can be imported via the
837C<:booleans> tag.
838
839=back
840
841=head1 IMPORT TAGS
842
843The following groups of functions and constants are available as parameters to
844a C<use Perl::Critic::Util> statement.
845
846=over
847
848=item C<:all>
849
850The lot.
851
852=item C<:booleans>
853
854Includes:
855C<$TRUE>, C<$FALSE>
856
857=item C<:severities>
858
859Includes:
860C<$SEVERITY_HIGHEST>,
861C<$SEVERITY_HIGH>,
862C<$SEVERITY_MEDIUM>,
863C<$SEVERITY_LOW>,
864C<$SEVERITY_LOWEST>,
865C<@SEVERITY_NAMES>
866
867=item C<:characters>
868
869Includes:
870C<$COLON>,
871C<$COMMA>,
872C<$DQUOTE>,
873C<$EMPTY>,
874C<$FATCOMMA>,
875C<$PERIOD>,
876C<$PIPE>,
877C<$QUOTE>,
878C<$SCOLON>,
879C<$SPACE>,
880C<$SLASH>,
881C<$BSLASH>
310e7cf9
ES
882C<$LEFT_PAREN>
883C<$RIGHT_PAREN>
bbf4108c
ES
884
885=item C<:classification>
886
887Includes:
888C<&is_function_call>,
889C<&is_hash_key>,
890C<&is_method_call>,
891C<&is_perl_builtin>,
892C<&is_perl_global>,
893C<&is_script>,
894C<&is_subroutine_name>,
895C<&is_unchecked_call>
896
897=item C<:data_conversion>
898
899Generic manipulation, not having anything specific to do with Perl::Critic.
900
901Includes:
902C<&hashify>,
903C<&words_from_string>,
904C<&interpolate>
905
906=item C<:ppi>
907
908Things for dealing with L<PPI>, other than classification.
909
910Includes:
911C<&first_arg>,
912C<&parse_arg_list>
913
914=item C<:internal_lookup>
915
916Translations between internal representations.
917
918Includes:
919C<&severity_to_number>,
920C<&verbosity_to_format>
921
922=item C<:language>
923
924Information about Perl not programmatically available elsewhere.
925
926Includes:
927C<&precedence_of>
928
929=item C<:deprecated>
930
931Not surprisingly, things that are deprecated. It is preferred to use this tag
932to get to these functions, rather than the function names themselves, so as to
933mark any module using them as needing cleanup.
934
935Includes:
936C<&find_keywords>
59b05e08
JRT
937
938=back
939
940=head1 AUTHOR
941
942Jeffrey Ryan Thalhammer <thaljef@cpan.org>
943
944=head1 COPYRIGHT
945
0d5b2dca 946Copyright (c) 2005-2007 Jeffrey Ryan Thalhammer. All rights reserved.
59b05e08
JRT
947
948This program is free software; you can redistribute it and/or modify
949it under the same terms as Perl itself. The full text of this license
950can be found in the LICENSE file included with this module.
dff08b70
JRT
951
952=cut
737d3b65
CD
953
954# Local Variables:
955# mode: cperl
956# cperl-indent-level: 4
957# fill-column: 78
958# indent-tabs-mode: nil
959# c-indentation-style: bsd
960# End:
345c7562 961# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab :