Permalink
Fetching contributors…
Cannot retrieve contributors at this time
170 lines (139 sloc) 3.57 KB
#!/usr/bin/env perl -l
# This is a little test program to see if we could implement
# http://candygram.sourceforge.net/node6.html on MooseX::POE
# using MX::Poe objects (aka POE::Sessions) to replace threads
# Here is the relevant code from Canygram
#
#
# >>> import candygram as cg
# >>> import time
# >>> def proc_func():
# ... r = cg.Receiver()
# ... r.addHandler('land shark', shut_door, cg.Message)
# ... r.addHandler('candygram', open_door, cg.Message)
# ... for message in r:
# ... print message
# ...
# >>> def shut_door(name):
# ... return 'Go Away ' + name
# ...
# >>> def open_door(name):
# ... return 'Hello ' + name
# ...
# >>> proc = cg.spawn(proc_func)
# >>> proc.send('land shark')
# >>> proc.send('candygram')
# >>> # Give the proc a chance to print its messages before termination:
# ... time.sleep(1)
#
# here is our version
#
sub main {
sub proc_func {
my $r = $_[0]->receiver;
$r->add_handler( 'land_shark', \&shut_door );
$r->add_handler( 'candygram', \&open_door );
while (<$r>) {
print;
}
}
sub shut_door {
return 'Go away ' . $_[1];
}
sub open_door {
return 'Hello ' . $_[1];
}
my $proc = Candygram->spawn( \&proc_func );
$proc->send('land_shark');
$proc->send('candygram');
POE::Kernel->run; # we have to run the kernel manually
}
#
# Implementation
#
{
package Candygram;
sub spawn {
my ( $self, $func ) = splice @_, 0, 2;
return Proc->new( func => $func, args => \@_ );
}
}
#
# the Receiver object does all the real work
#
{
package Receiver;
use Moose;
use overload '<>' => \&receive;
has mailbox => (
isa => 'ArrayRef',
is => 'ro',
auto_deref => 1,
default => sub { [] },
);
has handlers => (
isa => 'HashRef',
is => 'ro',
default => sub { {} },
);
sub add_handler {
my ( $self, $state, $code ) = @_;
return if exists $self->handlers->{$state};
$self->handlers->{$state} = $code;
}
# This could be cleaned up a bunch by MooseX::AttributeHelpers on the
# attributes above, but I didn't wan't to have a dependency
# for a example script
sub receive {
my $self = shift;
my ( $state, $args );
return unless scalar @{ $self->mailbox };
for ( 0 .. $#{ $self->mailbox } ) {
my $state = $self->mailbox->[$_]->[0];
next unless $state;
next unless exists $self->handlers->{$state};
( $state, $args ) = @{ splice @{ $self->mailbox }, $_, 1 };
if ( $state && $args ) {
my $res = $self->handlers->{$state}->(@$args);
return $res;
}
}
return;
}
}
{
package Proc;
use MooseX::POE;
has func => (
isa => 'CodeRef',
is => 'ro',
default => sub {
sub { }
},
);
has args => (
isa => 'ArrayRef',
is => 'ro',
auto_deref => 1,
default => sub { [] },
);
has receiver => (
is => 'ro',
default => sub { Receiver->new() },
);
sub START {
my ($self) = @_;
$self->yield('loop');
}
sub on_loop {
my ($self) = @_;
my $func = $self->func;
$self->$func( $self->args );
}
sub send {
my ( $self, $message ) = @_;
push @{ $self->receiver->mailbox }, [ $message, \@_ ];
$self->yield('loop');
}
}
main();