1 package Eval::WithLexicals;
6 our $VERSION = '1.001000'; # 1.1.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 is => 'rw', default => quote_sub q{ 'use strictures 1;' }
33 my ($self, $to_eval) = @_;
34 local *Eval::WithLexicals::Cage::current_line;
35 local *Eval::WithLexicals::Cage::pad_capture;
36 local *Eval::WithLexicals::Cage::grab_captures;
37 my $setup = Sub::Quote::capture_unroll('$_[2]', $self->lexicals, 2);
38 my $package = $self->in_package;
39 my $prelude = $self->prelude;
40 local our $current_code = qq!${prelude}
42 sub Eval::WithLexicals::Cage::current_line {
46 ;sub Eval::WithLexicals::Cage::pad_capture { }
47 BEGIN { Eval::WithLexicals::Util::capture_list() }
48 sub Eval::WithLexicals::Cage::grab_captures {
49 no warnings 'closure'; no strict 'vars';
50 package Eval::WithLexicals::VarScope;!;
51 $self->_eval_do(\$current_code, $self->lexicals, $to_eval);
53 my $ctx = $self->context;
55 @ret = Eval::WithLexicals::Cage::current_line();
56 } elsif ($ctx eq 'scalar') {
57 $ret[0] = Eval::WithLexicals::Cage::current_line();
59 Eval::WithLexicals::Cage::current_line();
63 %{$self->_grab_captures},
70 my $cap = Eval::WithLexicals::Cage::grab_captures();
71 foreach my $key (keys %$cap) {
72 my ($sigil, $name) = $key =~ /^(.)(.+)$/;
73 my $var_scope_name = $sigil.'Eval::WithLexicals::VarScope::'.$name;
74 if ($cap->{$key} eq eval "\\${var_scope_name}") {
82 my ($self, $text_ref, $lexicals, $original) = @_;
84 if ($_[1] eq '/eval_do') {
85 open my $fh, '<', $text_ref;
91 do '/eval_do' or die $@;
95 package Eval::WithLexicals::Util;
97 use B qw(svref_2object);
100 my $pad_capture = \&Eval::WithLexicals::Cage::pad_capture;
101 my @names = grep $_ ne '&', map $_->PV, grep $_->isa('B::PV'),
102 svref_2object($pad_capture)->OUTSIDE->PADLIST->ARRAYelt(0)->ARRAY;
103 $Eval::WithLexicals::current_code .=
104 '+{ '.join(', ', map "'$_' => \\$_", @names).' };'
111 Eval::WithLexicals - pure perl eval with persistent lexical variables
120 use Eval::WithLexicals;
124 $SIG{INT} = sub { warn "SIGINT\n" };
126 { package Data::Dumper; no strict 'vars';
127 $Terse = $Indent = $Useqq = $Deparse = $Sortkeys = 1;
131 my $eval = Eval::WithLexicals->new;
132 my $read = Term::ReadLine->new('Perl REPL');
134 my $line = $read->readline('re.pl$ ');
135 exit unless defined $line;
137 local $SIG{INT} = sub { die "Caught SIGINT" };
138 @ret = $eval->eval($line); 1;
139 } or @ret = ("Error!", $@);
145 $ perl -Ilib bin/tinyrepl
159 my $eval = Eval::WithLexicals->new(
160 lexicals => { '$x' => \1 }, # default {}
161 in_package => 'PackageToEvalIn', # default Eval::WithLexicals::Scratchpad
162 context => 'scalar', # default 'list'
163 prelude => 'use warnings', # default 'use strictures 1'
168 my @return_value = $eval->eval($code_to_eval);
172 my $current_lexicals = $eval->lexicals;
174 $eval->lexicals(\%new_lexicals);
178 my $current_package = $eval->in_package;
180 $eval->in_package($new_package);
184 my $current_context = $eval->context;
186 $eval->context($new_context); # 'list', 'scalar' or 'void'
190 Code to run before evaling code. Loads L<strictures> by default.
192 my $current_prelude = $eval->prelude;
194 $eval->prelude(q{use warnings}); # only warnings, not strict.
198 Matt S. Trout <mst@shadowcat.co.uk>
202 David Leadbeater <dgl@dgl.cx>
206 Copyright (c) 2010 the Eval::WithLexicals L</AUTHOR> and L</CONTRIBUTORS>
211 This library is free software and may be distributed under the same terms