File Coverage

blib/lib/Return/Type/Lexical.pm

Criterion	Covered	Total	%
statement	28	28	100.0
branch	5	6	83.3
condition	5	6	83.3
subroutine	10	10	100.0
pod	0	1	0.0
total	48	51	94.1

package Return::Type::Lexical;
# ABSTRACT: Same thing as Return::Type, but lexical

use 5.008;
use warnings;
use strict;

use parent 'Return::Type';

our $VERSION = '0.002'; # VERSION

sub import {
    my ($class, %args) = @_;
    $^H{'Return::Type::Lexical/in_effect'} = exists $args{check} && !$args{check} ? 0 : 1;
}

sub unimport {
    $^H{'Return::Type::Lexical/in_effect'} = 0;
}

sub _in_effect {
    my ($level) = @_;
    $level = 0 if !defined $level;
    my $hinthash = (caller($level))[10];
    my $in_effect = $hinthash->{'Return::Type::Lexical/in_effect'};
    return !defined $in_effect || $in_effect;
}

# XXX This is kind of janky. It relies upon Return::Type using Attribute::Handlers, and it assumes
# some internal Attribute::Handlers behavior. If it proves to be too fragile, we may need to copy
# the Return::Type code to here. Or make Return::Type lexical if that can be done without breaking
# backward-compatibility.
my $handler;
BEGIN {
    $handler = $UNIVERSAL::{ReturnType};
    delete $UNIVERSAL::{ReturnType};
    delete $UNIVERSAL::{_ATTR_CODE_ReturnType};
}
sub UNIVERSAL::ReturnType :ATTR(CODE,BEGIN) {
    my $in_effect = _in_effect(4);
    return if !$in_effect;

    return $handler->(@_);
}

1;

__END__