summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJesse Luehrs <doy@tozt.net>2013-06-03 18:37:20 -0500
committerJesse Luehrs <doy@tozt.net>2013-06-03 18:37:20 -0500
commit356deae026d1775506966615abf8e4dfae1e8ca5 (patch)
tree8b2fbd4c8b38a30aebda1951a3b9b941c1253106
parentcaa08a7cfb96aa319fbd79f688178b3f8fb89f7f (diff)
downloadreply-356deae026d1775506966615abf8e4dfae1e8ca5.tar.gz
reply-356deae026d1775506966615abf8e4dfae1e8ca5.zip
stop using Lexical::Persistence entirely
the things it's doing are really pretty trivial, and i can't actually get it to work the way i want it to
-rw-r--r--lib/Reply/Plugin/LexicalPersistence.pm49
1 files changed, 8 insertions, 41 deletions
diff --git a/lib/Reply/Plugin/LexicalPersistence.pm b/lib/Reply/Plugin/LexicalPersistence.pm
index 3b1f3f5..44b2ef8 100644
--- a/lib/Reply/Plugin/LexicalPersistence.pm
+++ b/lib/Reply/Plugin/LexicalPersistence.pm
@@ -5,7 +5,7 @@ use warnings;
use base 'Reply::Plugin';
-use Lexical::Persistence;
+use PadWalker 'peek_sub';
=head1 SYNOPSIS
@@ -23,7 +23,7 @@ then use C<$x> as expected in subsequent lines.
sub new {
my $class = shift;
my $self = $class->SUPER::new(@_);
- $self->{env} = Lexical::Persistence->new;
+ $self->{env} = {};
return $self;
}
@@ -31,53 +31,20 @@ sub compile {
my $self = shift;
my ($next, $line, %args) = @_;
- my %c = %{ $self->{env}->get_context('_') };
-
$args{environment} ||= {};
$args{environment} = {
%{ $args{environment} },
- (map { $_ => ref($c{$_}) ? $c{$_} : \$c{$_} } keys %c),
+ %{ $self->{env} },
};
- my ($code) = $next->($line, %args);
- $code = $self->_fixup_code($code, \%c);
- return $self->{env}->wrap($code);
-}
-
-# XXX this is maybe a bug in Lexical::Persistence - it clears variables that
-# aren't in its context, regardless of if they may have been set elsewhere
-sub _fixup_code {
- my $self = shift;
- my ($code, $context) = @_;
-
- require PadWalker;
- require Devel::LexAlias;
- my $pad = PadWalker::peek_sub($code);
- my %restore;
- for my $var (keys %$pad) {
- next unless $var =~ /^\$\@\%./;
- next if exists $context->{$var};
- $restore{$var} = $pad->{$var};
- }
-
- $self->{code} = $code;
+ my ($code) = $next->($line, %args);
- return sub {
- my $code = shift;
- for my $var (keys %restore) {
- Devel::LexAlias::lexalias($code, $var, $restore{$var});
- }
- $code->(@_);
+ $self->{env} = {
+ %{ $self->{env} },
+ %{ peek_sub($code) },
};
-}
-
-# XXX can't just close over $code, because it will also be cleared by the same
-# bug! we have to pass it as a parameter instead
-sub execute {
- my $self = shift;
- my ($next, @args) = @_;
- $next->(delete $self->{code}, @args);
+ return $code;
}
1;