1 package Eval::WithLexicals;
7 our $VERSION = '1.002000'; # 1.2.0
8 $VERSION = eval $VERSION;
10 has lexicals => (is => 'rw', default => quote_sub q{ {} });
13 my %valid_contexts = map +($_ => 1), qw(list scalar void);
16 is => 'rw', default => quote_sub(q{ 'list' }),
19 die "Invalid context type $val - should be list, scalar or void"
20 unless $valid_contexts{$val};
26 is => 'rw', default => quote_sub q{ 'Eval::WithLexicals::Scratchpad' }
30 is => 'rw', default => quote_sub q{ 'use strictures 1;' }
33 has line => ( is => 'rw', default => 1 );
36 my($class, @names) = @_;
38 Moo::Role->create_class_with_roles($class,
39 map "Eval::WithLexicals::With$_", @names);
48 ( qq{ BEGIN { Eval::WithLexicals::Util::capture_list() } } )
52 my ($self, $to_eval) = @_;
53 local *Eval::WithLexicals::Cage::current_line;
54 local *Eval::WithLexicals::Cage::pad_capture;
55 local *Eval::WithLexicals::Cage::grab_captures;
57 my $package = $self->in_package;
58 my $line = $self->line;
60 my $setup_code = join '', $self->setup_code,
61 # $_[2] being what is passed to _eval_do below
62 Sub::Quote::capture_unroll('$_[2]', $self->lexicals, 2);
64 my $capture_code = join '', $self->capture_code;
66 local our $current_code = qq!
68 sub Eval::WithLexicals::Cage::current_line {
72 ;sub Eval::WithLexicals::Cage::pad_capture { }
74 sub Eval::WithLexicals::Cage::grab_captures {
75 no warnings 'closure'; no strict 'vars';
76 package Eval::WithLexicals::VarScope;!;
77 # rest is appended by Eval::WithLexicals::Util::capture_list, called
78 # during parsing by the BEGIN block from capture_code.
80 $self->_eval_do(\$current_code, $self->lexicals, $to_eval);
81 $self->_run(\&Eval::WithLexicals::Cage::current_line);
85 my($self, $code) = @_;
88 my $ctx = $self->context;
91 } elsif ($ctx eq 'scalar') {
98 %{$self->_grab_captures},
105 my $cap = Eval::WithLexicals::Cage::grab_captures();
106 foreach my $key (keys %$cap) {
107 my ($sigil, $name) = $key =~ /^(.)(.+)$/;
108 my $var_scope_name = $sigil.'Eval::WithLexicals::VarScope::'.$name;
109 if ($cap->{$key} eq eval "\\${var_scope_name}") {
117 my ($self, $text_ref, $lexical, $original) = @_;
119 if ($_[1] eq '/eval_do') {
120 open my $fh, '<', $text_ref;
126 do '/eval_do' or die $@;
130 package Eval::WithLexicals::Util;
132 use B qw(svref_2object);
135 my $pad_capture = \&Eval::WithLexicals::Cage::pad_capture;
136 my @names = grep $_ ne '&', map $_->PV, grep $_->isa('B::PV'),
137 svref_2object($pad_capture)->OUTSIDE->PADLIST->ARRAYelt(0)->ARRAY;
138 $Eval::WithLexicals::current_code .=
139 '+{ '.join(', ', map "'$_' => \\$_", @names).' };'
149 Eval::WithLexicals - pure perl eval with persistent lexical variables
158 use Eval::WithLexicals;
164 "plugin=s" => \my @plugins
167 $SIG{INT} = sub { warn "SIGINT\n" };
169 { package Data::Dumper; no strict 'vars';
170 $Terse = $Indent = $Useqq = $Deparse = $Sortkeys = 1;
175 ? Eval::WithLexicals->with_plugins(@plugins)->new
176 : Eval::WithLexicals->new;
178 my $read = Term::ReadLine->new('Perl REPL');
180 my $line = $read->readline('re.pl$ ');
181 exit unless defined $line;
183 local $SIG{INT} = sub { die "Caught SIGINT" };
184 @ret = $eval->eval($line); 1;
185 } or @ret = ("Error!", $@);
191 $ perl -Ilib bin/tinyrepl
205 my $eval = Eval::WithLexicals->new(
206 lexicals => { '$x' => \1 }, # default {}
207 in_package => 'PackageToEvalIn', # default Eval::WithLexicals::Scratchpad
208 context => 'scalar', # default 'list'
209 prelude => 'use warnings', # default 'use strictures 1'
214 my @return_value = $eval->eval($code_to_eval);
218 my $current_lexicals = $eval->lexicals;
220 $eval->lexicals(\%new_lexicals);
224 my $current_package = $eval->in_package;
226 $eval->in_package($new_package);
230 my $current_context = $eval->context;
232 $eval->context($new_context); # 'list', 'scalar' or 'void'
236 Code to run before evaling code. Loads L<strictures> by default.
238 my $current_prelude = $eval->prelude;
240 $eval->prelude(q{use warnings}); # only warnings, not strict.
244 my $eval = Eval::WithLexicals->with_plugins("HintPersistence")->new;
246 Construct a class with the given plugins. Plugins are roles located under
247 a package name like C<Eval::WithLexicals::With*>.
253 =item * HintPersistence
255 When enabled this will persist pragams and other compile hints between evals
256 (for example the L<strict> and L<warnings> flags in effect). See
257 L<Eval::WithLexicals::WithHintPersistence> for further details.
263 Matt S. Trout <mst@shadowcat.co.uk>
267 David Leadbeater <dgl@dgl.cx>
269 haarg - Graham Knop (cpan:HAARG) <haarg@cpan.org>
273 Copyright (c) 2010 the Eval::WithLexicals L</AUTHOR> and L</CONTRIBUTORS>
278 This library is free software and may be distributed under the same terms