File Coverage

blib/lib/App/FindCallers.pm
Criterion Covered Total %
statement 28 42 66.6
branch 6 12 50.0
condition 4 7 57.1
subroutine 7 10 70.0
pod 0 3 0.0
total 45 74 60.8


line stmt bran cond sub pod time code
1             package App::FindCallers;
2             # ABSTRACT: Find the callers of a given function in a directory tree
3              
4             our $VERSION = '0.04';
5              
6 1     1   16611 use 5.010;
  1         3  
7 1     1   4 use strict;
  1         1  
  1         18  
8 1     1   4 use warnings;
  1         5  
  1         29  
9              
10 1     1   3 use File::Find;
  1         2  
  1         72  
11 1     1   529 use PPI;
  1         109204  
  1         331  
12              
13             sub report {
14 0     0 0 0 my ($filename, $f, $nestlevel) = @_;
15 0         0 my $indent = " " x $nestlevel;
16 0         0 my $message = "Called from";
17 0 0       0 if ($nestlevel) {
18 0         0 $message = "Defined in"
19             }
20 0         0 my $location = $filename . ":" . $f->line_number;
21              
22 0         0 printf "%s%s %s() in %s\n", $indent, $message, $f->name, $location;
23             }
24              
25             sub find_in_file {
26 1     1 0 20 my ($function, $filename, $cb) = @_;
27 1   50     4 $cb ||= \&report;
28 1         14 my $document = PPI::Document->new($filename);
29 1 50       5973 unless ($document) {
30 0         0 say "Failed to parse $filename " . PPI::Document->errstr;
31 0         0 return;
32             }
33 1         5 $document->index_locations;
34             my $references = $document->find(sub {
35 68 100   68   629 $_[1]->isa('PPI::Token::Word') and $_[1]->content eq $function
36 1         1040 });
37 1 50       14 return unless $references;
38 1         2 for my $f (@$references) {
39 3         12 my $nestlevel = 0;
40 3         12 while ($f = $f->parent) {
41             # XXX this makes skip the declaration of said sub,
42             # but also makes it not detect recursive calls
43 14 100 100     154 if ($f->isa('PPI::Statement::Sub') and $f->name ne $function) {
44 4         85 $cb->($filename, $f, $nestlevel);
45 4         2616 $nestlevel++;
46             }
47             };
48             }
49             }
50              
51             sub main {
52 0     0 0   my ($funcname, $directory, $cb) = @_;
53 0   0       $directory ||= '.';
54             find({ wanted => sub {
55 0 0   0     if (/\.p[lm]$/) {
56 0           find_in_file $funcname, $_;
57             }
58 0           }, follow => 1, no_chdir => 1 }, $directory);
59             }
60              
61             1;
62              
63             __END__