1 package Eval::WithLexicals;
6 has lexicals => (is => 'rw', default => quote_sub q{ {} });
9 my %valid_contexts = map +($_ => 1), qw(list scalar void);
12 is => 'rw', default => quote_sub(q{ 'list' }),
15 die "Invalid context type $val - should be list, scalar or void"
16 unless $valid_contexts{$val};
22 is => 'rw', default => quote_sub q{ 'Eval::WithLexicals::Scratchpad' }
26 my ($self, $to_eval) = @_;
27 local *Eval::WithLexicals::Cage::current_line;
28 local *Eval::WithLexicals::Cage::pad_capture;
29 local *Eval::WithLexicals::Cage::grab_captures;
30 my $setup = Sub::Quote::capture_unroll('$_[2]', $self->lexicals, 2);
31 my $package = $self->in_package;
32 local our $current_code = qq!use strictures 1;
34 sub Eval::WithLexicals::Cage::current_line {
37 ;sub Eval::WithLexicals::Cage::pad_capture { }
38 BEGIN { Eval::WithLexicals::Util::capture_list() }
39 sub Eval::WithLexicals::Cage::grab_captures {
40 no warnings 'closure'; no strict 'refs';
41 package Eval::WithLexicals::Cage;!;
42 $self->_eval_do(\$current_code, $self->lexicals);
44 my $ctx = $self->context;
46 @ret = Eval::WithLexicals::Cage::current_line();
47 } elsif ($ctx eq 'scalar') {
48 $ret[0] = Eval::WithLexicals::Cage::current_line();
50 Eval::WithLexicals::Cage::current_line();
54 %{Eval::WithLexicals::Cage::grab_captures()}
60 my ($self, $text_ref) = @_;
62 if ($_[1] eq '/eval_do') {
63 open my $fh, '<', $text_ref;
69 do '/eval_do' or die "Error: $@\nCompiling: $$text_ref";
73 package Eval::WithLexicals::Util;
75 use B qw(svref_2object);
78 my $pad_capture = \&Eval::WithLexicals::Cage::pad_capture;
79 my @names = map $_->PV, grep $_->isa('B::PV'),
80 svref_2object($pad_capture)->OUTSIDE->PADLIST->ARRAYelt(0)->ARRAY;
81 $Eval::WithLexicals::current_code .=
82 '+{ '.join(', ', map "'$_' => \\$_", @names).' };'