File Coverage

blib/lib/Variable/Strongly/Typed/Code.pm

Criterion	Covered	Total	%
statement	41	50	82.0
branch	0	4	0.0
condition			n/a
subroutine	10	11	90.9
pod	0	1	0.0
total	51	66	77.2

package Variable::Strongly::Typed::Code;

use version; $VERSION = qv('1.0.0');

use warnings;
use strict;
use Carp;

use base qw(Variable::Strongly::Typed);

{
    sub new {
        my($class, $symbol, $referent, $type) = @_;

        my $self = bless \my($anon_scalar), $class;

        my $full_sub_name = $$symbol;
        $full_sub_name =~ s/^\*//;
        my $sub_ref = do { no strict 'refs'; *{$full_sub_name}{CODE} };

        $self->_init($sub_ref, $type);

        my $checked_sub = $self->_make_checker_for;

        # Install it
        {
            no strict 'refs';
            no warnings 'redefine';
            *{$full_sub_name} = $checked_sub;
        }

        return;
    }

    sub _make_checker_for {
        my($self) = @_;

        my $valid_type = $self->_get_type;
        my $original_sub = $self->_get_object;

        return sub {
            # Call $original_sub correctly

            if (!defined wantarray) {
                $self->_error("Throwing away return value of $valid_type");
            }

            if (wantarray) {
                my @ret = $original_sub->(@_);
                $self->_check_values(@ret);
                return @ret;
            } else {
                my $ret = $original_sub->(@_);
                $self->_check_values($ret);
                return $ret;
            }
        }
    }
}

1;

__END__