File Coverage

blib/lib/Perl6/Caller.pm

Criterion	Covered	Total	%
statement	35	35	100.0
branch	5	6	83.3
condition	4	6	66.6
subroutine	10	10	100.0
pod	1	2	50.0
total	55	59	93.2

package Perl6::Caller;

use warnings;
use strict;

our $VERSION = '0.100';
$VERSION = eval $VERSION;

use overload '""' => \&package, fallback => 1;

sub import {
    my ($class) = @_;
    my $callpack = caller;
    no strict 'refs';
    *{"$callpack\::caller"} = \&caller;
}

sub caller {
    my $thing = shift || 0;
    my $frame =
      __PACKAGE__ eq $thing
      ? ( shift || 0 )
      : $thing;
    return __PACKAGE__->new($frame);
}

my @methods;

BEGIN {
    @methods = qw/package filename line subroutine hasargs
      wantarray evaltext is_require/;
    foreach my $method (@methods) {
        no strict 'refs';
        *$method = sub {
            my ( $self, $frame ) = @_;
            return $self->{$method};
        };
    }
}

sub new {
    my $class = shift;
    my $frame = @_ ? (shift || 0) : -1;
    $frame += 2;

    my $self = bless {} => __PACKAGE__;
    my @caller = CORE::caller($frame);
    return @caller if CORE::wantarray;
    @$self{@methods} = @caller;
    return $self;
}

1;

__END__