X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=p5sagit%2FEval-WithLexicals.git;a=blobdiff_plain;f=lib%2FEval%2FWithLexicals.pm;h=b3a15e993f676a7564095ef48ead2233e8df6212;hp=c7b5fcaf71168a02e29814f713b32f3759a65b1f;hb=f19eca699a0d4520a3e6d3a3f7dd6c134ae8749d;hpb=e764ce9b0e0a0dbb3b51ecab734b0a6bf111b6c8 diff --git a/lib/Eval/WithLexicals.pm b/lib/Eval/WithLexicals.pm index c7b5fca..b3a15e9 100644 --- a/lib/Eval/WithLexicals.pm +++ b/lib/Eval/WithLexicals.pm @@ -1,9 +1,10 @@ package Eval::WithLexicals; use Moo; +use Moo::Role (); use Sub::Quote; -our $VERSION = '1.000000'; # 1.0.0 +our $VERSION = '1.003005'; # 1.3.5 $VERSION = eval $VERSION; has lexicals => (is => 'rw', default => quote_sub q{ {} }); @@ -16,7 +17,7 @@ has lexicals => (is => 'rw', default => quote_sub q{ {} }); isa => sub { my ($val) = @_; die "Invalid context type $val - should be list, scalar or void" - unless $valid_contexts{$val}; + unless $valid_contexts{$val}; }, ); } @@ -25,33 +26,69 @@ 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, + # $_[2] being what is passed to _eval_do below + 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;!; + package! # hide from PAUSE + .q! 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 +111,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; @@ -87,13 +124,14 @@ sub _eval_do { } { - package Eval::WithLexicals::Util; + package # hide from PAUSE + Eval::WithLexicals::Util; use B qw(svref_2object); sub capture_list { my $pad_capture = \&Eval::WithLexicals::Cage::pad_capture; - my @names = grep $_ ne '&', map $_->PV, grep $_->isa('B::PV'), + my @names = grep defined && length && $_ ne '&', map $_->PV, grep $_->can('PV'), svref_2object($pad_capture)->OUTSIDE->PADLIST->ARRAYelt(0)->ARRAY; $Eval::WithLexicals::current_code .= '+{ '.join(', ', map "'$_' => \\$_", @names).' };' @@ -101,6 +139,9 @@ sub _eval_do { } } +1; +__END__ + =head1 NAME Eval::WithLexicals - pure perl eval with persistent lexical variables @@ -115,6 +156,11 @@ Eval::WithLexicals - pure perl eval with persistent lexical variables use Eval::WithLexicals; use Term::ReadLine; use Data::Dumper; + use Getopt::Long; + + GetOptions( + "plugin=s" => \my @plugins + ); $SIG{INT} = sub { warn "SIGINT\n" }; @@ -123,7 +169,10 @@ Eval::WithLexicals - pure perl eval with persistent lexical variables $Quotekeys = 0; } - my $eval = Eval::WithLexicals->new; + my $eval = @plugins + ? Eval::WithLexicals->with_plugins(@plugins)->new + : Eval::WithLexicals->new; + my $read = Term::ReadLine->new('Perl REPL'); while (1) { my $line = $read->readline('re.pl$ '); @@ -155,6 +204,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,13 +229,42 @@ 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. + +=head2 with_plugins + + my $eval = Eval::WithLexicals->with_plugins("HintPersistence")->new; + +Construct a class with the given plugins. Plugins are roles located under +a package name like C. + +Current plugins are: + +=over 4 + +=item * HintPersistence + +When enabled this will persist pragams and other compile hints between evals +(for example the L and L flags in effect). See +L for further details. + +=back + =head1 AUTHOR Matt S. Trout =head1 CONTRIBUTORS -None required yet. Maybe this module is perfect (hahahahaha ...). +David Leadbeater + +haarg - Graham Knop (cpan:HAARG) =head1 COPYRIGHT @@ -198,5 +277,3 @@ This library is free software and may be distributed under the same terms as perl itself. =cut - -1;