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

use 5.006;    # our
use strict;
use warnings;

package PPIx::Element::Sub;

our $VERSION = '0.001000'; # TRIAL

# ABSTRACT: Find subroutines associated with any element.

our $AUTHORITY = 'cpan:KENTNL'; # AUTHORITY

our @EXPORT_OK = qw( identify_sub identify_next_sub identify_associated_sub );

use Exporter 5.57 qw( import );
use Scalar::Util qw( refaddr );

sub identify_sub {
    my ($element) = @_;

    # any  contains itself.
    return $element if $element->isa('PPI::Statement::Sub');

    # no parents => can't find a sub => must be main execution
    return unless $element->can('parent') and defined( my $parent = $element->parent );

    # If we have a parent, ask it for which sub we're in.
    return identify_sub($parent);
}

sub identify_next_sub {
    my ($element) = @_;

    # Parentless nodes can't have siblings
    return unless $element->can('parent') and defined( my $parent = $element->parent );

    # parents without children can't give us siblings
    # but *their* parents could
    return identify_next_sub($parent) unless $parent->can('children');

    my $own_addr  = refaddr($element);
    my $seen_self = 0;

    # Search direct siblings deeply
    for my $sibling ( $parent->children ) {

        # Iterate forwards until self is found.
        if ( not $seen_self ) {
            $seen_self = 1 if refaddr($sibling) eq $own_addr;
            next;
        }

        # For successive siblings
        # return the first sub found
        return $sibling if $sibling->isa('PPI::Statement::Sub');

        # If a sibling has children, a sub could be one of them
        # note: a false value == fail, but explit undef is invalid query
        if ( $sibling->can('find_first') and my $result = $sibling->find_first('PPI::Statement::Sub') ) {
            return $result;
        }
    }

    # When no sibling is a sub, assume that the sub is further down
    # the document, making it a sibling that succeeds a parent, or a descendent
    # of a parents sibling.
    return identify_next_sub($parent);
}

sub identify_associated_sub {
    my ($element) = @_;

    # First, resolve to the containers, as all comments inside a
    # sub are related to the sub itself
    if ( my $parent = identify_sub($element) ) {
        return $parent;
    }

    # Otherwise, look into the next-sibling tree to find the subsequent sub
    return identify_next_sub($element);
}

1;

__END__