Permalink
Browse files

Support POE::Components that wish to be given postbacks.

  • Loading branch information...
1 parent 99e52f7 commit bf57dfb925c598dc222bb52df967018a164a4e52 @rcaputo committed Sep 2, 2009
Showing with 155 additions and 0 deletions.
  1. +59 −0 PoCoPostback.pm
  2. +54 −0 Postback.pm
  3. +42 −0 eg-11-postback.pl
View
59 PoCoPostback.pm
@@ -0,0 +1,59 @@
+package PoCoPostback;
+
+# A component that accepts postbacks to return messages.
+
+use warnings;
+use strict;
+use POE;
+
+sub new {
+ my $class = shift;
+
+ my $self = bless { }, $class;
+
+ my $result = 'aaaaaaaa';
+
+ POE::Session->create(
+ inline_states => {
+ _start => sub {
+ # Set an alias based on the object that owns us.
+ $_[HEAP]{alias} = "$self";
+ $_[KERNEL]->alias_set("$self");
+ },
+ shutdown => sub {
+ # Shutdown is triggered by the object DESTROY.
+ # Remove the alias, and gracefully exit when all pending
+ # timers are done.
+ $_[KERNEL]->alias_remove($_[HEAP]{alias});
+ },
+ request => sub {
+ # Handle a request. Feign some work.
+ my $postback = $_[ARG0];
+ $_[KERNEL]->delay_add(
+ work_done => rand(3) => $postback => $result++
+ );
+ },
+ work_done => sub {
+ # When the work is done, post back a result.
+ my ($postback, $result) = @_[ARG0, ARG1];
+ $postback->($result);
+ },
+ },
+ );
+
+ return $self;
+}
+
+# Clean up the session on destruction.
+sub DESTROY {
+ my $self = shift;
+ $poe_kernel->call("$self", "shutdown");
+}
+
+# Convenience method. Hide POE::Kernel->post.
+sub request {
+ my ($self, $postback) = @_;
+ $poe_kernel->post("$self", "request", $postback);
+}
+
+1;
View
54 Postback.pm
@@ -0,0 +1,54 @@
+package Postback;
+
+# TODO - Not Moose, unless Moose allows us to create blessed coderefs.
+
+use warnings;
+use strict;
+use Scalar::Util qw(weaken);
+
+my %owner_session_ids;
+
+sub new {
+ my ($class, $object, $method, $passthrough_args) = @_;
+
+ # TODO - Object owns component, which owns object?
+ weaken $object;
+
+ my $self = bless sub {
+ $POE::Kernel::poe_kernel->post(
+ $object->session_id(), "call_gate", $object, $method, {
+ passthrough => $passthrough_args,
+ callback => [ @_ ],
+ },
+ );
+ }, $class;
+
+ $owner_session_ids{$self} = $object->session_id();
+ $POE::Kernel::poe_kernel->refcount_increment(
+ $object->session_id(), "stage_postback"
+ );
+
+ # Double indirection sucks, but some libraries (like Tk) bless their
+ # callbacks. If we returned our own blessed callback, they would
+ # alter the class and thwart DESTROY.
+ #
+ # TODO - POE::Session only does this when Tk is loaded. I opted
+ # against it because the set of libraries that bless their callbacks
+ # may grow over time.
+
+ return sub { $self->(@_) };
+}
+
+sub DESTROY {
+ my $self = shift;
+
+ my $session_id = delete $owner_session_ids{$self};
+ return unless defined $session_id;
+ $POE::Kernel::poe_kernel->refcount_decrement(
+ $session_id, "stage_postback"
+ );
+
+ undef;
+}
+
+1;
View
42 eg-11-postback.pl
@@ -0,0 +1,42 @@
+#!/usr/bin/env perl
+
+# Exercise the Postback class, for passing postbacks into POE space.
+
+{
+ package App;
+
+ use Moose;
+ extends 'Stage';
+ use Postback;
+ use PoCoPostback;
+
+ has component => (
+ isa => 'Object|Undef',
+ is => 'rw',
+ );
+
+ sub BUILD {
+ my $self = shift;
+ $self->component( PoCoPostback->new() );
+
+ $self->component->request(
+ Postback->new($self, "on_component_result", { cookie => 123 }),
+ );
+ }
+
+ sub on_component_result {
+ my ($self, $args) = @_;
+ print(
+ "Got component response:\n",
+ " pass-through cookie: $args->{passthrough}{cookie}\n",
+ " call-back result : $args->{callback}[0]\n",
+ );
+
+ # Ok, we're done.
+ $self->component(undef);
+ }
+}
+
+my $app = App->new();
+$app->run_all();
+exit;

0 comments on commit bf57dfb

Please sign in to comment.