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