4 # Walk through a perl script and look for 'naughty match variables'
5 # $`, $&, and $', which may cause poor performance.
8 # find_naughty file1 [file2 [...]]
9 # find_naughty <file.pl
11 # Author: Steve Hancock, July 2003
14 # - recursive processing might be nice
16 # Inspired by the discussion of naughty match variables at:
17 # http://www.perlmonks.org/index.pl?node_id=276549
25 find_naughty file1 [file2 [...]]
28 getopts('h') or die "$usage";
29 if ($opt_h) { die $usage }
31 unless (@ARGV) { unshift @ARGV, '-' } # stdin
32 foreach my $source (@ARGV) {
33 PerlTokenSearch::find_naughty(
38 #####################################################################
40 # The PerlTokenSearch package is an interface to perltidy which accepts a
41 # source filehandle and looks for selected variables.
43 # It works by making a a callback object with a write_line() method to
44 # receive tokenized lines from perltidy.
48 # PerlTokenSearch::find_naughty(
49 # _source => $fh, # required source
52 # _source is any source that perltidy will accept, including a
53 # filehandle or reference to SCALAR or ARRAY
55 #####################################################################
57 package PerlTokenSearch;
64 print "Testing File: $args{_source}\n";
66 # run perltidy, which will call $formatter's write_line() for each line
68 'source' => $args{_source},
69 'formatter' => bless( \%args, __PACKAGE__ ), # callback object
70 'argv' => "-npro -se", # -npro : ignore .perltidyrc,
71 # -se : errors to STDOUT
77 # This is called back from perltidy line-by-line
78 # We're looking for $`, $&, and $'
79 my ( $self, $line_of_tokens ) = @_;
80 my $source = $self->{_source};
82 # pull out some stuff we might need
83 my $line_type = $line_of_tokens->{_line_type};
84 my $input_line_number = $line_of_tokens->{_line_number};
85 my $input_line = $line_of_tokens->{_line_text};
86 my $rtoken_type = $line_of_tokens->{_rtoken_type};
87 my $rtokens = $line_of_tokens->{_rtokens};
90 # skip comments, pod, etc
91 return if ( $line_type ne 'CODE' );
93 # loop over tokens looking for $`, $&, and $'
94 for ( my $j = 0 ; $j < @$rtoken_type ; $j++ ) {
96 # we only want to examine token types 'i' (identifier)
97 next unless $$rtoken_type[$j] eq 'i';
99 # pull out the actual token text
100 my $token = $$rtokens[$j];
103 if ( $token =~ /^\$[\`\&\']$/ ) {
105 "$source:$input_line_number: $token\n";
110 # optional routine, called once after the last line of a file
111 sub finish_formatting {