Commit 701249a5d5afa35ad9bcf0fe998dcdaf8aba4177

Initial implementation of promises, completing the callback types.


		1	#!/usr/bin/env perl
		2
		3	# This example illustrates explicit a promise-like form of callback.
		4	# The promise acts as an event pipeline. Events emitted from the
		5	# object are available one at a time from a promise method.
		6	#
		7	# Promises require some form of asynchrony. This example is larger
		8	# than the others because it includes some custom mock-up code to
		9	# stand in for the rest of Reflex.
		10
		11	# Reflex::Callbacks and the Reflex::Callback helper classes will
		12	# abstract callbacks to fulfill a number of goals. The goals are
		13	# detailed in docs/requirements.otl and summarized in
		14	# eg/eg-20-rcb-callback.pl
		15
		16	use warnings;
		17	use strict;
		18	use lib qw(../lib);
		19
		20	# Create a thing that will invoke callbacks.
		21
		22	{
		23	package PromiseThing;
		24	use Moose;
		25	extends 'Reflex::Object';
		26	use Reflex::Timer;
		27	use Reflex::Callbacks qw(gather_cb);
		28
		29	has ticker => (
		30	isa => 'Reflex::Timer',
		31	is => 'rw',
		32	setup => { interval => 1, auto_repeat => 1 },
		33	traits => [ 'Reflex::Trait::Observer' ],
		34	);
		35
		36	has cb => ( is => 'rw', isa => 'Reflex::Callbacks' );
		37
		38	sub BUILD {
		39	my ($self, $arg) = @_;
		40	$self->cb(gather_cb($arg));
		41	}
		42
		43	sub on_ticker_tick {
		44	my $self = shift;
		45	$self->cb()->send( event => {} );
		46	}
		47	}
		48
		49	use Reflex::Callbacks qw(cb_promise);
		50	use ExampleHelpers qw(eg_say);
		51
		52	my $promise;
		53	my $pt = PromiseThing->new( cb_promise(\$promise) );
		54
		55	while (my $event = $promise->wait()) {
		56	eg_say("wait() returned an event (@$event)");
		57	}


17	17	);
18	18
19	19	sub deliver {
20		my $self = shift;
	20	my ($self, $event, $arg) = @_;
21	21	my $method_name = $self->method_name();
22		$self->object()->$method_name(@_);
	22	$self->object()->$method_name($arg);
23	23	}
24	24
25	25	1;


		1	package Reflex::Callback::Promise;
		2
		3	use Moose;
		4	extends 'Reflex::Callback';
		5	extends 'Reflex::Callbacks';
		6
		7	has queue => (
		8	is => 'rw',
		9	isa => 'ArrayRef[ArrayRef]',
		10	default => sub { [] },
		11	);
		12
		13	# Delivering to a promise enqueues the message.
		14	sub send {
		15	my ($self, $event, $arg) = @_;
		16	push @{$self->queue()}, [ $event, $arg ];
		17	}
		18
		19	sub wait {
		20	my $self = shift;
		21
		22	my $queue = $self->queue();
		23
		24	# TODO - Probably should bail out if the event loop ends.
		25	$POE::Kernel::poe_kernel->run_one_timeslice() while @$queue < 1;
		26
		27	return shift @$queue;
		28	}
		29
		30	1;


18	18	use Reflex::Callback::CodeRef;
19	19	#use Reflex::Callback::Emit; # For current Reflex compatibility
20	20	use Reflex::Callback::Method;
21		#use Reflex::Callback::Promise;
22		#use Reflex::Callback::Role;
	21	use Reflex::Callback::Promise;
23	22
24	23	use Exporter;
25	24	use base qw(Exporter);
…	…
121	121	}
122	122
123	123	sub cb_promise {
124		die;
	124	my $promise_ref = shift;
	125
	126	$$promise_ref = Reflex::Callback::Promise->new();
	127
	128	return( on_promise => $$promise_ref );
125	129	}
126	130
127	131	sub cb_coderef (&) {
…	…
144	144	my $callback = $arg->{$_};
145	145
146	146	if (blessed $callback) {
	147	if ($callback->isa('Reflex::Callback::Promise')) {
	148	return $callback;
	149	}
	150
147	151	if ($callback->isa('Reflex::Callback')) {
148	152	$return{$_} = $callback;
149	153	next;
…	…
175	175
176	176	$event =~ s/^(on_)?/on_/;
177	177
178		$self->callback_map()->{$event}->deliver($arg);
	178	$self->callback_map()->{$event}->deliver($event, $arg);
179	179	}
180	180
181	181	1;