| Subject: | code ref as an eval $string |
The included patch creates the POE::Callback coderef with a eval $string
that contains just enough to do the necessary lexical magic.
I hope.
Also includes a small test case.
| Subject: | Philip_Gwyn-POE-Stage-eval-string.01.patch |
diff -rubN POE-Stage-0.02_00/lib/POE/Callback.pm POE-Stage-0.02_00-PG/lib/POE/Callback.pm
--- POE-Stage-0.02_00/lib/POE/Callback.pm 2007-02-28 02:30:36.000000000 -0500
+++ POE-Stage-0.02_00-PG/lib/POE/Callback.pm 2007-10-12 21:37:25.000000000 -0400
@@ -72,44 +72,35 @@
return $self->_track($name);
}
- my $self = bless sub {
+ my $b_self = ''; # build $self
+ my $b_tied_self = ''; # build $tied_self
+ my $b_rsp = ''; # build $rsp
+ my $b_req = ''; # build $req;
+ my $b_arg = ''; # build $arg;
+ my @vars;
- # Cache these for speed.
- my ($self, $tied_self, $arg, $req, $rsp);
-
- my $pad = peek_sub($code);
foreach my $var_name (@persistent) {
- my $var_reference = $pad->{$var_name};
-
if ($var_name eq '$self') {
- $self = POE::Stage::self() unless defined $self;
- lexalias($code, $var_name, \$self);
+ $b_self ||= q{my $self = POE::Stage::self(); }.
+ q{lexalias($code, '$self', \$self);};
next;
}
-
- if ($var_name eq '$req') {
- unless (defined $req) {
- unless (defined $tied_self) {
- $self = POE::Stage::self() unless defined $self;
- $tied_self = tied(%$self);
- }
- $req = $tied_self->_get_request();
+ if( $var_name eq '$tied_self' ) {
+ push @persistent, '$self' unless $b_self;
+ $b_tied_self ||= q(my $tied_self = tied %$self;);
+ next;
}
-
- lexalias($code, $var_name, \$req);
+ if ($var_name eq '$req') {
+ push @persistent, '$tied_self' unless $b_tied_self;
+ $b_req ||= q(my $req = $tied_self->_get_request(); ).
+ q(lexalias($code, '$req', \$req););
next;
}
if ($var_name eq '$rsp') {
- unless (defined $rsp) {
- unless (defined $tied_self) {
- $self = POE::Stage::self() unless defined $self;
- $tied_self = tied(%$self);
- }
- $rsp = $tied_self->_get_response();
- }
-
- lexalias($code, $var_name, \$rsp);
+ push @persistent, '$tied_self' unless $b_tied_self;
+ $b_rsp ||= q(my $rsp = $tied_self->_get_response(); ).
+ q(lexalias($code, '$rsp', \$rsp););
next;
}
@@ -120,150 +111,128 @@
# Determine which object to use based on the prefix.
- my $obj;
- if ($prefix eq 'req') {
- $req = POE::Request->_get_current_request() unless defined $req;
-
- unless (defined $tied_self) {
- $self = POE::Stage::self() unless defined $self;
- $tied_self = tied(%$self);
- }
-
- # Get the existing member reference.
-
- my $member_ref = $tied_self->_request_context_fetch(
- $req->get_id(),
- $member_name,
- );
-
- # Autovivify if necessary.
-
- unless (defined $member_ref) {
+ my $vivify;
if ($sigil eq '$') {
- my $new_scalar;
- $member_ref = \$new_scalar;
+ $vivify = q(my $new_scalar; $member_ref = \$new_scalar; );
}
elsif ($sigil eq '@') {
- $member_ref = [];
+ $vivify = q($member_ref = []; );
}
elsif ($sigil eq '%') {
- $member_ref = {};
+ $vivify = q($member_ref = {}; );
}
- $tied_self->_request_context_store(
- $req->get_id(),
- $member_name,
- $member_ref,
- );
- }
+ $vivify = q(unless( defined $member_ref ) { ).
+ $vivify .
+ q( lexalias($code, $var_name, $member_ref); );
- # Alias the member.
+ my $def = qq{\$var_name='$var_name';}.
+ qq{\$member_name='$member_name';};
+
+ my $obj;
+ if ($prefix eq 'req') {
+ push @persistent, '$req' unless $b_req;
+ push @persistent, '$tied_self' unless $b_tied_self;
- lexalias($code, $var_name, $member_ref);
+ # Get the existing member reference.
+ push @vars, $def, q{$member_ref = }.
+ q{$tied_self->_request_context_fetch(}.
+ q{$req->get_id(), $member_name );};
+
+ # Autovivify if necessary.
+ push @vars, $vivify,
+ q{$tied_self->_request_context_store(}.
+ q{$req->get_id(),$member_name,$member_ref); },
+ q(}),
+ # Alias the member.
+ q{lexalias($code, $var_name, $member_ref); };
next;
}
if ($prefix eq 'rsp') {
- unless (defined $rsp) {
- unless (defined $tied_self) {
- $self = POE::Stage::self() unless defined $self;
- $tied_self = tied(%$self);
- }
- $rsp = $tied_self->_get_response();
- }
+ push @persistent, '$rsp' unless $b_rsp;
+ push @persistent, '$tied_self' unless $b_tied_self;
# Get the existing member reference.
-
- my $member_ref = $tied_self->_request_context_fetch(
- $rsp->get_id(),
- $member_name,
- );
+ push @vars, $def, q{$member_ref = }.
+ q{$tied_self->_request_context_fetch(}.
+ q{$rsp->get_id(),$member_name,);};
# Autovivify if necessary.
-
- unless (defined $member_ref) {
- if ($sigil eq '$') {
- my $new_scalar;
- $member_ref = \$new_scalar;
- }
- elsif ($sigil eq '@') {
- $member_ref = [];
- }
- elsif ($sigil eq '%') {
- $member_ref = {};
- }
-
- $tied_self->_request_context_store(
- $rsp->get_id(),
- $member_name,
- $member_ref,
- );
- }
-
- lexalias($code, $var_name, $member_ref);
+ push @vars, $vivify,
+ q{$tied_self->_request_context_store(}.
+ q{$rsp->get_id(),$member_name, $member_ref); }.
+ q(}),
+ # Alias the member.
+ q{lexalias($code, $var_name, $member_ref); };
next;
}
if ($prefix eq 'arg') {
- unless (defined $arg) {
- package DB;
- my @x = caller(0);
- $arg = $DB::args[1];
- }
+# push @persistent, '$tied_self' unless $b_tied_self;
+ $b_arg ||=
+ q{my $arg; { package DB; my @x = caller(0); $arg = $DB::args[1]; }};
+ $def .= q{$var_reference = $pad->{$var_name};}.
+ qq{\$base_member_name = '$base_member_name';};
if ($sigil eq '$') {
- $$var_reference = $arg->{$base_member_name};
+ push @vars, $def,
+ q{$$var_reference = $arg->{$base_member_name};};
next;
}
if ($sigil eq '@') {
- @$var_reference = @{$arg->{$base_member_name}};
+ push @vars, $def,
+ q{@$var_reference = @{$arg->{$base_member_name}};};
next;
}
if ($sigil eq '%') {
- %$var_reference = %{$arg->{$base_member_name}};
+ push @vars, $def,
+ q{%$var_reference = %{$arg->{$base_member_name}};};
next;
}
}
if ($prefix eq 'self') {
- unless (defined $tied_self) {
- $self = POE::Stage::self() unless defined $self;
- $tied_self = tied(%$self);
- }
+ push @persistent, '$tied_self' unless $b_tied_self;
# Get the existing member reference.
-
- my $member_ref = $tied_self->_self_fetch($member_name);
+ push @vars, $def, q{$member_ref = }.
+ q{$tied_self->_self_fetch($member_name);};
# Autovivify if necessary.
+ push @vars, $vivify.
+ q{$tied_self->_self_store($member_name, $member_ref);}.
+ q(}),
+ # Alias the member.
+ q{lexalias($code, $var_name, $member_ref);};
- unless (defined $member_ref) {
- if ($sigil eq '$') {
- my $new_scalar;
- $member_ref = \$new_scalar;
- }
- elsif ($sigil eq '@') {
- $member_ref = [];
+ next;
}
- elsif ($sigil eq '%') {
- $member_ref = {};
}
-
- $tied_self->_self_store($member_name, $member_ref);
+ unshift @vars, $b_self, $b_tied_self, $b_arg, $b_req, $b_rsp;
+ my $setup = join "\n", @vars;
+ my $sub = <<" CODE";
+ sub {
+ my \$pad = peek_sub(\$code);
+ my( \$member_ref, \$var_name, \$member_name,
+ \$base_member_name, \$var_reference );
+ $setup;
+ goto \$code;
+ };
+ CODE
+ my $coderef = eval $sub;
+ if( $@ ) {
+ while( $@ =~ /line (\d+)/g ) {
+ my $line = $1;
+ for( ($line-10) .. $line-4 ) {
+ warn $_+4, ": $vars[$_]\n";
}
-
- # Alias the member.
-
- lexalias($code, $var_name, $member_ref);
-
- next;
}
+ die $@;
}
-
- goto $code;
- }, $class;
+ my $self = bless $coderef, $class;
return $self->_track($name);
}
diff -rubN POE-Stage-0.02_00/t/10_callback.t POE-Stage-0.02_00-PG/t/10_callback.t
--- POE-Stage-0.02_00/t/10_callback.t 1969-12-31 19:00:00.000000000 -0500
+++ POE-Stage-0.02_00-PG/t/10_callback.t 2007-10-12 21:41:08.000000000 -0400
@@ -0,0 +1,68 @@
+#!/usr/bin/perl -w
+
+use strict;
+use warnings;
+
+use Test::More ( tests => 4 );
+
+use POE::Callback;
+
+###################
+my $code = POE::Callback->new( {
+ name => 'scalar',
+ code => sub {
+ my $arg_scalar;
+ is( $arg_scalar, 'scalar', 'arg_scalar' );
+ }
+ } );
+
+$code->( $code, { scalar=>'scalar' } );
+
+###################
+$code = POE::Callback->new( {
+ name => 'array',
+ code => sub {
+ my @arg_array;
+ is_deeply( \@arg_array, [ 1..2], 'arg_array' );
+ }
+ } );
+
+$code->( $code, { array=>[ 1..2 ] } );
+
+###################
+$code = POE::Callback->new( {
+ name => 'hash',
+ code => sub {
+ my %arg_hash;
+ is_deeply( \%arg_hash, { honk=>1,
+ bonk=>1
+ }, 'arg_hash' );
+ }
+ } );
+
+$code->( $code, { hash=>{ qw( honk 1 bonk 1 ) } } );
+
+
+$code = POE::Callback->new({
+ name => 'everything',
+ code => sub {
+ my $self;
+ my $rsp;
+ my $req;
+ my $rsp_scalar;
+ my @rsp_array;
+ my %rsp_hash;
+ my $req_scalar;
+ my @req_array;
+ my %req_hash;
+ my $arg_scalar;
+ my @arg_array;
+ my %arg_hash;
+ }
+ } );
+
+pass( 'everything' );
+
+exit 0;
+
+__DATA__