File Coverage

lib/PPIx/Element/Sub.pm
Criterion Covered Total %
statement 35 35 100.0
branch 18 18 100.0
condition 9 9 100.0
subroutine 8 8 100.0
pod 3 3 100.0
total 73 73 100.0


line stmt bran cond sub pod time code
1 16     16   355802 use 5.006; # our
  16         60  
2 16     16   167 use strict;
  16         33  
  16         363  
3 16     16   98 use warnings;
  16         45  
  16         1549  
4              
5             package PPIx::Element::Sub;
6              
7             our $VERSION = '0.001000'; # TRIAL
8              
9             # ABSTRACT: Find subroutines associated with any element.
10              
11             our $AUTHORITY = 'cpan:KENTNL'; # AUTHORITY
12              
13             our @EXPORT_OK = qw( identify_sub identify_next_sub identify_associated_sub );
14              
15 16     16   84 use Exporter 5.57 qw( import );
  16         276  
  16         539  
16 16     16   84 use Scalar::Util qw( refaddr );
  16         30  
  16         7063  
17              
18             sub identify_sub {
19 108     108 1 2022625 my ($element) = @_;
20              
21             # any contains itself.
22 108 100       627 return $element if $element->isa('PPI::Statement::Sub');
23              
24             # no parents => can't find a sub => must be main execution
25 94 100 100     770 return unless $element->can('parent') and defined( my $parent = $element->parent );
26              
27             # If we have a parent, ask it for which sub we're in.
28 76         836 return identify_sub($parent);
29             }
30              
31             sub identify_next_sub {
32 81     81 1 10273 my ($element) = @_;
33              
34             # Parentless nodes can't have siblings
35 81 100 100     506 return unless $element->can('parent') and defined( my $parent = $element->parent );
36              
37             # parents without children can't give us siblings
38             # but *their* parents could
39 65 100       796 return identify_next_sub($parent) unless $parent->can('children');
40              
41 64         154 my $own_addr = refaddr($element);
42 64         84 my $seen_self = 0;
43              
44             # Search direct siblings deeply
45 64         196 for my $sibling ( $parent->children ) {
46              
47             # Iterate forwards until self is found.
48 200 100       2258 if ( not $seen_self ) {
49 145 100       454 $seen_self = 1 if refaddr($sibling) eq $own_addr;
50 145         220 next;
51             }
52              
53             # For successive siblings
54             # return the first sub found
55 55 100       299 return $sibling if $sibling->isa('PPI::Statement::Sub');
56              
57             # If a sibling has children, a sub could be one of them
58             # note: a false value == fail, but explit undef is invalid query
59 48 100 100     341 if ( $sibling->can('find_first') and my $result = $sibling->find_first('PPI::Statement::Sub') ) {
60 2         1286 return $result;
61             }
62             }
63              
64             # When no sibling is a sub, assume that the sub is further down
65             # the document, making it a sibling that succeeds a parent, or a descendent
66             # of a parents sibling.
67 55         213 return identify_next_sub($parent);
68             }
69              
70             sub identify_associated_sub {
71 16     16 1 7126 my ($element) = @_;
72              
73             # First, resolve to the containers, as all comments inside a
74             # sub are related to the sub itself
75 16 100       73 if ( my $parent = identify_sub($element) ) {
76 7         21 return $parent;
77             }
78              
79             # Otherwise, look into the next-sibling tree to find the subsequent sub
80 9         119 return identify_next_sub($element);
81             }
82              
83             1;
84              
85             __END__