File Coverage

blib/lib/T2.pm

Criterion	Covered	Total	%
statement	38	318	11.9
branch	13	212	6.1
condition	3	279	1.0
subroutine	7	99	7.0
pod	0	94	0.0
total	61	1002	6.0

package T2;
use strict;
use warnings;

our $VERSION = '0.002';

my $INIT;
my $HANDLE;
sub handle { $HANDLE }

sub import {
    my $class = shift;
    my ($handle) = @_;

    my ($caller, $file, $line) = caller;

    die "The ${ \__PACKAGE__ } namespace has already been initialized (Originally initiated at $INIT->[1] line $INIT->[2]) at $file line $line.\n"
        if $INIT;

    unless ($handle) {
        die "The '$caller' package does not provide a T2 handler at $file line $line.\n"
            unless $caller->can('T2');

        $handle = $caller->T2 or die "Could not get handle via '$caller\->T2()' at $file line $line.\n";
    }

    die "'$handle' is not a Test2::Handle instance at $file line $line.\n"
        unless $handle->isa('Test2::Handle');

    $INIT = [$caller, $file, $line];
    $HANDLE = $handle;

    for my $sym ($HANDLE->HANDLE_SUBS) {
        next if $sym eq 'import';
        next if $sym eq 'handle';

        my $code = $HANDLE->HANDLE_NAMESPACE->can($sym);
        my $proto = prototype($code);

        my $header = defined($proto) ? "sub $sym($proto) {" : "sub $sym {";

        my $line = __LINE__ + 3;
        my $sub = eval <<"        EOT" or die $@;
#line $line ${ \__FILE__ }
$header
    my (\$f) = \@_;
    shift if \$f && "\$f" eq "$class";
    goto &\$code;
};

\\&$sym;
        EOT

        no strict 'refs';
        *$sym = $sub;
    }
}

sub AUTOLOAD {
    my ($this) = @_;

    if ($this) {
        shift if "$this" eq 'T2';
        shift if ref($this) eq 'T2';
    }

    my ($name) = (our $AUTOLOAD =~ m/^(?:.*::)?([^:]+)$/);

    my @caller = caller;
    my $sub = $HANDLE->HANDLE_NAMESPACE->can($name) or die qq{"$name" is not provided by this T2 handle at $caller[1] line $caller[2].\n};
    goto &$sub;
}

1;

__END__