File Coverage

blib/lib/Test/Kantan/Caller.pm

Criterion	Covered	Total	%
statement	37	42	88.1
branch	4	8	50.0
condition	5	6	83.3
subroutine	9	13	69.2
pod	5	5	100.0
total	60	74	81.0

package Test::Kantan::Caller;
use strict;
use warnings;
use utf8;
use 5.010_001;

use Cwd ();
use File::Spec;

our $BASE_DIR = Cwd::getcwd();
our %FILECACHE;

sub package { shift->{package} }
sub filename { shift->{filename} }
sub line { shift->{line} }
sub code { shift->{code} }

sub new {
    my $class = shift;

    my $level   = shift || 0;
    my $binmode = shift || '<:encoding(utf-8)';

    my ($package, $filename, $line) = caller($level+1);
    return unless defined($package);

    my $code = sub {
        undef $filename if $filename eq '-e';
        if (defined $filename) {
            my $abs_filename = File::Spec->rel2abs($filename, $BASE_DIR);
            my $file = $FILECACHE{$abs_filename} ||= [
                do {
                    # Do not die if we can't open the file
                    open my $fh, $binmode, $abs_filename
                        or return '';
                    <$fh>
                }
            ];
            my $code = $file->[ $line - 1 ];
            $code =~ s{^\s+|\s+$}{}g;
            $code;
        } else {
            "";
        }
    }->();
    return bless +{
        package  => $package,
        filename => $filename,
        line     => $line,
        code     => $code,
    }, $class;
}

1;
__END__