File Coverage

blib/lib/Devel/Chitin/SubroutineLocation.pm

Criterion	Covered	Total	%
statement	15	27	55.5
branch	0	4	0.0
condition	0	9	0.0
subroutine	5	8	62.5
pod	0	2	0.0
total	20	50	40.0

package Devel::Chitin::SubroutineLocation;

use strict;
use warnings;

our $VERSION = '0.15';

use Carp;

my @properties = qw(package subroutine line filename end code source source_line);
foreach my $prop ( @properties ) {
    my $sub = sub { shift->{$prop} };
    no strict 'refs';
    *$prop = $sub;
}

sub new {
    my($class, %props) = @_;

    foreach my $prop ( @properties ) {
        Carp::croak("$prop is a required property") unless (exists $props{$prop});
    }

    return bless \%props, $class;
}

sub new_from_db_sub {
    my($class, $subname) = @_;

    return () unless (defined($subname) and $DB::sub{$subname});
    my($filename, $line, $end) = $DB::sub{$subname} =~ m/(.*):(\d+)-(\d+)$/;
    my($source, $source_line) = $filename =~ m/\[(.*):(\d+)\]$/;
    my $glob = do {
        no strict 'refs';
        \*$subname;
    };
    return Devel::Chitin::SubroutineLocation->new(
            filename    => $filename,
            line        => $line,
            end         => $end,
            source      => $source || $filename,
            source_line => $source_line || $line,
            subroutine  => *$glob{NAME},
            package     => *$glob{PACKAGE},
            code        => *$glob{CODE} );
}

1;

__END__