X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=p5sagit%2FEval-WithLexicals.git;a=blobdiff_plain;f=lib%2FEval%2FWithLexicals%2FWithHintPersistence.pm;h=642887ca9df03424b11e8fba9d527757004a8045;hp=e95a00832e072f0f3cf5d3b183a212d3f760c574;hb=refs%2Fheads%2Frewrite-prelude;hpb=8d732f3064bb88d682504f365ef1af62c6598b8c diff --git a/lib/Eval/WithLexicals/WithHintPersistence.pm b/lib/Eval/WithLexicals/WithHintPersistence.pm index e95a008..642887c 100644 --- a/lib/Eval/WithLexicals/WithHintPersistence.pm +++ b/lib/Eval/WithLexicals/WithHintPersistence.pm @@ -2,22 +2,14 @@ package Eval::WithLexicals::WithHintPersistence; use Moo::Role; use Sub::Quote; -our $VERSION = '1.001000'; # 1.1.0 +our $VERSION = '1.002000'; # 1.2.0 $VERSION = eval $VERSION; -# Used localised -our($hints, %hints); - has hints => ( is => 'rw', default => quote_sub q{ {} }, ); -has _first_eval => ( - is => 'rw', - default => quote_sub q{ 1 }, -); - around eval => sub { my $orig = shift; my($self) = @_; @@ -28,6 +20,11 @@ around eval => sub { my @ret = $orig->(@_); $self->hints({ Eval::WithLexicals::Cage::capture_hints() }); + $self->prelude( + join '', q[ BEGIN { ], + _capture_unroll_global('$Eval::WithLexicals::Cage::hints', $self->hints, 2), + q[ } ], + ); @ret; }; @@ -46,35 +43,30 @@ sub _capture_unroll_global { ); } -sub setup_code { - my($self) = @_; - # Only run the prelude on the first eval, hints will be set after - # that. - if($self->_first_eval) { - $self->_first_eval(0); - return $self->prelude; - } else { - # Seems we can't use the technique of passing via @_ for code in a BEGIN - # block - return q[ BEGIN { ], - _capture_unroll_global('$Eval::WithLexicals::Cage::hints', $self->hints, 2), - q[ } ], - } -}; - around capture_code => sub { my $orig = shift; my($self) = @_; ( q{ sub Eval::WithLexicals::Cage::capture_hints { - no warnings 'closure'; - my($hints, %hints); - BEGIN { $hints = $^H; %hints = %^H; } - return q{$^H} => \$hints, q{%^H} => \%hints; + my ($hints, %hints, $warn_bits); + BEGIN { + no warnings 'closure'; + $hints = $^H; + %hints = %^H; + $warn_bits = ${^WARNING_BITS}; + } + return ( + q{$^H} => \$hints, + q{%^H} => \%hints, + q{${^WARNING_BITS}} => \$warn_bits, + ); } }, $orig->(@_) ) }; +1; +__END__ + =head1 NAME Eval::WithLexicals::WithHintPersistence - Persist compile hints between evals @@ -101,6 +93,16 @@ Saves and restores the C<$^H> and C<%^H> variables. Returns the internal hints hash, keys are C<$^H> and C<%^H> for the hint bits and hint hash respectively. -=cut +=head1 SUPPORT -1; +See L for support and contact information. + +=head1 AUTHORS + +See L for authors. + +=head1 COPYRIGHT AND LICENSE + +See L for the copyright and license. + +=cut