File Coverage

blib/lib/BeamX/Peer/Emitter.pm
Criterion Covered Total %
statement 25 25 100.0
branch 5 8 62.5
condition 3 8 37.5
subroutine 6 6 100.0
pod 2 2 100.0
total 41 49 83.6


line stmt bran cond sub pod time code
1             package BeamX::Peer::Emitter;
2              
3             # ABSTRACT: Beam::Emitter with peer-to-peer messaging
4              
5 1     1   12782 use Types::Standard ':all';
  1         85666  
  1         15  
6 1     1   42016 use Safe::Isa;
  1         2  
  1         159  
7              
8 1     1   5 use Moo::Role;
  1         1  
  1         12  
9             with 'Beam::Emitter';
10              
11             our $VERSION = '0.002';
12              
13             sub _find_listener {
14              
15 2     2   3 my ( $self, $peer, $name ) = @_;
16              
17 2 50       7 return if !defined $peer;
18              
19 2 100       19 return ( grep { $_->has_peer && $_->peer == $peer }
  4         42  
20             $self->listeners( $name ) )[0];
21             }
22              
23             #pod =method subscribe
24             #pod
25             #pod # subscribe as Beam::Emitter does
26             #pod $emitter->subscribe( $event_name, $subref, [, %args] );
27             #pod
28             #pod Subscribe to the named event from C<$emitter>. C<$subref>
29             #pod will be called when the event is emitted.
30             #pod
31             #pod By default, the emitter tracks the listener with an object of class
32             #pod L. C<%args> is used to pass arguments
33             #pod to its constructor.
34             #pod
35             #pod To enable C<$emitter> to send the event directly to a C<$peer> via
36             #pod the L method, specify the peer with the C key in C<%args>.
37             #pod
38             #pod $emitter->subscribe( $event_name, $subref, peer => $peer, %args );
39             #pod
40             #pod To use a different listener class, subclass B
41             #pod and pass its name via the C key in C<%args>.
42             #pod
43             #pod $emitter->subscribe( $event_name, $subref, class => MyListener, %args );
44             #pod
45             #pod =cut
46              
47             around subscribe => sub {
48              
49             my $orig = shift;
50              
51             splice( @_, 3, 0, class => 'BeamX::Peer::Listener', );
52              
53             &$orig;
54             };
55              
56             #pod =method send
57             #pod
58             #pod $emitter->send( $peer, $event_name [, %args] );
59             #pod
60             #pod Send the named event to the specified peer. C<%args> is a list of
61             #pod name, value pairs to pass to the L constructor; use the
62             #pod C key to specify an alternate event class.
63             #pod
64             #pod =cut
65              
66             sub send {
67              
68 1     1 1 6413 my ( $self, $peer, $name, %args ) = @_;
69              
70 1 50       5 my $listener = $self->_find_listener( $peer, $name )
71             or return;
72              
73 1   50     7 my $class = delete $args{class} || "Beam::Event";
74              
75 1   33     5 $args{emitter} ||= $self;
76 1   33     5 $args{name} ||= $name;
77              
78 1         23 my $event = $class->new( %args );
79 1         164 $listener->callback->( $event );
80 1         47 return $event;
81             }
82              
83             #pod =method send_args
84             #pod
85             #pod $emitter->send_args( $peer, $event_name, @args] );
86             #pod
87             #pod Send the named event to the specified peer. C<@args> will be passed
88             #pod to the subscribed callback.
89             #pod
90             #pod =cut
91              
92             sub send_args {
93              
94 1     1 1 3163 my ( $self, $peer, $name, @args ) = @_;
95              
96 1 50       3 my $listener = $self->_find_listener( $peer, $name )
97             or return;
98              
99 1         7 $listener->callback->( @args );
100 1         36 return;
101             }
102              
103              
104             1;
105              
106             #
107             # This file is part of BeamX-Peer-Emitter
108             #
109             # This software is Copyright (c) 2016 by the Smithsonian Astrophysical Observatory.
110             #
111             # This is free software, licensed under:
112             #
113             # The GNU General Public License, Version 3, June 2007
114             #
115              
116             =pod
117              
118             =encoding UTF-8
119              
120             =head1 NAME
121              
122             BeamX::Peer::Emitter - Beam::Emitter with peer-to-peer messaging
123              
124             =head1 VERSION
125              
126             version 0.002
127              
128             =head1 SYNOPSIS
129              
130             use 5.10.0;
131             use Safe::Isa;
132            
133             sub fmt_msg {
134             $_[0]->$_isa( 'Beam::Event' )
135             ? sprintf( "received event '%s' from node %s", $_[0]->name, $_[0]->emitter->id )
136             : join( ' ', @_ );
137             }
138            
139            
140             package Node {
141            
142             use Safe::Isa;
143             use Moo;
144             with 'BeamX::Peer::Emitter';
145            
146             has id => (
147             is => 'ro',
148             required => 1,
149             );
150            
151             sub recv {
152            
153             my $self = shift;
154            
155             say $self->id, ': ', &::fmt_msg;
156             }
157            
158             }
159            
160             my $n1 = Node->new( id => 'N1' );
161             my $n2 = Node->new( id => 'N2' );
162            
163            
164             # standard Beam::Emitter event
165             $n1->subscribe( 'alert', sub { say 'non-peer: ', &fmt_msg } );
166            
167             # explicit peer event
168             $n1->subscribe( 'alert', sub { $n2->recv( @_ ) }, peer => $n2 );
169            
170             say "Broadcast Event object:";
171             $n1->emit( 'alert' );
172            
173             say "\nSend Event object directly to \$n2";
174             $n1->send( $n2, 'alert' );
175            
176             say "\nBroadcast arbitrary args";
177             $n1->emit_args( 'alert', q[Server's Down!] );
178            
179             say "\nSend arbitrary args directly to \$n2";
180             $n1->send_args( $n2, 'alert', q[Let's get coffee!] );
181              
182             Results in:
183              
184             Broadcast Event object:
185             non-peer: received event 'alert' from node N1
186             N2: received event 'alert' from node N1
187              
188             Send Event object directly to $n2
189             N2: received event 'alert' from node N1
190              
191             Broadcast arbitrary args
192             non-peer: Server's Down!
193             N2: Server's Down!
194              
195             Send arbitrary args directly to $n2
196             N2: Let's get coffee!
197              
198             =head1 DESCRIPTION
199              
200             B is a role (based upon L) which
201             adds the ability to notify individual subscribers (peers) of
202             events to L's publish/subscribe capabilities.
203              
204             =head1 METHODS
205              
206             =head2 subscribe
207              
208             # subscribe as Beam::Emitter does
209             $emitter->subscribe( $event_name, $subref, [, %args] );
210              
211             Subscribe to the named event from C<$emitter>. C<$subref>
212             will be called when the event is emitted.
213              
214             By default, the emitter tracks the listener with an object of class
215             L. C<%args> is used to pass arguments
216             to its constructor.
217              
218             To enable C<$emitter> to send the event directly to a C<$peer> via
219             the L method, specify the peer with the C key in C<%args>.
220              
221             $emitter->subscribe( $event_name, $subref, peer => $peer, %args );
222              
223             To use a different listener class, subclass B
224             and pass its name via the C key in C<%args>.
225              
226             $emitter->subscribe( $event_name, $subref, class => MyListener, %args );
227              
228             =head2 send
229              
230             $emitter->send( $peer, $event_name [, %args] );
231              
232             Send the named event to the specified peer. C<%args> is a list of
233             name, value pairs to pass to the L constructor; use the
234             C key to specify an alternate event class.
235              
236             =head2 send_args
237              
238             $emitter->send_args( $peer, $event_name, @args] );
239              
240             Send the named event to the specified peer. C<@args> will be passed
241             to the subscribed callback.
242              
243             =head1 SEE ALSO
244              
245             L
246              
247             =head1 AUTHOR
248              
249             Diab Jerius
250              
251             =head1 COPYRIGHT AND LICENSE
252              
253             This software is Copyright (c) 2016 by the Smithsonian Astrophysical Observatory.
254              
255             This is free software, licensed under:
256              
257             The GNU General Public License, Version 3, June 2007
258              
259             =cut
260              
261             __END__