1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230
|
package POEx::Role::SessionInstantiation::Meta::Session::Magic;
BEGIN {
$POEx::Role::SessionInstantiation::Meta::Session::Magic::VERSION = '1.101040';
}
use MooseX::Declare;
#ABSTRACT: Provides the magic necessary to integrate with POE
role POEx::Role::SessionInstantiation::Meta::Session::Magic
{
use POE;
use MooseX::Types::Moose(':all');
use overload '""' => sub
{
my $s = shift;
return $s->orig if $s->orig;
return $s;
};
use overload '!=' => sub
{
return "$_[0]" ne "$_[1]";
};
use overload '==' => sub
{
return "$_[0]" eq "$_[1]";
};
has orig => ( is => 'rw', isa => Str );
has orig_name => ( is => 'rw', isa => Str );
has _self_meta =>
(
is => 'rw',
isa => 'Class::MOP::Class'
);
sub BUILD { 1 }
after BUILD { $self->_post_build() }
method _post_build
{
$self->_overload_magic();
$self->_poe_register();
}
method _overload_magic
{
#enable overload in the composed class (ripped from overload.pm)
{
no strict 'refs';
no warnings 'redefine';
${$self->meta->name . "::OVERLOAD"}{dummy}++;
*{$self->meta->name . "::()"} = sub {};
}
# we need a no-op bless here to activate the magic for overload
bless ({}, $self->meta->name);
}
method _poe_register
{
#this registers us with the POE::Kernel
$POE::Kernel::poe_kernel->session_alloc($self, @{$self->args()})
if not $self->orig;
}
method _clone_self
{
# we only need to clone once
if($self->orig)
{
return $self;
}
# we need to hold on to the original stringification
my $orig = "$self";
$self->orig($orig);
my $meta = $self->meta();
$self->orig_name($meta->name);
my $anon = Moose::Meta::Class->create_anon_class
(
superclasses => [ $meta->superclasses(), $meta->name ],
methods => { map { $_->name, $_ } $meta->get_all_methods },
attributes => [ $meta->get_all_attributes() ],
);
$anon->add_role($_) for @{$meta->roles};
#enable overload in the anonymous class (ripped from overload.pm)
{
no strict 'refs';
no warnings 'redefine';
${$anon->name . "::OVERLOAD"}{dummy}++;
*{$anon->name . "::()"} = sub {};
}
my $stuff;
# need to copy all of the symbols over
foreach my $type (keys %{ $stuff = { SCALAR => '$', ARRAY => '@', HASH => '%', CODE => '&' } } )
{
my $symbols = $meta->get_all_package_symbols($type);
foreach my $key (keys %$symbols)
{
if(!$anon->has_package_symbol($stuff->{$type} . $key))
{
if($type eq 'SCALAR')
{
$anon->add_package_symbol($stuff->{$type} . $key, ${$symbols->{$key}});
}
else
{
$anon->add_package_symbol($stuff->{$type} . $key, $symbols->{$key});
}
}
}
}
# this bless not only reblesses into the anonymous class, but also activates overload
bless($self, $anon->name);
# and to keep our anonymous class from going out of scope, stash a reference into ourselves
$self->_self_meta($anon);
# And here is where we break POE encapsulation
$POE::Kernel::poe_kernel->[POE::Kernel::KR_SESSIONS]->{$orig}->[POE::Kernel::SS_SESSION] = $self;
return $self;
}
}
__END__
=pod
=head1 NAME
POEx::Role::SessionInstantiation::Meta::Session::Magic - Provides the magic necessary to integrate with POE
=head1 VERSION
version 1.101040
=head1 PRIVATE_ATTRIBUTES
=head2 orig
is: rw, isa: Str
orig stores the stringification of the original reference. This lets us
fool POE into thinking that our new reference is the old reference.
=head2 orig_name
is: rw, isa: Str
This stores the original meta name that would otherwise be lost
=head2 _self_meta
is: rw, isa: Str
This is where we store the newly created anonymous clone class to keep it from
going out of scope
=head1 PRIVATE_METHODS
=head2 overload "", !=, ==
Stringification, and numeric comparison are overridden so that we can fool POE
into thinking that our inject reference is actually the same as the old
reference.
The numeric comparisons actually use string comparisons and stringifies the
provided arguments.
=head2 after BUILD
All of the magic for turning the constructed object into a Session happens in
this method. If a BUILD is not provided, a stub exists to make sure this advice
is executed. Internally, it delegates actual execution to _post_build to allow
it to be advised.
=head2 _post_build
_post_build does the magic of making sure our overload magic is activated and
that we are registered with POE via $poe_kernel->session_alloc.
=head2 _overload_magic
To active the overload magic, use this method. This is what _post_build uses.
=head2 _poe_register
To register this instance with POE, use this method. This is what _post_build
uses.
=head2 _clone_self
_clone_self does the initial anonymous class clone as needed to enable per
instance modification via normal POE mechanisms.
=head1 AUTHOR
Nicholas Perez <nperez@cpan.org>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2010 by Nicholas Perez.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
|