X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FEval%2FWithLexicals.pm;h=95194a83449e86f1d044636f6be218fe3ac0077d;hb=d9087132689f27e3409cf79308b90a67ee7a9ab2;hp=31703e65713c85c9635e1726d8109b8b1130a66a;hpb=1de34059104e948aa75ce26b562eb9b3f14980e7;p=p5sagit%2FEval-WithLexicals.git diff --git a/lib/Eval/WithLexicals.pm b/lib/Eval/WithLexicals.pm index 31703e6..95194a8 100644 --- a/lib/Eval/WithLexicals.pm +++ b/lib/Eval/WithLexicals.pm @@ -1,6 +1,7 @@ package Eval::WithLexicals; use Moo; +use Moo::Role (); use Sub::Quote; our $VERSION = '1.001000'; # 1.1.0 @@ -25,33 +26,67 @@ has in_package => ( is => 'rw', default => quote_sub q{ 'Eval::WithLexicals::Scratchpad' } ); +has prelude => ( + is => 'rw', default => quote_sub q{ 'use strictures 1;' } +); + +sub with_plugins { + my($class, @names) = @_; + + Moo::Role->create_class_with_roles($class, + map "Eval::WithLexicals::With$_", @names); +} + +sub setup_code { + my($self) = @_; + $self->prelude; +} + +sub capture_code { + ( qq{ BEGIN { Eval::WithLexicals::Util::capture_list() } } ) +} + sub eval { my ($self, $to_eval) = @_; local *Eval::WithLexicals::Cage::current_line; local *Eval::WithLexicals::Cage::pad_capture; local *Eval::WithLexicals::Cage::grab_captures; - my $setup = Sub::Quote::capture_unroll('$_[2]', $self->lexicals, 2); + my $package = $self->in_package; - local our $current_code = qq!use strictures 1; -${setup} + my $setup_code = join '', $self->setup_code, + Sub::Quote::capture_unroll('$_[2]', $self->lexicals, 2); + + my $capture_code = join '', $self->capture_code; + + local our $current_code = qq! +${setup_code} sub Eval::WithLexicals::Cage::current_line { package ${package}; #line 1 "(eval)" ${to_eval} ;sub Eval::WithLexicals::Cage::pad_capture { } -BEGIN { Eval::WithLexicals::Util::capture_list() } +${capture_code} sub Eval::WithLexicals::Cage::grab_captures { no warnings 'closure'; no strict 'vars'; package Eval::WithLexicals::VarScope;!; + # rest is appended by Eval::WithLexicals::Util::capture_list, called + # during parsing by the BEGIN block from capture_code. + $self->_eval_do(\$current_code, $self->lexicals, $to_eval); + $self->_run(\&Eval::WithLexicals::Cage::current_line); +} + +sub _run { + my($self, $code) = @_; + my @ret; my $ctx = $self->context; if ($ctx eq 'list') { - @ret = Eval::WithLexicals::Cage::current_line(); + @ret = $code->(); } elsif ($ctx eq 'scalar') { - $ret[0] = Eval::WithLexicals::Cage::current_line(); + $ret[0] = $code->(); } else { - Eval::WithLexicals::Cage::current_line(); + $code->(); } $self->lexicals({ %{$self->lexicals}, @@ -74,7 +109,7 @@ sub _grab_captures { } sub _eval_do { - my ($self, $text_ref, $lexicals, $original) = @_; + my ($self, $text_ref, $lexical, $original) = @_; local @INC = (sub { if ($_[1] eq '/eval_do') { open my $fh, '<', $text_ref; @@ -155,6 +190,7 @@ Eval::WithLexicals - pure perl eval with persistent lexical variables lexicals => { '$x' => \1 }, # default {} in_package => 'PackageToEvalIn', # default Eval::WithLexicals::Scratchpad context => 'scalar', # default 'list' + prelude => 'use warnings', # default 'use strictures 1' ); =head2 eval @@ -179,6 +215,14 @@ Eval::WithLexicals - pure perl eval with persistent lexical variables $eval->context($new_context); # 'list', 'scalar' or 'void' +=head2 prelude + +Code to run before evaling code. Loads L by default. + + my $current_prelude = $eval->prelude; + + $eval->prelude(q{use warnings}); # only warnings, not strict. + =head1 AUTHOR Matt S. Trout