File Coverage

blib/lib/Sub/Info.pm

Criterion	Covered	Total	%
statement	38	38	100.0
branch	11	14	78.5
condition	2	3	66.6
subroutine	6	6	100.0
pod	1	1	100.0
total	58	62	93.5

package Sub::Info;
use strict;
use warnings;

our $VERSION = '0.001';

use Carp qw/croak/;
use B();

use Importer Importer => 'import';
our @EXPORT_OK = qw{ sub_info };

sub sub_info {
    my ($sub, @all_lines) = @_;
    my %in = map {$_ => 1} @all_lines;

    croak "sub_info requires a coderef as its first argument"
        unless ref($sub) eq 'CODE';

    my $cobj    = B::svref_2object($sub);
    my $name    = $cobj->GV->NAME;
    my $file    = $cobj->FILE;
    my $package = $cobj->GV->STASH->NAME;

    my $op = $cobj->START;
    while ($op) {
        push @all_lines => $op->line if $op->can('line');
        last unless $op->can('next');
        $op = $op->next;
    }

    my ($start, $end, @lines);
    if (@all_lines) {
        @all_lines = sort { $a <=> $b } @all_lines;
        ($start, $end) = ($all_lines[0], $all_lines[-1]);

        # Adjust start and end for the most common case of a multi-line block with
        # parens on the lines before and after.
        if ($start < $end) {
            $start-- unless $start <= 1 || $in{$start};
            $end++   unless $in{$end};
        }
        @lines = ($start, $end);
    }

    return {
        ref        => $sub,
        cobj       => $cobj,
        name       => $name,
        file       => $file,
        package    => $package,
        start_line => $start,
        end_line   => $end,
        all_lines  => \@all_lines,
        lines      => \@lines,
    };
}

1;

__END__