File Coverage

blib/lib/MooX/Role/POE/Emitter.pm
Criterion Covered Total %
statement 28 30 93.3
branch n/a
condition n/a
subroutine 10 10 100.0
pod n/a
total 38 40 95.0


line stmt bran cond sub pod time code
1             package MooX::Role::POE::Emitter;
2             $MooX::Role::POE::Emitter::VERSION = '1.001001';
3 1     1   9863 use strictures 1;
  1         7  
  1         32  
4              
5 1     1   77 use feature 'state';
  1         2  
  1         81  
6 1     1   4 use Carp;
  1         1  
  1         64  
7 1     1   5 use Scalar::Util 'reftype';
  1         2  
  1         70  
8              
9 1     1   893 use List::Objects::WithUtils;
  1         677  
  1         6  
10 1     1   189805 use List::Objects::Types -all;
  1         99413  
  1         15  
11 1     1   5103 use Types::Standard -types;
  1         2  
  1         8  
12              
13 1     1   4655 use MooX::Role::Pluggable::Constants;
  1         378  
  1         85  
14 1     1   741 use MooX::Role::POE::Emitter::RegisteredSession;
  1         5  
  1         49  
15              
16 1     1   463 use POE;
  0            
  0            
17              
18             sub E_TAG () { 'Emitter Running' }
19              
20             =pod
21              
22             =for Pod::Coverage E_TAG
23              
24             =cut
25              
26              
27             use Moo::Role; use MooX::late;
28             with 'MooX::Role::Pluggable';
29              
30              
31             has alias => (
32             lazy => 1,
33             is => 'ro',
34             isa => Str,
35             predicate => 'has_alias',
36             writer => 'set_alias',
37             default => sub { my $self = shift; "$self" },
38             );
39              
40             around set_alias => sub {
41             my ($orig, $self, $value) = @_;
42              
43             if ( $poe_kernel->alias_resolve( $self->session_id ) ) {
44             $self->call( __emitter_reset_alias => $value );
45             $self->emit( $self->event_prefix . 'alias_set' => $value );
46             }
47              
48             $self->$orig($value)
49             };
50              
51             has event_prefix => (
52             lazy => 1,
53             is => 'ro',
54             isa => Str,
55             predicate => 'has_event_prefix',
56             writer => 'set_event_prefix',
57             default => sub { 'emitted_' },
58             );
59              
60             has pluggable_type_prefixes => (
61             ## Optionally remap PROCESS / NOTIFY types
62             lazy => 1,
63             is => 'ro',
64             isa => HashObj,
65             coerce => 1,
66             predicate => 'has_pluggable_type_prefixes',
67             writer => 'set_pluggable_type_prefixes',
68             default => sub {
69             hash( PROCESS => 'P', NOTIFY => 'N' )
70             },
71             );
72              
73              
74             has object_states => (
75             lazy => 1,
76             is => 'ro',
77             isa => ArrayObj,
78             coerce => 1,
79             predicate => 'has_object_states',
80             writer => 'set_object_states',
81             trigger => 1,
82             default => sub { array },
83             );
84              
85             sub _trigger_object_states {
86             my ($self, $states) = @_;
87              
88             $states = array(%$states) if reftype $states eq 'HASH';
89              
90             confess "object_states() should be an ARRAY or HASH"
91             unless ref $states and reftype $states eq 'ARRAY';
92              
93             $states = array(@$states) unless is_ArrayObj $states;
94              
95             state $disallowed = array( qw/
96             _start
97             _stop
98             _default
99             emit
100             register
101             unregister
102             subscribe
103             unsubscribe
104             / )->map(sub { $_ => 1 })->inflate;
105              
106             my $itr = $states->natatime(2);
107             while (my (undef, $events) = $itr->()) {
108             my $evarr = reftype $events eq 'ARRAY' ? array(@$events)
109             : reftype $events eq 'HASH' ? array(keys %$events)
110             : confess "Expected ARRAY or HASH but got $events";
111             $evarr->map(
112             sub { confess "Disallowed handler: $_" if $disallowed->exists($_) }
113             );
114             }
115             }
116              
117              
118             has register_prefix => (
119             lazy => 1,
120             is => 'ro',
121             isa => Str,
122             predicate => 'has_register_prefix',
123             writer => 'set_register_prefix',
124             ## Emitter_register / Emitter_unregister
125             default => sub { 'Emitter_' },
126             );
127              
128             has session_id => (
129             init_arg => undef,
130             lazy => 1,
131             is => 'ro',
132             isa => Defined,
133             predicate => 'has_session_id',
134             writer => 'set_session_id',
135             default => sub { -1 },
136             );
137              
138             has shutdown_signal => (
139             lazy => 1,
140             is => 'ro',
141             isa => Str,
142             predicate => 'has_shutdown_signal',
143             writer => 'set_shutdown_signal',
144             default => sub { 'SHUTDOWN_EMITTER' },
145             );
146              
147             has __emitter_reg_sessions => (
148             lazy => 1,
149             is => 'ro',
150             isa => TypedHash[Object],
151             default => sub { hash_of Object },
152             );
153              
154              
155             has __emitter_reg_events => (
156             ## ->{ $event }->{ $session_id } = 1
157             lazy => 1,
158             is => 'ro',
159             isa => TypedHash[ TypedHash[Int] ],
160             coerce => 1,
161             default => sub { hash_of TypedHash[Int] },
162             );
163              
164              
165             sub _start_emitter {
166             ## Call to spawn Session.
167             ## my $emitter = MyClass->new(
168             ## alias => Emitter session alias
169             ## event_prefix => Session event prefix (emitted_)
170             ## register_prefix => _register/_unregister prefix (Emitter_)
171             ## object_states => Extra object_states for Session
172             ## )->_start_emitter();
173             my ($self) = @_;
174              
175             my %types;
176             if ( $self->has_pluggable_type_prefixes ) {
177             $types{PROCESS} = $self->pluggable_type_prefixes->{PROCESS} ||= 'P';
178             $types{NOTIFY} = $self->pluggable_type_prefixes->{NOTIFY} ||= 'N';
179             } else {
180             %types = ( PROCESS => 'P', NOTIFY => 'N' );
181             }
182              
183             $self->_pluggable_init(
184             event_prefix => $self->event_prefix,
185             reg_prefix => $self->register_prefix,
186             types => \%types,
187             );
188              
189             POE::Session->create(
190             object_states => [
191              
192             $self => {
193             '_start' => '__emitter_start',
194             '_stop' => '__emitter_stop',
195             'shutdown_emitter' => '__shutdown_emitter',
196              
197             'register' => '__emitter_register',
198             'subscribe' => '__emitter_register',
199             'unregister' => '__emitter_unregister',
200             'unsubscribe' => '__emitter_unregister',
201             'emit' => '__emitter_notify',
202              
203             '_default' => '__emitter_disp_default',
204             '__emitter_real_default' => '_emitter_default',
205             },
206              
207             $self => [ qw/
208             __emitter_notify
209              
210             __emitter_timer_set
211             __emitter_timer_del
212              
213             __emitter_sigdie
214              
215             __emitter_reset_alias
216              
217             __emitter_sig_shutdown
218             / ],
219              
220             (
221             $self->has_object_states ? $self->object_states->all : ()
222             ),
223              
224             ],
225             );
226              
227             $self
228             }
229              
230             around '_pluggable_event' => sub {
231             my ($orig, $self) = splice @_, 0, 2;
232              
233             ## Overriden from Role::Pluggable
234             ## Receives plugin_error, plugin_add etc
235             ## Redispatch via emit()
236              
237             $self->emit( @_ );
238             };
239              
240              
241             ### Public:
242              
243             sub timer {
244             my ($self, $time, $event, @args) = @_;
245              
246             confess "timer() expected at least a time and event name"
247             unless defined $time and defined $event;
248              
249             $self->call( __emitter_timer_set => $time, $event, @args )
250             }
251              
252             sub __emitter_timer_set {
253             my ($kernel, $self) = @_[KERNEL, OBJECT];
254             my ($time, $event, @args) = @_[ARG0 .. $#_];
255              
256             my $alarm_id = $poe_kernel->delay_set( $event, $time, @args );
257              
258             $self->emit( $self->event_prefix . 'timer_set',
259             $alarm_id,
260             $event,
261             $time,
262             @args
263             ) if $alarm_id;
264              
265             $alarm_id
266             }
267              
268             sub timer_del {
269             my ($self, $alarm_id) = @_;
270              
271             confess "timer_del() expects an alarm ID"
272             unless defined $alarm_id;
273              
274             $self->call( __emitter_timer_del => $alarm_id );
275             }
276              
277             sub __emitter_timer_del {
278             my ($kernel, $self, $alarm_id) = @_[KERNEL, OBJECT, ARG0];
279              
280             my @deleted = $poe_kernel->alarm_remove($alarm_id);
281             return unless @deleted;
282              
283             my ($event, undef, $params) = @deleted;
284              
285             $self->emit( $self->event_prefix . 'timer_deleted',
286             $alarm_id,
287             $event,
288             @{ $params || [] }
289             );
290              
291             $params
292             }
293              
294             ## yield/call provide post()/call() frontends.
295             sub yield {
296             my ($self, @args) = @_;
297              
298             $poe_kernel->post( $self->session_id, @args );
299              
300             $self
301             }
302              
303             sub call {
304             my ($self, @args) = @_;
305              
306             $poe_kernel->call( $self->session_id, @args );
307              
308             $self
309             }
310              
311             sub emit {
312             ## Async NOTIFY event dispatch.
313             my ($self, $event, @args) = @_;
314              
315             $self->yield( __emitter_notify => $event, @args );
316              
317             $self
318             }
319              
320             sub emit_now {
321             ## Synchronous NOTIFY event dispatch.
322             my ($self, $event, @args) = @_;
323              
324             $self->call( __emitter_notify => $event, @args );
325              
326             $self
327             }
328              
329             sub process {
330             my ($self, $event, @args) = @_;
331             ## Dispatch PROCESS events.
332             ## process() events should _pluggable_process immediately
333             ## and return the EAT value.
334              
335             ## Dispatched to P_$event :
336             $self->_pluggable_process( PROCESS => $event, \@args )
337             }
338              
339              
340              
341             ## Session ref-counting bits.
342              
343             sub __get_ses_refc {
344             my ($self, $sess_id) = @_;
345             return unless $self->__emitter_reg_sessions->exists($sess_id);
346             $self->__emitter_reg_sessions->get($sess_id)->refcount
347             }
348              
349             sub __reg_ses_id {
350             my ($self, $sess_id) = @_;
351             return if $self->__emitter_reg_sessions->exists($sess_id);
352             $self->__emitter_reg_sessions->set($sess_id =>
353             MooX::Role::POE::Emitter::RegisteredSession->new(
354             id => $sess_id,
355             refcount => 0
356             )
357             );
358             }
359              
360             sub __incr_ses_refc {
361             my ($self, $sess_id) = @_;
362              
363             my $regsess_obj = $self->__emitter_reg_sessions->get($sess_id);
364             unless (defined $regsess_obj) {
365             confess "BUG; attempted to increase nonexistant refcount for '$sess_id'";
366             }
367              
368             $self->__emitter_reg_sessions->set($sess_id =>
369             MooX::Role::POE::Emitter::RegisteredSession->new(
370             id => $sess_id,
371             refcount => $regsess_obj->refcount + 1,
372             )
373             );
374              
375             $self->__emitter_reg_sessions->get($sess_id)->refcount
376             }
377              
378             sub __decr_ses_refc {
379             my ($self, $sess_id) = @_;
380              
381             my $regsess_obj = $self->__emitter_reg_sessions->get($sess_id);
382             unless (defined $regsess_obj) {
383             confess "BUG; attempted to decrease nonexistant refcount for '$sess_id'"
384             }
385              
386             $self->__emitter_reg_sessions->set($sess_id =>
387             do {
388             my $refc = $regsess_obj->refcount - 1;
389             $refc = 0 if $refc < 0; # FIXME delete (and return above) instead?
390             MooX::Role::POE::Emitter::RegisteredSession->new(
391             id => $sess_id,
392             refcount => $refc,
393             )
394             },
395             );
396             }
397              
398             sub __emitter_drop_sessions {
399             my ($self) = @_;
400              
401             for my $id ($self->__emitter_reg_sessions->keys->all) {
402             my $count = $self->__get_ses_refc($id);
403             while ( $count-- > 0 ) {
404             $poe_kernel->refcount_decrement( $id, E_TAG )
405             }
406              
407             $self->__emitter_reg_sessions->delete($id)
408             }
409              
410             1
411             }
412              
413              
414             ## Our Session's handlers:
415              
416             sub __emitter_notify {
417             ## Dispatch a NOTIFY event
418             my ($kernel, $self) = @_[KERNEL, OBJECT];
419             my ($event, @args) = @_[ARG0 .. $#_];
420              
421             my $prefix = $self->event_prefix;
422              
423             ## May have event_prefix (such as $prefix.'plugin_error')
424             substr($event, 0, length($prefix), '') if index($event, $prefix) == 0;
425              
426             my %sessions;
427              
428             for my $registered_ev ('all', $event) {
429             if (my $sess_hash = $self->__emitter_reg_events->get($registered_ev)) {
430             $sess_hash->keys->visit(sub { $sessions{$_} = 1 })
431             }
432             }
433              
434             my $meth = $prefix . $event;
435              
436             ## Our own session will get ->event_prefix . $event first
437             $kernel->call( $_[SESSION], $meth, @args )
438             if delete $sessions{ $_[SESSION]->ID };
439              
440             ## Dispatched to N_$event after our Session has been notified:
441             unless ( $self->_pluggable_process('NOTIFY', $event, \@args) == EAT_ALL ) {
442             ## Notify subscribed sessions.
443             $kernel->call( $_ => $meth, @args ) for keys %sessions;
444             }
445              
446             ## Received emitted 'shutdown', drop sessions.
447             $self->__emitter_drop_sessions if $event eq 'shutdown';
448             }
449              
450             sub __emitter_start {
451             ## _start handler
452             my ($kernel, $self) = @_[KERNEL, OBJECT];
453             my ($session, $sender) = @_[SESSION, SENDER];
454              
455             $self->set_session_id( $session->ID );
456              
457             $kernel->alias_set( $self->alias );
458              
459             $kernel->sig( DIE => '__emitter_sigdie' );
460             $kernel->sig( $self->shutdown_signal => '__emitter_sig_shutdown' );
461              
462             unless ($sender == $kernel) {
463             ## Have a parent session.
464             my $s_id = $sender->ID;
465             $kernel->refcount_increment( $s_id, E_TAG );
466             $self->__reg_ses_id( $s_id );
467             $self->__incr_ses_refc( $s_id );
468              
469             ## subscribe parent session to all notification events
470             $self->__emitter_reg_events->{all}->{ $s_id } = 1;
471              
472             ## Detach child session.
473             $kernel->detach_myself;
474             }
475              
476             $self->call('emitter_started');
477              
478             $self
479             }
480              
481             sub __emitter_reset_alias {
482             my ($kernel, $self) = @_[KERNEL, OBJECT];
483             $kernel->alias_set( $_[ARG0] );
484             }
485              
486             sub __emitter_disp_default {
487             my ($kernel, $self) = @_[KERNEL, OBJECT];
488             my ($event, $args) = @_[ARG0, ARG1];
489              
490             if (ref $event eq 'CODE') {
491             ## Anonymous coderef callback.
492             ## Cute trick from dngor:
493             ## - Shove arguments back into @_
494             ## (starting at ARG0 and replacing ARG0/ARG1)
495             ## - Set $_[STATE] to our coderef
496             ## (callback sub can retrieve itself via $_[STATE])
497             ## - Replace current subroutine
498             splice @_, ARG0, 2, @$args;
499             $_[STATE] = $event;
500             goto $event
501             } else {
502             $self->call( __emitter_real_default => $event, $args );
503             }
504             }
505              
506             sub _emitter_default {
507             my ($kernel, $self) = @_[KERNEL, OBJECT];
508             my ($event, $args) = @_[ARG0, ARG1];
509              
510             ## Session received an unknown event.
511             ## Dispatch it to any appropriate P_$event handlers.
512              
513             $self->process( $event, @$args )
514             unless index($event, '_') == 0
515             or index($event, 'emitter_') == 0
516             and $event =~ /(?:started|stopped)$/;
517             }
518              
519             sub __emitter_sig_shutdown {
520             my ($kernel, $self) = @_[KERNEL, OBJECT];
521             $self->yield( shutdown_emitter => @_[ARG2 .. $#_] )
522             }
523              
524             sub __emitter_sigdie {
525             my ($kernel, $self) = @_[KERNEL, OBJECT];
526             my $exh = $_[ARG1];
527              
528             my $event = $exh->{event};
529             my $dest_id = $exh->{dest_session}->ID;
530             my $errstr = $exh->{error_str};
531              
532             warn
533             "SIG_DIE: Event '$event' session '$dest_id'\n",
534             " exception: $errstr\n";
535              
536             $kernel->sig_handled;
537             }
538              
539             sub __emitter_stop {
540             ## _stop handler
541             my ($kernel, $self) = @_[KERNEL, OBJECT];
542              
543             $self->call('emitter_stopped');
544             }
545              
546             sub _shutdown_emitter {
547             ## Opposite of _start_emitter
548             my $self = shift;
549              
550             $self->call( shutdown_emitter => @_ );
551              
552             1
553             }
554              
555             sub __shutdown_emitter {
556             my ($kernel, $self) = @_[KERNEL, OBJECT];
557              
558             $kernel->alarm_remove_all;
559              
560             ## Destroy plugin pipeline.
561             $self->_pluggable_destroy;
562              
563             ## Notify sessions.
564             $self->emit( shutdown => @_[ARG0 .. $#_] );
565              
566             ## Drop sessions and we're spent.
567             $self->call( unsubscribe => () );
568             $self->__emitter_drop_sessions;
569             }
570              
571              
572             ## Handlers for listener sessions.
573             sub __emitter_register {
574             my ($kernel, $self, $sender) = @_[KERNEL, OBJECT, SENDER];
575             my @events = @_[ARG0 .. $#_];
576              
577             @events = 'all' unless @events;
578              
579             my $s_id = $sender->ID;
580              
581             ## Add to our known sessions.
582             $self->__reg_ses_id( $s_id );
583              
584             for my $event (@events) {
585             ## Add session to registered event lists.
586             $self->__emitter_reg_events->{$event}->{$s_id} = 1;
587              
588             ## Make sure registered session hangs around
589             ## (until _unregister or shutdown)
590             $kernel->refcount_increment( $s_id, E_TAG )
591             unless $s_id == $self->session_id
592             or $self->__get_ses_refc($s_id);
593              
594             $self->__incr_ses_refc( $s_id );
595             }
596              
597             $kernel->post( $s_id => $self->event_prefix . 'registered', $self )
598             }
599              
600             sub __emitter_unregister {
601             my ($kernel, $self, $sender) = @_[KERNEL, OBJECT, SENDER];
602             my @events = @_[ARG0 .. $#_];
603              
604             ## - An unsub without any arguments means "stop sending all events I
605             ## have subscribed to"
606             ## - An unsub for 'all' means "stop sending events I haven't asked for
607             ## by name"
608              
609             @events = $self->__emitter_reg_events->keys->all unless @events;
610              
611             my $s_id = $sender->ID;
612              
613             EV: for my $event (@events) {
614             # intentional no Lowu, leave me for autoviv:
615             unless (delete $self->__emitter_reg_events->{$event}->{$s_id}) {
616             next EV
617             }
618              
619             # Sessions left for this event?
620             $self->__emitter_reg_events->delete($event)
621             if $self->__emitter_reg_events->get($event)->is_empty;
622              
623             $self->__decr_ses_refc($s_id);
624              
625             unless ($self->__get_ses_refc($s_id)) {
626             ## No events left for this session.
627             $self->__emitter_reg_sessions->delete($s_id);
628              
629             $kernel->refcount_decrement( $s_id, E_TAG )
630             unless $_[SESSION] == $sender;
631             }
632              
633             } ## EV
634             }
635              
636             1;
637              
638              
639             =pod
640              
641             =for Pod::Coverage has_\S+
642              
643             =head1 NAME
644              
645             MooX::Role::POE::Emitter - Pluggable POE event emitter role for cows
646              
647             =head1 SYNOPSIS
648              
649             ## A POE::Session that can broadcast events to listeners:
650             package My::EventEmitter;
651             use POE;
652             use Moo;
653             with 'MooX::Role::POE::Emitter';
654              
655             sub spawn {
656             my ($self, %args) = @_;
657              
658             $self->set_object_states(
659             [
660             $self => {
661             ## Add some extra handlers to our Emitter:
662             'emitter_started' => '_emitter_started',
663             'emitter_stopped' => '_emitter_stopped',
664             },
665              
666             ## Include any object_states we had previously
667             ## (e.g. states added at construction time):
668             (
669             $self->has_object_states ?
670             @{ $self->object_states } : ()
671             ),
672              
673             ## Maybe include from named arguments, for example:
674             (
675             ref $args{object_states} eq 'ARRAY' ?
676             @{ $args{object_states} } : ()
677             ),
678             ],
679             );
680              
681             ## Start our Emitter's POE::Session:
682             $self->_start_emitter;
683             }
684              
685             sub shutdown {
686             my ($self) = @_;
687             ## .. do some cleanup, whatever ..
688             $self->_shutdown_emitter;
689             }
690              
691             sub _emitter_started {
692             my ($kernel, $self) = @_[KERNEL, OBJECT];
693             ## A POE state called when the emitter's session starts.
694             ## (Analogous to a normal '_start' handler)
695             ## Could load plugins, do initialization, etc.
696             }
697              
698             sub _emitter_stopped {
699             ## Opposite of 'emitter_started'
700             }
701              
702             sub do_something {
703             my ($self, @things) = @_;
704             # ... do some work ...
705             # ... emit an event:
706             $self->emit( did_stuff => @things )
707             }
708              
709             ## A listening POE::Session:
710             package My::Listener;
711             use POE;
712              
713             sub spawn {
714             # This spawn() takes an alias/session to subscribe to:
715             my ($self, $alias_or_sessionID) = @_;
716              
717             POE::Session->create(
718             ## Set up a Session, etc
719             object_states => [
720             $self => [
721             'emitted_did_stuff',
722             # ...
723             ],
724             ],
725             );
726              
727             ## Subscribe to all events from $alias_or_sessionID:
728             $poe_kernel->call(
729             $alias_or_sessionID => subscribe => 'all'
730             );
731             }
732              
733             sub emitted_did_stuff {
734             my ($kernel, $self) = @_[KERNEL, OBJECT];
735             ## Received 'did_stuff' from Emitter
736             my @things = @_[ARG0 .. $#_];
737             # ...
738             }
739              
740             =head1 DESCRIPTION
741              
742             Consuming this L gives your class a L capable of
743             processing events via loaded plugins and/or emitting them to registered
744             "listener" sessions.
745              
746             It is derived from L by BINGOS, HINRIK, APOCAL
747             et al, but with more cows ;-) and a few extra features (such as anonymous
748             coderef callbacks; see L), as well as the
749             faster plugin dispatch system that comes with L.
750              
751             The Emitter role consumes L,
752             making your emitter pluggable (see the
753             L documentation for plugin-related details).
754              
755             You do not need to create your own L; calling
756             L will spawn one for you.
757              
758             You also get some useful sugar over POE event dispatch; see L.
759              
760             =head2 Creating an Emitter
761              
762             L contains an emitter that uses B methods to
763             configure itself when C is called; attributes can, of course,
764             be set when your Emitter is constructed:
765              
766             my $emitter = MyEmitter->new(
767             alias => 'my_emitter',
768             pluggable_type_prefixes => {
769             NOTIFY => 'Notify',
770             PROCESS => 'Proc',
771             },
772             # . . .
773             );
774              
775             =head3 Attributes
776              
777             Most of these can be altered via B methods at any time before
778             L is called. Changing an emitter's configuration after it has
779             been started may result in undesirable behavior ;-)
780              
781             =head4 alias
782              
783             B specifies the POE::Kernel alias used for our L;
784             defaults to the stringified object.
785              
786             Set via B. If the emitter is running, a prefixed B
787             event is emitted to notify listeners that need to know where to reach the emitter.
788              
789             =head4 event_prefix
790              
791             B is prepended to notification events before they are
792             dispatched to listening sessions. It is also used for the plugin
793             pipeline's internal events; see L
794             for details.
795              
796             Defaults to I
797              
798             Set via B
799              
800             =head4 pluggable_type_prefixes
801              
802             B is a hash reference that can optionally be set
803             to change the default L plugin handler prefixes for
804             C and C (which default to C

and C, respectively):

805              
806             my $emitter = $class->new(
807             pluggable_type_prefixes => {
808             PROCESS => 'P',
809             NOTIFY => 'N',
810             },
811             );
812              
813             Set via B
814              
815             =head4 object_states
816              
817             B is an array reference suitable for passing to
818             L; the subclasses own handlers should be added to
819             B prior to calling L.
820              
821             Set via B
822              
823             =head4 register_prefix
824              
825             B is prepended to 'register' and 'unregister' methods
826             called on plugins at load time (see L).
827              
828             Defaults to I
829              
830             Set via B
831              
832             =head4 session_id
833              
834             B is our emitter's L ID, set when our Session is
835             started via L.
836              
837             =head4 shutdown_signal
838              
839             B is the name of the L signal that will trigger a
840             shutdown (used to shut down multiple Emitters). See L
841              
842             =head3 _start_emitter
843              
844             B<_start_emitter()> should be called on our object to spawn the actual
845             L. It takes no arguments and should be called after the
846             object has been configured.
847              
848             =head3 _shutdown_emitter
849              
850             B<_shutdown_emitter()> must be called to terminate the Emitter's
851             L
852              
853             A 'shutdown' event will be emitted before sessions are dropped.
854              
855             =head2 Listening sessions
856              
857             =head3 Session event subscription
858              
859             An external L can subscribe to receive events via
860             normal POE event dispatch by sending a C:
861              
862             $poe_kernel->post( $emitter->session_id,
863             'subscribe',
864             @events
865             );
866              
867             Listening sessions are consumers; they cannot modify event arguments in
868             any meaningful way, and will receive arguments as-normal (in @_[ARG0 ..
869             $#_] like any other POE state). Plugins operate differently and receive
870             references to arguments that can be modified -- see
871             L for details.
872              
873             =head3 Session event unregistration
874              
875             An external Session can unregister subscribed events using the same syntax
876             as above:
877              
878             $poe_kernel->post( $emitter->session_id,
879             'unsubscribe',
880             @events
881             );
882              
883             If no events are specified, then any previously subscribed events are
884             unregistered.
885              
886             Note that unsubscribing from 'all' does not carry the same behavior; that
887             is to say, a subscriber can subscribe/unsubscribe for 'all' separately from
888             some set of specifically named events.
889              
890             =head2 Receiving events
891              
892             =head3 Events delivered to listeners
893              
894             Events are delivered to subscribed listener sessions as normal POE events,
895             with the configured L prepended and arguments available via
896             C< @_[ARG0 .. $#_] > as normal.
897              
898             sub emitted_my_event {
899             my ($kernel, $self) = @_[KERNEL, OBJECT];
900             my @args = @_[ARG0 .. $#_];
901             # . . .
902             }
903              
904             See L and L
905              
906             =head3 Events delivered to this session
907              
908             The emitter's L provides a '_default' handler that
909             redispatches unknown POE-delivered events to L
910             (except for events prefixed with '_', which are reserved).
911              
912             You can change this behavior by overriding '_emitter_default' -- here's a
913             direct adaption of the example from L:
914              
915             use Moo;
916             use POE;
917             with 'MooX::Role::POE::Emitter';
918             around '_emitter_default' => sub {
919             my $orig = shift;
920             my ($kernel, $self) = @_[KERNEL, OBJECT];
921             my ($event, $args) = @_[ARG0, ARG1];
922              
923             ## process(), then do something else, for example
924             return if $self->process( $event, @$args ) == EAT_ALL;
925              
926             . . .
927             };
928              
929             (Note that due to internal redispatch $_[SENDER] will be the Emitter's
930             Session.)
931              
932             =head2 EAT values
933              
934             L uses C constants to indicate event
935             lifetime.
936              
937             If a plugin in the pipeline returns EAT_CLIENT or EAT_ALL, events
938             are not dispatched to subscribed listening sessions; a dispatched NOTIFY
939             event goes to your emitter's Session if it is subscribed to receive it,
940             then to the plugin pipeline, and finally to other subscribed listener
941             Sessions B a plugin returned EAT_CLIENT or EAT_ALL.
942              
943             See L for more on dispatch behavior and event lifetime. See
944             L for details regarding plugins.
945              
946             =head3 NOTIFY events
947              
948             B events are intended to be dispatched asynchronously to our own
949             session, any loaded plugins in the pipeline, and subscribed listening
950             sessions, respectively.
951              
952             See L.
953              
954             =head3 PROCESS events
955              
956             B events are intended to be processed by the plugin pipeline
957             immediately; these are intended for message processing and similar
958             synchronous action handled by plugins.
959              
960             Handlers for B events are prefixed with C
961              
962             See L.
963              
964             =head2 Sending events
965              
966             =head3 emit
967              
968             $self->emit( $event, @args );
969              
970             B dispatches L -- these events are dispatched
971             first to our own session (with L prepended), then any
972             loaded plugins in the pipeline (with C prepended), then registered
973             sessions (with L prepended):
974              
975             ## With default event_prefix:
976             $self->emit( 'my_event', @args )
977             # -> Dispatched to own session as 'emitted_my_event'
978             # -> Dispatched to plugin pipeline as 'N_my_event'
979             # -> Dispatched to registered sessions as 'emitted_my_event'
980             # *unless* a plugin returned EAT_CLIENT or EAT_ALL
981              
982             See L, L
983              
984             =head3 emit_now
985              
986             $self->emit_now( $event, @args );
987              
988             B synchronously dispatches L -- see
989             L.
990              
991             =head3 process
992              
993             $self->process( $event, @args );
994              
995             B calls registered plugin handlers for L
996             immediately; these are B dispatched to listening sessions.
997              
998             Returns the same value as L.
999              
1000             See L for details on pluggable
1001             event dispatch.
1002              
1003             =head2 Methods
1004              
1005             These methods provide easy proxy mechanisms for issuing POE events and
1006             managing timers within the context of the emitter's L.
1007              
1008             =head3 yield
1009              
1010             $self->yield( $poe_event, @args );
1011              
1012             Provides an interface to L's yield/post() method, dispatching
1013             POE events within the context of the emitter's session.
1014              
1015             The event can be either a named event/state dispatched to your Emitter's
1016             L:
1017              
1018             $emitter->yield( 'some_event', @args );
1019              
1020             ... or an anonymous coderef, which is executed as if it were a named
1021             POE state belonging to your Emitter:
1022              
1023             $emitter->yield( sub {
1024             ## $_[OBJECT] is the Emitter's object:
1025             my ($kernel, $self) = @_[KERNEL, OBJECT];
1026             my @params = @_[ARG0 .. $#_];
1027              
1028             ## $_[STATE] is the current coderef
1029             ## Yield ourselves again, for example:
1030             $self->yield( $_[STATE], @new_args )
1031             if $some_condition;
1032             }, $some, $args );
1033              
1034             Inside an anonymous coderef callback such as shown above, C<$_[OBJECT]> is
1035             the Emitter's C<$self> object and C<$_[STATE]> contains the callback
1036             coderef itself.
1037              
1038             =head3 call
1039              
1040             $self->call( $poe_event, @args );
1041              
1042             The synchronous counterpart to L.
1043              
1044             =head3 timer
1045              
1046             my $alarm_id = $self->timer(
1047             $delayed_seconds,
1048             $event,
1049             @args
1050             );
1051              
1052             Set a timer in the context of the emitter's L. Returns the
1053             POE alarm ID.
1054              
1055             The event can be either a named event/state or an anonymous coderef (see
1056             L).
1057              
1058             A prefixed (L) 'timer_set' event is emitted when a timer is
1059             set. Arguments are the alarm ID, the event name or coderef, the delay time,
1060             and any event parameters, respectively.
1061              
1062             =head3 timer_del
1063              
1064             $self->timer_del( $alarm_id );
1065              
1066             Clears a pending L.
1067              
1068             A prefixed (L) 'timer_deleted' event is emitted when a timer
1069             is deleted. Arguments are the removed alarm ID, the event name or coderef,
1070             and any event parameters, respectively.
1071              
1072             =head2 Signals
1073              
1074             =head3 Shutdown Signal
1075              
1076             The attribute L defines a POE signal that will trigger a
1077             shutdown; it defaults to C:
1078              
1079             ## Shutdown *all* emitters (with a default shutdown_signal()):
1080             $poe_kernel->signal( $poe_kernel, 'SHUTDOWN_EMITTER' );
1081              
1082             See L for details on L signals.
1083              
1084             =head1 SEE ALSO
1085              
1086             For details regarding POE, see L, L, L
1087              
1088             For details regarding Moo classes and Roles, see L, L,
1089             L
1090              
1091             =head1 AUTHOR
1092              
1093             Jon Portnoy
1094              
1095             Written from the ground up, but conceptually derived from
1096             L-0.06 by BINGOS, HINRIK,
1097             APOCAL et al. That will probably do you for non-Moo(se) use cases; I
1098             needed something cow-like that worked with L.
1099              
1100             Licensed under the same terms as perl5
1101              
1102             =cut
1103