File Coverage

blib/lib/Venus/Role/Subscribable.pm
Criterion Covered Total %
statement 42 42 100.0
branch 15 16 93.7
condition 2 2 100.0
subroutine 11 11 100.0
pod 5 7 71.4
total 75 78 96.1


line stmt bran cond sub pod time code
1             package Venus::Role::Subscribable;
2              
3 1     1   24 use 5.018;
  1         4  
4              
5 1     1   5 use strict;
  1         2  
  1         39  
6 1     1   5 use warnings;
  1         1  
  1         34  
7              
8 1     1   12 use Venus::Role 'with';
  1         4  
  1         11  
9              
10             # METHODS
11              
12             sub name {
13 35     35 1 66 my ($name) = @_;
14              
15 35 100       170 $name = lc $name =~ s/\W+/_/gr if $name;
16              
17 35         145 return $name;
18             }
19              
20             sub publish {
21 6     6 1 21 my ($self, $name, @args) = @_;
22              
23 6 100       25 $name = name($name) or return $self;
24              
25 5         12 &$_(@args) for @{subscriptions($self)->{$name}};
  5         13  
26              
27 5         49 return $self;
28             }
29              
30             sub subscribe {
31 15     15 1 41 my ($self, $name, $code) = @_;
32              
33 15 50       29 $name = name($name) or return $self;
34              
35 15         29 push @{subscriptions($self)->{$name}}, $code;
  15         39  
36              
37 15         232 return $self;
38             }
39              
40             sub subscribers {
41 8     8 1 17 my ($self, $name) = @_;
42              
43 8 100       15 $name = name($name) or return 0;
44              
45 7 100       20 if (exists subscriptions($self)->{$name}) {
46 4         7 return 0+@{subscriptions($self)->{$name}};
  4         9  
47             }
48             else {
49 3         12 return 0;
50             }
51             }
52              
53             sub subscriptions {
54 43     43 0 64 my ($self) = @_;
55              
56 43   100     297 return $self->{'$subscriptions'} ||= {};
57             }
58              
59             sub unsubscribe {
60 6     6 1 18 my ($self, $name, $code) = @_;
61              
62 6 100       15 $name = name($name) or return $self;
63              
64 5 100       61 if ($code) {
65             subscriptions($self)->{$name} = [
66 3         6 grep { $code ne $_ } @{subscriptions($self)->{$name}}
  4         21  
  3         8  
67             ];
68             }
69             else {
70 2         6 delete subscriptions($self)->{$name};
71             }
72              
73 5 100       17 delete subscriptions($self)->{$name} if !$self->subscribers($name);
74              
75 5         76 return $self;
76             }
77              
78             # EXPORTS
79              
80             sub EXPORT {
81 14     14 0 62 ['publish', 'subscribe', 'subscribers', 'unsubscribe']
82             }
83              
84             1;
85              
86              
87              
88             =head1 NAME
89              
90             Venus::Role::Subscribable - Subscribable Role
91              
92             =cut
93              
94             =head1 ABSTRACT
95              
96             Subscribable Role for Perl 5
97              
98             =cut
99              
100             =head1 SYNOPSIS
101              
102             package Example;
103              
104             use Venus::Class;
105              
106             with 'Venus::Role::Subscribable';
107              
108             sub execute {
109             $_[0]->publish('on.execute');
110             }
111              
112             package main;
113              
114             my $example = Example->new;
115              
116             # $example->subscribe('on.execute', sub{...});
117              
118             # bless(..., 'Example')
119              
120             # $example->publish('on.execute');
121              
122             # bless(..., 'Example')
123              
124             =cut
125              
126             =head1 DESCRIPTION
127              
128             This package provides a mechanism for publishing and subscribing to events.
129              
130             =cut
131              
132             =head1 METHODS
133              
134             This package provides the following methods:
135              
136             =cut
137              
138             =head2 publish
139              
140             publish(string $name, any @args) (object)
141              
142             The publish method notifies all subscribers for a given event and returns the
143             invocant.
144              
145             I>
146              
147             =over 4
148              
149             =item publish example 1
150              
151             # given: synopsis
152              
153             package main;
154              
155             $example = $example->publish;
156              
157             # bless(..., 'Example')
158              
159             =back
160              
161             =over 4
162              
163             =item publish example 2
164              
165             # given: synopsis
166              
167             package main;
168              
169             $example = $example->publish('on.execute');
170              
171             # bless(..., 'Example')
172              
173             =back
174              
175             =over 4
176              
177             =item publish example 3
178              
179             # given: synopsis
180              
181             package main;
182              
183             $example->subscribe('on.execute', sub {$example->{emitted} = [@_]});
184              
185             $example = $example->publish('on.execute');
186              
187             # bless(..., 'Example')
188              
189             =back
190              
191             =over 4
192              
193             =item publish example 4
194              
195             # given: synopsis
196              
197             package main;
198              
199             $example->subscribe('on.execute', sub {$example->{emitted} = [@_]});
200              
201             $example = $example->publish('on.execute', [1..4]);
202              
203             # bless(..., 'Example')
204              
205             =back
206              
207             =cut
208              
209             =head2 subscribe
210              
211             subscribe(string $name, coderef $code) (object)
212              
213             The subscribe method registers a subscribers (i.e. callbacks) for a given event,
214             and returns the invocant.
215              
216             I>
217              
218             =over 4
219              
220             =item subscribe example 1
221              
222             # given: synopsis
223              
224             package main;
225              
226             $example = $example->subscribe('on.execute', sub {$example->{emitted} = [@_]});
227              
228             # bless(..., 'Example')
229              
230             =back
231              
232             =over 4
233              
234             =item subscribe example 2
235              
236             # given: synopsis
237              
238             package main;
239              
240             $example = $example->subscribe('on.execute', sub {$example->{emitted_1} = [@_]});
241              
242             # bless(..., 'Example')
243              
244             $example = $example->subscribe('on.execute', sub {$example->{emitted_2} = [@_]});
245              
246             # bless(..., 'Example')
247              
248             $example = $example->subscribe('on.execute', sub {$example->{emitted_3} = [@_]});
249              
250             # bless(..., 'Example')
251              
252             # $example->publish('on.execute');
253              
254             # bless(..., 'Example')
255              
256             =back
257              
258             =cut
259              
260             =head2 subscribers
261              
262             subscribers(string $name) (number)
263              
264             The subscribers method returns the number of subscribers (i.e. callbacks) for a
265             given event.
266              
267             I>
268              
269             =over 4
270              
271             =item subscribers example 1
272              
273             # given: synopsis
274              
275             package main;
276              
277             $example = $example->subscribers;
278              
279             # 0
280              
281             =back
282              
283             =over 4
284              
285             =item subscribers example 2
286              
287             # given: synopsis
288              
289             package main;
290              
291             $example = $example->subscribers('on.execute');
292              
293             # 0
294              
295             =back
296              
297             =over 4
298              
299             =item subscribers example 3
300              
301             # given: synopsis
302              
303             package main;
304              
305             $example = $example->subscribe('on.execute', sub {$example->{emitted_1} = [@_]});
306              
307             $example = $example->subscribe('on.execute', sub {$example->{emitted_2} = [@_]});
308              
309             $example = $example->subscribe('on.execute', sub {$example->{emitted_3} = [@_]});
310              
311             $example = $example->subscribers('on.execute');
312              
313             # 3
314              
315             =back
316              
317             =cut
318              
319             =head2 unsubscribe
320              
321             unsubscribe(string $name, coderef $code) (object)
322              
323             The unsubscribe method deregisters all subscribers (i.e. callbacks) for a given
324             event, or a specific callback if provided, and returns the invocant.
325              
326             I>
327              
328             =over 4
329              
330             =item unsubscribe example 1
331              
332             # given: synopsis
333              
334             package main;
335              
336             $example = $example->unsubscribe;
337              
338             # bless(..., 'Example')
339              
340             =back
341              
342             =over 4
343              
344             =item unsubscribe example 2
345              
346             # given: synopsis
347              
348             package main;
349              
350             $example = $example->unsubscribe('on.execute');
351              
352             # bless(..., 'Example')
353              
354             =back
355              
356             =over 4
357              
358             =item unsubscribe example 3
359              
360             # given: synopsis
361              
362             package main;
363              
364             $example = $example->subscribe('on.execute', sub {$example->{emitted_1} = [@_]});
365              
366             $example = $example->subscribe('on.execute', sub {$example->{emitted_2} = [@_]});
367              
368             $example = $example->subscribe('on.execute', sub {$example->{emitted_3} = [@_]});
369              
370             $example = $example->unsubscribe('on.execute');
371              
372             # bless(..., 'Example')
373              
374             =back
375              
376             =over 4
377              
378             =item unsubscribe example 4
379              
380             # given: synopsis
381              
382             package main;
383              
384             my $execute = sub {$example->{execute} = [@_]};
385              
386             $example = $example->subscribe('on.execute', $execute);
387              
388             $example = $example->unsubscribe('on.execute', $execute);
389              
390             # bless(..., 'Example')
391              
392             =back
393              
394             =cut
395              
396             =head1 AUTHORS
397              
398             Awncorp, C
399              
400             =cut
401              
402             =head1 LICENSE
403              
404             Copyright (C) 2000, Awncorp, C.
405              
406             This program is free software, you can redistribute it and/or modify it under
407             the terms of the Apache license version 2.0.
408              
409             =cut