1 package Eval::WithLexicals;
6 our $VERSION = '1.000000'; # 1.0.0
7 $VERSION = eval $VERSION;
9 has lexicals => (is => 'rw', default => quote_sub q{ {} });
12 my %valid_contexts = map +($_ => 1), qw(list scalar void);
15 is => 'rw', default => quote_sub(q{ 'list' }),
18 die "Invalid context type $val - should be list, scalar or void"
19 unless $valid_contexts{$val};
25 is => 'rw', default => quote_sub q{ 'Eval::WithLexicals::Scratchpad' }
29 my ($self, $to_eval) = @_;
30 local *Eval::WithLexicals::Cage::current_line;
31 local *Eval::WithLexicals::Cage::pad_capture;
32 local *Eval::WithLexicals::Cage::grab_captures;
33 my $setup = Sub::Quote::capture_unroll('$_[2]', $self->lexicals, 2);
34 my $package = $self->in_package;
35 local our $current_code = qq!use strictures 1;
37 sub Eval::WithLexicals::Cage::current_line {
40 ;sub Eval::WithLexicals::Cage::pad_capture { }
41 BEGIN { Eval::WithLexicals::Util::capture_list() }
42 sub Eval::WithLexicals::Cage::grab_captures {
43 no warnings 'closure'; no strict 'vars';
44 package Eval::WithLexicals::VarScope;!;
45 $self->_eval_do(\$current_code, $self->lexicals, $to_eval);
47 my $ctx = $self->context;
49 @ret = Eval::WithLexicals::Cage::current_line();
50 } elsif ($ctx eq 'scalar') {
51 $ret[0] = Eval::WithLexicals::Cage::current_line();
53 Eval::WithLexicals::Cage::current_line();
57 %{$self->_grab_captures},
64 my $cap = Eval::WithLexicals::Cage::grab_captures();
65 foreach my $key (keys %$cap) {
66 my ($sigil, $name) = $key =~ /^(.)(.+)$/;
67 my $var_scope_name = $sigil.'Eval::WithLexicals::VarScope::'.$name;
68 if ($cap->{$key} eq eval "\\${var_scope_name}") {
76 my ($self, $text_ref, $lexicals, $original) = @_;
78 if ($_[1] eq '/eval_do') {
79 open my $fh, '<', $text_ref;
85 do '/eval_do' or die $@;
89 package Eval::WithLexicals::Util;
91 use B qw(svref_2object);
94 my $pad_capture = \&Eval::WithLexicals::Cage::pad_capture;
95 my @names = grep $_ ne '&', map $_->PV, grep $_->isa('B::PV'),
96 svref_2object($pad_capture)->OUTSIDE->PADLIST->ARRAYelt(0)->ARRAY;
97 $Eval::WithLexicals::current_code .=
98 '+{ '.join(', ', map "'$_' => \\$_", @names).' };'
105 Eval::WithLexicals - pure perl eval with persistent lexical variables
114 use Eval::WithLexicals;
118 $SIG{INT} = sub { warn "SIGINT\n" };
120 { package Data::Dumper; no strict 'vars';
121 $Terse = $Indent = $Useqq = $Deparse = $Sortkeys = 1;
125 my $eval = Eval::WithLexicals->new;
126 my $read = Term::ReadLine->new('Perl REPL');
128 my $line = $read->readline('re.pl$ ');
129 exit unless defined $line;
131 local $SIG{INT} = sub { die "Caught SIGINT" };
132 @ret = $eval->eval($line); 1;
133 } or @ret = ("Error!", $@);
139 $ perl -Ilib bin/tinyrepl
153 my $eval = Eval::WithLexicals->new(
154 lexicals => { '$x' => \1 }, # default {}
155 in_package => 'PackageToEvalIn', # default Eval::WithLexicals::Scratchpad
156 context => 'scalar', # default 'list'
161 my @return_value = $eval->eval($code_to_eval);
165 my $current_lexicals = $eval->lexicals;
167 $eval->lexicals(\%new_lexicals);
171 my $current_package = $eval->in_package;
173 $eval->in_package($new_package);
177 my $current_context = $eval->context;
179 $eval->context($new_context); # 'list', 'scalar' or 'void'
183 Matt S. Trout <mst@shadowcat.co.uk>
187 None required yet. Maybe this module is perfect (hahahahaha ...).
191 Copyright (c) 2010 the Eval::WithLexicals L</AUTHOR> and L</CONTRIBUTORS>
196 This library is free software and may be distributed under the same terms