File Coverage

blib/lib/Eval/Quosure.pm

Criterion	Covered	Total	%
statement	49	49	100.0
branch			n/a
condition	3	4	75.0
subroutine	16	16	100.0
pod	4	5	80.0
total	72	74	97.3

package Eval::Quosure;

# ABSTRACT: Evaluate within a caller environment

use 5.010;
use strict;
use warnings;

our $VERSION = '0.001000'; # VERSION

use List::Util 1.28 qw(pairmap);
use PadWalker 2.3 qw(peek_my peek_our);
use Safe::Isa 1.000009;
use Sub::Quote 2.005 qw(quote_sub);
use Type::Params 1.004004;
use Types::Standard qw(Str Int HashRef Optional);

sub new {
    state $check = Type::Params::compile( Str, Optional [Int] );

    my $class = shift;
    my ( $expr, $level ) = $check->(@_);
    $level //= 0;

    my $captures = {
        pairmap { $a => $b }
        ( %{ peek_our( $level + 1 ) }, %{ peek_my( $level + 1 ) } )
    };

    my $self = bless {
        expr     => $expr,
        captures => $captures,
        caller   => [ caller($level) ],
    }, $class;
    return $self;
}


sub expr     { $_[0]->{expr} }
sub captures { $_[0]->{captures} }
sub caller   { $_[0]->{caller} }


sub eval {
    state $check = Type::Params::compile( Optional [HashRef] );

    my $self = shift;
    my ($additional_captures) = $check->(@_);
    $additional_captures //= {};

    my $captures =
      { %{ $self->captures }, pairmap { $a => \$b } %$additional_captures };
    my $caller = $self->caller;

    my $coderef = quote_sub(
        undef,
        $self->expr,
        $captures,
        {
            no_install => 1,              # do not install the function
            package    => $caller->[0],
            file       => $caller->[1],
            line       => $caller->[2],

            # Without below it would get error with Function::Parameters
            #  https://rt.cpan.org/Public/Bug/Display.html?id=122698
            hintshash => undef,
        }
    );
    return $coderef->();
}

1;

__END__