| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
# Copyright (c) 2011-17, Mitchell Cooper |
|
2
|
|
|
|
|
|
|
# |
|
3
|
|
|
|
|
|
|
# Evented::Object: a simple yet featureful base class event framework. |
|
4
|
|
|
|
|
|
|
# |
|
5
|
|
|
|
|
|
|
# Evented::Object is based on the libuic UIC::Evented::Object: |
|
6
|
|
|
|
|
|
|
# ... which is based on Evented::Object from foxy-java IRC Bot, |
|
7
|
|
|
|
|
|
|
# ... which is based on Evented::Object from Arinity IRC Services, |
|
8
|
|
|
|
|
|
|
# ... which is based on Evented::Object from ntirc IRC Client, |
|
9
|
|
|
|
|
|
|
# ... which is based on IRC::Evented::Object from libirc IRC Library. |
|
10
|
|
|
|
|
|
|
# |
|
11
|
|
|
|
|
|
|
# Evented::Object and its very detailed documentation can be found |
|
12
|
|
|
|
|
|
|
# in their latest versions at https://github.com/cooper/evented-object. |
|
13
|
|
|
|
|
|
|
# |
|
14
|
|
|
|
|
|
|
package Evented::Object; |
|
15
|
|
|
|
|
|
|
|
|
16
|
13
|
|
|
13
|
|
842709
|
use warnings; |
|
|
13
|
|
|
|
|
142
|
|
|
|
13
|
|
|
|
|
459
|
|
|
17
|
13
|
|
|
13
|
|
73
|
use strict; |
|
|
13
|
|
|
|
|
24
|
|
|
|
13
|
|
|
|
|
259
|
|
|
18
|
13
|
|
|
13
|
|
8227
|
use utf8; |
|
|
13
|
|
|
|
|
194
|
|
|
|
13
|
|
|
|
|
71
|
|
|
19
|
13
|
|
|
13
|
|
731
|
use 5.010; |
|
|
13
|
|
|
|
|
52
|
|
|
20
|
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
# these must be set before loading EventFire. |
|
22
|
|
|
|
|
|
|
our ($events, $props, %monitors); |
|
23
|
|
|
|
|
|
|
BEGIN { |
|
24
|
13
|
|
|
13
|
|
61
|
$events = 'eventedObject.events'; |
|
25
|
13
|
|
|
|
|
265
|
$props = 'eventedObject.props'; |
|
26
|
|
|
|
|
|
|
} |
|
27
|
|
|
|
|
|
|
|
|
28
|
13
|
|
|
13
|
|
73
|
use Scalar::Util qw(weaken blessed); |
|
|
13
|
|
|
|
|
23
|
|
|
|
13
|
|
|
|
|
759
|
|
|
29
|
13
|
|
|
13
|
|
5906
|
use Evented::Object::EventFire; |
|
|
13
|
|
|
|
|
33
|
|
|
|
13
|
|
|
|
|
407
|
|
|
30
|
13
|
|
|
13
|
|
6208
|
use Evented::Object::Collection; |
|
|
13
|
|
|
|
|
45
|
|
|
|
13
|
|
|
|
|
22993
|
|
|
31
|
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
our $VERSION = '5.68'; |
|
33
|
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
# creates a new evented object. |
|
35
|
|
|
|
|
|
|
sub new { |
|
36
|
15
|
|
|
15
|
1
|
1132
|
my ($class, %opts) = @_; |
|
37
|
15
|
|
|
|
|
62
|
bless \%opts, $class; |
|
38
|
|
|
|
|
|
|
} |
|
39
|
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
############################# |
|
41
|
|
|
|
|
|
|
### REGISTERING CALLBACKS ### |
|
42
|
|
|
|
|
|
|
############################# |
|
43
|
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
# ->register_callback() |
|
45
|
|
|
|
|
|
|
# |
|
46
|
|
|
|
|
|
|
# aliases: ->register_event(), ->on() |
|
47
|
|
|
|
|
|
|
# attaches an event callback. |
|
48
|
|
|
|
|
|
|
# |
|
49
|
|
|
|
|
|
|
# $eo->register_callback(myEvent => sub { |
|
50
|
|
|
|
|
|
|
# ... |
|
51
|
|
|
|
|
|
|
# }, 'some.callback.name', priority => 200); |
|
52
|
|
|
|
|
|
|
# |
|
53
|
|
|
|
|
|
|
sub register_callback { |
|
54
|
35
|
|
|
35
|
1
|
381
|
my ($eo, $event_name, $code, @opts_) = @_; |
|
55
|
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
# if there is an odd number of options, the first is the callback name. |
|
57
|
|
|
|
|
|
|
# this also implies with_eo. |
|
58
|
35
|
|
|
|
|
56
|
my %opts; |
|
59
|
35
|
50
|
|
|
|
111
|
if (@opts_ % 2) { |
|
60
|
0
|
|
|
|
|
0
|
%opts = ( |
|
61
|
|
|
|
|
|
|
name => shift @opts_, |
|
62
|
|
|
|
|
|
|
with_eo => 1, |
|
63
|
|
|
|
|
|
|
@opts_ |
|
64
|
|
|
|
|
|
|
); |
|
65
|
|
|
|
|
|
|
} |
|
66
|
|
|
|
|
|
|
else { |
|
67
|
35
|
|
|
|
|
95
|
%opts = @opts_; |
|
68
|
|
|
|
|
|
|
} |
|
69
|
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
# no name was provided, so we shall construct one using pure hackery. |
|
71
|
|
|
|
|
|
|
# this is one of the most criminal things I've ever done. |
|
72
|
35
|
|
|
|
|
115
|
my @caller = caller; |
|
73
|
35
|
100
|
|
|
|
109
|
if (!defined $opts{name}) { |
|
74
|
21
|
|
|
|
|
39
|
state $c = -1; $c++; |
|
|
21
|
|
|
|
|
36
|
|
|
75
|
21
|
|
|
|
|
90
|
$opts{name} = "$event_name:$caller[0]($caller[2],$c)"; |
|
76
|
|
|
|
|
|
|
} |
|
77
|
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
# determine the event store. |
|
79
|
35
|
|
|
|
|
90
|
my $event_store = _event_store($eo); |
|
80
|
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
# before/after a callback. |
|
82
|
35
|
|
100
|
|
|
134
|
my $priority = delete $opts{priority} || 0; |
|
83
|
35
|
100
|
100
|
|
|
175
|
if (defined $opts{before} or defined $opts{after}) { |
|
84
|
7
|
|
|
|
|
13
|
$priority = 'nan'; |
|
85
|
|
|
|
|
|
|
# nan priority indicates it should be determined at a later time. |
|
86
|
|
|
|
|
|
|
} |
|
87
|
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
# add the callback. |
|
89
|
35
|
|
100
|
|
|
185
|
my $callbacks = $event_store->{$event_name}{$priority} ||= []; |
|
90
|
35
|
|
|
|
|
168
|
push @$callbacks, my $cb = { |
|
91
|
|
|
|
|
|
|
%opts, |
|
92
|
|
|
|
|
|
|
code => $code, |
|
93
|
|
|
|
|
|
|
caller => \@caller |
|
94
|
|
|
|
|
|
|
}; |
|
95
|
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
# tell class monitor. |
|
97
|
|
|
|
|
|
|
_monitor_fire( |
|
98
|
35
|
|
33
|
|
|
220
|
$opts{_caller} // $caller[0], |
|
99
|
|
|
|
|
|
|
register_callback => $eo, $event_name, $cb |
|
100
|
|
|
|
|
|
|
); |
|
101
|
|
|
|
|
|
|
|
|
102
|
35
|
|
|
|
|
106
|
return $cb; |
|
103
|
|
|
|
|
|
|
} |
|
104
|
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
# ->register_callbacks() |
|
106
|
|
|
|
|
|
|
# |
|
107
|
|
|
|
|
|
|
# attaches several event callbacks at once. |
|
108
|
|
|
|
|
|
|
# |
|
109
|
|
|
|
|
|
|
sub register_callbacks { |
|
110
|
0
|
|
|
0
|
1
|
0
|
my $eo = shift; |
|
111
|
0
|
|
|
|
|
0
|
return map { $eo->register_callback(%$_, _caller => caller) } @_; |
|
|
0
|
|
|
|
|
0
|
|
|
112
|
|
|
|
|
|
|
} |
|
113
|
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
########################## |
|
115
|
|
|
|
|
|
|
### DELETING CALLBACKS ### |
|
116
|
|
|
|
|
|
|
########################## |
|
117
|
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
# ->delete_callback(event_name => 'callback.name') |
|
119
|
|
|
|
|
|
|
# ->delete_event('event_name') |
|
120
|
|
|
|
|
|
|
# |
|
121
|
|
|
|
|
|
|
# deletes an event callback or all callbacks of an event. |
|
122
|
|
|
|
|
|
|
# returns a true value if any events were deleted, false otherwise. |
|
123
|
|
|
|
|
|
|
# more specifically, it returns the number of callbacks deleted. |
|
124
|
|
|
|
|
|
|
# |
|
125
|
|
|
|
|
|
|
sub delete_callback { |
|
126
|
16
|
|
|
16
|
1
|
71
|
my ($eo, $event_name, $name, $caller) = @_; |
|
127
|
16
|
50
|
33
|
|
|
113
|
my @caller = $caller && ref $caller eq 'ARRAY' ? @$caller : caller; |
|
128
|
16
|
|
|
|
|
40
|
my $amount = 0; |
|
129
|
16
|
|
|
|
|
36
|
my $event_store = _event_store($eo); |
|
130
|
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
# event does not have any callbacks. |
|
132
|
16
|
50
|
|
|
|
77
|
return 0 unless $event_store->{$event_name}; |
|
133
|
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
# if no callback is specified, delete all events of this type. |
|
135
|
16
|
100
|
|
|
|
76
|
if (!$name) { |
|
136
|
15
|
|
|
|
|
29
|
$amount = scalar keys %{ $event_store->{$event_name} }; |
|
|
15
|
|
|
|
|
45
|
|
|
137
|
15
|
|
|
|
|
129
|
delete $event_store->{$event_name}; |
|
138
|
15
|
|
|
|
|
57
|
_monitor_fire($caller[0], delete_event => $eo, $event_name); |
|
139
|
15
|
|
|
|
|
39
|
return $amount; |
|
140
|
|
|
|
|
|
|
} |
|
141
|
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
# iterate through callbacks and delete matches. |
|
143
|
1
|
|
|
|
|
1
|
PRIORITY: foreach my $priority (keys %{ $event_store->{$event_name} }) { |
|
|
1
|
|
|
|
|
5
|
|
|
144
|
2
|
|
|
|
|
5
|
my $callbacks = $event_store->{$event_name}{$priority}; |
|
145
|
2
|
|
|
|
|
2
|
my @goodbacks; |
|
146
|
|
|
|
|
|
|
|
|
147
|
2
|
|
|
|
|
4
|
CALLBACK: foreach my $cb (@$callbacks) { |
|
148
|
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
# don't want this one. |
|
150
|
2
|
100
|
66
|
|
|
12
|
if (ref $cb ne 'HASH' || $cb->{name} eq $name) { |
|
151
|
1
|
|
|
|
|
1
|
$amount++; |
|
152
|
1
|
|
|
|
|
3
|
next CALLBACK; |
|
153
|
|
|
|
|
|
|
} |
|
154
|
|
|
|
|
|
|
|
|
155
|
1
|
|
|
|
|
2
|
push @goodbacks, $cb; |
|
156
|
|
|
|
|
|
|
} |
|
157
|
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
# no callbacks left in this priority. |
|
159
|
2
|
100
|
|
|
|
5
|
if (!scalar @goodbacks) { |
|
160
|
1
|
|
|
|
|
3
|
delete $event_store->{$event_name}{$priority}; |
|
161
|
1
|
|
|
|
|
5
|
next PRIORITY; |
|
162
|
|
|
|
|
|
|
} |
|
163
|
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
# keep these callbacks. |
|
165
|
1
|
|
|
|
|
5
|
@$callbacks = @goodbacks; |
|
166
|
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
} |
|
168
|
|
|
|
|
|
|
|
|
169
|
1
|
|
|
|
|
3
|
return $amount; |
|
170
|
|
|
|
|
|
|
} |
|
171
|
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
# ->delete_all_events() |
|
173
|
|
|
|
|
|
|
# |
|
174
|
|
|
|
|
|
|
# deletes all the callbacks of EVERY event. |
|
175
|
|
|
|
|
|
|
# useful when you're done with an object to ensure any possible self-referencing |
|
176
|
|
|
|
|
|
|
# callbacks are properly destroyed for garbage collection to work. |
|
177
|
|
|
|
|
|
|
# |
|
178
|
|
|
|
|
|
|
sub delete_all_events { |
|
179
|
15
|
|
|
15
|
1
|
47
|
my ($eo, $amount) = (shift, 0); |
|
180
|
15
|
50
|
|
|
|
41
|
my $event_store = _event_store($eo) or return; |
|
181
|
15
|
50
|
|
|
|
74
|
ref $event_store eq 'HASH' or return; |
|
182
|
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
# delete one-by-one. |
|
184
|
|
|
|
|
|
|
# we can't simply set an empty list because monitor events must be fired. |
|
185
|
15
|
|
|
|
|
62
|
foreach my $event_name (keys %$event_store) { |
|
186
|
14
|
|
|
|
|
57
|
$eo->delete_event($event_name); |
|
187
|
14
|
|
|
|
|
30
|
$amount++; |
|
188
|
|
|
|
|
|
|
} |
|
189
|
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
# just clear it to be safe. |
|
191
|
15
|
|
|
|
|
43
|
%$event_store = (); |
|
192
|
15
|
|
|
|
|
37
|
delete $eo->{$events}; |
|
193
|
15
|
|
|
|
|
34
|
delete $eo->{$props}; |
|
194
|
|
|
|
|
|
|
|
|
195
|
15
|
|
|
|
|
1648
|
return $amount; |
|
196
|
|
|
|
|
|
|
} |
|
197
|
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
######################## |
|
199
|
|
|
|
|
|
|
### PREPARING EVENTS ### |
|
200
|
|
|
|
|
|
|
######################## |
|
201
|
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
# ->prepare() |
|
203
|
|
|
|
|
|
|
# |
|
204
|
|
|
|
|
|
|
# automatically guesses whether to use |
|
205
|
|
|
|
|
|
|
# ->prepare_event() or ->prepare_together(). |
|
206
|
|
|
|
|
|
|
# |
|
207
|
|
|
|
|
|
|
sub prepare { |
|
208
|
2
|
|
|
2
|
1
|
11
|
my ($eo_maybe, $eo) = $_[0]; |
|
209
|
2
|
50
|
33
|
|
|
19
|
$eo = shift if blessed $eo_maybe && $eo_maybe->isa(__PACKAGE__); |
|
210
|
2
|
50
|
33
|
|
|
7
|
if (ref $_[0] && ref $_[0] eq 'ARRAY') { |
|
211
|
0
|
|
|
|
|
0
|
return $eo->prepare_together(@_); |
|
212
|
|
|
|
|
|
|
} |
|
213
|
2
|
|
|
|
|
6
|
return $eo->prepare_event(@_); |
|
214
|
|
|
|
|
|
|
} |
|
215
|
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
# ->prepare_event() |
|
217
|
|
|
|
|
|
|
# |
|
218
|
|
|
|
|
|
|
# prepares a single event fire by creating a callback collection. |
|
219
|
|
|
|
|
|
|
# returns the collection. |
|
220
|
|
|
|
|
|
|
# |
|
221
|
|
|
|
|
|
|
sub prepare_event { |
|
222
|
13
|
|
|
13
|
1
|
44
|
my ($eo, $event_name, @args) = @_; |
|
223
|
13
|
|
|
|
|
60
|
return $eo->prepare_together([ $event_name, @args ]); |
|
224
|
|
|
|
|
|
|
} |
|
225
|
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
# ->prepare_together() |
|
227
|
|
|
|
|
|
|
# |
|
228
|
|
|
|
|
|
|
# prepares several events fire by creating a callback collection. |
|
229
|
|
|
|
|
|
|
# returns the collection. |
|
230
|
|
|
|
|
|
|
# |
|
231
|
|
|
|
|
|
|
sub prepare_together { |
|
232
|
13
|
|
|
13
|
1
|
27
|
my $obj; |
|
233
|
13
|
|
|
|
|
147
|
my $collection = Evented::Object::Collection->new; |
|
234
|
13
|
|
|
|
|
44
|
foreach my $set (@_) { |
|
235
|
26
|
|
|
|
|
48
|
my $eo; |
|
236
|
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
# called with evented object. |
|
238
|
26
|
100
|
|
|
|
113
|
if (blessed $set) { |
|
239
|
13
|
50
|
|
|
|
146
|
$set->isa(__PACKAGE__) or return; |
|
240
|
13
|
|
|
|
|
49
|
$obj = $set; |
|
241
|
13
|
|
|
|
|
57
|
next; |
|
242
|
|
|
|
|
|
|
} |
|
243
|
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
# okay, it's an array ref of |
|
245
|
|
|
|
|
|
|
# [ $eo (optional), $event_name => @args ] |
|
246
|
13
|
50
|
|
|
|
89
|
ref $set eq 'ARRAY' or next; |
|
247
|
13
|
|
|
|
|
48
|
my ($eo_maybe, $event_name, @args); |
|
248
|
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
# was an object specified? |
|
250
|
13
|
|
|
|
|
51
|
$eo_maybe = shift @$set; |
|
251
|
13
|
50
|
33
|
|
|
86
|
if (blessed $eo_maybe && $eo_maybe->isa(__PACKAGE__)) { |
|
252
|
0
|
|
|
|
|
0
|
$eo = $eo_maybe; |
|
253
|
0
|
|
|
|
|
0
|
($event_name, @args) = @$set; |
|
254
|
|
|
|
|
|
|
} |
|
255
|
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
# no object; fall back to $obj. |
|
257
|
|
|
|
|
|
|
else { |
|
258
|
13
|
50
|
|
|
|
79
|
$eo = $obj or return; |
|
259
|
13
|
|
|
|
|
57
|
($event_name, @args) = ($eo_maybe, @$set); |
|
260
|
|
|
|
|
|
|
} |
|
261
|
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
# add to the collection. |
|
263
|
13
|
|
|
|
|
74
|
my ($callbacks, $names) = |
|
264
|
|
|
|
|
|
|
_get_callbacks($eo, $event_name, @args); |
|
265
|
13
|
|
|
|
|
78
|
$collection->push_callbacks($callbacks, $names); |
|
266
|
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
} |
|
268
|
|
|
|
|
|
|
|
|
269
|
13
|
|
|
|
|
97
|
return $collection; |
|
270
|
|
|
|
|
|
|
} |
|
271
|
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
##################### |
|
273
|
|
|
|
|
|
|
### FIRING EVENTS ### |
|
274
|
|
|
|
|
|
|
##################### |
|
275
|
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
# ->fire_event() |
|
277
|
|
|
|
|
|
|
# |
|
278
|
|
|
|
|
|
|
# prepares an event and then fires it. |
|
279
|
|
|
|
|
|
|
# |
|
280
|
|
|
|
|
|
|
sub fire_event { |
|
281
|
11
|
|
|
11
|
1
|
110
|
shift->prepare_event(shift, @_)->fire(caller => [caller 1]); |
|
282
|
|
|
|
|
|
|
} |
|
283
|
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
# ->fire_events_together() |
|
285
|
|
|
|
|
|
|
# fire_events_together() |
|
286
|
|
|
|
|
|
|
# |
|
287
|
|
|
|
|
|
|
# prepares several events and then fires them together. |
|
288
|
|
|
|
|
|
|
# |
|
289
|
|
|
|
|
|
|
sub fire_events_together { |
|
290
|
0
|
|
|
0
|
1
|
0
|
prepare_together(@_)->fire(caller => [caller 1]); |
|
291
|
|
|
|
|
|
|
} |
|
292
|
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
# ->fire_once() |
|
294
|
|
|
|
|
|
|
# |
|
295
|
|
|
|
|
|
|
# prepares an event, fires it, and deletes all callbacks afterward. |
|
296
|
|
|
|
|
|
|
# |
|
297
|
|
|
|
|
|
|
sub fire_once { |
|
298
|
0
|
|
|
0
|
1
|
0
|
my ($eo, $event_name, @args) = @_; |
|
299
|
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
# fire with this caller. |
|
301
|
0
|
|
|
|
|
0
|
my $fire = $eo->prepare_event($event_name, @args)->fire( |
|
302
|
|
|
|
|
|
|
caller => [caller 1] |
|
303
|
|
|
|
|
|
|
); |
|
304
|
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
# delete the event. |
|
306
|
0
|
|
|
|
|
0
|
$eo->delete_event($event_name); |
|
307
|
0
|
|
|
|
|
0
|
return $fire; |
|
308
|
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
} |
|
310
|
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
######################## |
|
312
|
|
|
|
|
|
|
### LISTENER OBJECTS ### |
|
313
|
|
|
|
|
|
|
######################## |
|
314
|
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
# ->add_listener() |
|
316
|
|
|
|
|
|
|
# |
|
317
|
|
|
|
|
|
|
# adds an object as a listener of another object's events. |
|
318
|
|
|
|
|
|
|
# see "listeners" in the documentation. |
|
319
|
|
|
|
|
|
|
# |
|
320
|
|
|
|
|
|
|
sub add_listener { |
|
321
|
3
|
|
|
3
|
1
|
27
|
my ($eo, $obj, $prefix) = @_; |
|
322
|
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
# find listeners list. |
|
324
|
3
|
|
50
|
|
|
39
|
my $listeners = $eo->{$props}{listeners} ||= []; |
|
325
|
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
# store this listener. |
|
327
|
3
|
|
|
|
|
24
|
push @$listeners, [$prefix, $obj]; |
|
328
|
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
# weaken the reference to the listener. |
|
330
|
3
|
|
|
|
|
19
|
weaken($listeners->[$#$listeners][1]); |
|
331
|
|
|
|
|
|
|
|
|
332
|
3
|
|
|
|
|
8
|
return 1; |
|
333
|
|
|
|
|
|
|
} |
|
334
|
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
# ->delete_listener() |
|
336
|
|
|
|
|
|
|
# |
|
337
|
|
|
|
|
|
|
# removes an object which was listening to another object's events. |
|
338
|
|
|
|
|
|
|
# see "listeners" in the documentation. |
|
339
|
|
|
|
|
|
|
# |
|
340
|
|
|
|
|
|
|
sub delete_listener { |
|
341
|
0
|
|
|
0
|
1
|
0
|
my ($eo, $obj) = @_; |
|
342
|
0
|
0
|
|
|
|
0
|
return 1 unless my $listeners = $eo->{$props}{listeners}; |
|
343
|
|
|
|
|
|
|
@$listeners = grep { |
|
344
|
0
|
0
|
|
|
|
0
|
ref $_->[1] eq 'ARRAY' and $_->[1] != $obj |
|
|
0
|
|
|
|
|
0
|
|
|
345
|
|
|
|
|
|
|
} @$listeners; |
|
346
|
0
|
|
|
|
|
0
|
return 1; |
|
347
|
|
|
|
|
|
|
} |
|
348
|
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
###################### |
|
350
|
|
|
|
|
|
|
### CLASS MONITORS ### |
|
351
|
|
|
|
|
|
|
###################### |
|
352
|
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
# for objective use $eo->monitor_events($pkg) |
|
354
|
0
|
|
|
0
|
1
|
0
|
sub monitor_events { add_class_monitor(reverse @_) } |
|
355
|
0
|
|
|
0
|
1
|
0
|
sub stop_monitoring { delete_class_monitor(reverse @_) } |
|
356
|
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
# add_class_monitor() |
|
358
|
|
|
|
|
|
|
# |
|
359
|
|
|
|
|
|
|
# set the monitor object of a class. |
|
360
|
|
|
|
|
|
|
# |
|
361
|
|
|
|
|
|
|
# TODO: honestly class monitors need to track individual callbacks so that the |
|
362
|
|
|
|
|
|
|
# monitor is notified of all deletes of callbacks added by the class being |
|
363
|
|
|
|
|
|
|
# monitored even if the delete action was not committed by that package. |
|
364
|
|
|
|
|
|
|
# |
|
365
|
|
|
|
|
|
|
sub add_class_monitor { |
|
366
|
0
|
|
|
0
|
0
|
0
|
my ($pkg, $obj) = @_; |
|
367
|
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
# ensure it's an evented object. |
|
369
|
0
|
0
|
|
|
|
0
|
return unless $obj->isa(__PACKAGE__); |
|
370
|
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
# it's already in the list. |
|
372
|
0
|
|
0
|
|
|
0
|
my $m = $monitors{$pkg} ||= []; |
|
373
|
0
|
0
|
|
|
|
0
|
return if grep { $_ == $obj } @$m = grep { defined } @$m; |
|
|
0
|
|
|
|
|
0
|
|
|
|
0
|
|
|
|
|
0
|
|
|
374
|
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
# hold a weak reference to the monitor. |
|
376
|
0
|
|
|
|
|
0
|
push @$m, $obj; |
|
377
|
0
|
|
|
|
|
0
|
weaken($monitors{$pkg}[$#$m]); |
|
378
|
|
|
|
|
|
|
|
|
379
|
0
|
|
|
|
|
0
|
return 1; |
|
380
|
|
|
|
|
|
|
} |
|
381
|
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
# delete_class_monitor() |
|
383
|
|
|
|
|
|
|
# |
|
384
|
|
|
|
|
|
|
# remove a class monitor object from a class. |
|
385
|
|
|
|
|
|
|
# |
|
386
|
|
|
|
|
|
|
sub delete_class_monitor { |
|
387
|
0
|
|
|
0
|
0
|
0
|
my ($pkg, $obj) = @_; |
|
388
|
0
|
0
|
|
|
|
0
|
my $m = $monitors{$pkg} or return; |
|
389
|
0
|
0
|
|
|
|
0
|
@$m = grep { defined && $_ != $obj } @$m; |
|
|
0
|
|
|
|
|
0
|
|
|
390
|
|
|
|
|
|
|
} |
|
391
|
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
####################### |
|
393
|
|
|
|
|
|
|
### CLASS FUNCTIONS ### |
|
394
|
|
|
|
|
|
|
####################### |
|
395
|
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
# safe_fire($obj, event => ...) |
|
397
|
|
|
|
|
|
|
# |
|
398
|
|
|
|
|
|
|
# checks that an object is blessed and that it is an evented object. |
|
399
|
|
|
|
|
|
|
# if so, prepares and fires an event with optional arguments. |
|
400
|
|
|
|
|
|
|
# |
|
401
|
|
|
|
|
|
|
sub safe_fire { |
|
402
|
0
|
|
|
0
|
1
|
0
|
my $obj = shift; |
|
403
|
0
|
0
|
0
|
|
|
0
|
return if !blessed $obj || !$obj->isa(__PACKAGE__); |
|
404
|
0
|
|
|
|
|
0
|
return $obj->fire_event(@_); |
|
405
|
|
|
|
|
|
|
} |
|
406
|
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
######################### |
|
408
|
|
|
|
|
|
|
### INTERNAL ROUTINES ### |
|
409
|
|
|
|
|
|
|
######################### |
|
410
|
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
# access package storage. |
|
412
|
|
|
|
|
|
|
sub _package_store { |
|
413
|
13
|
|
|
13
|
|
33
|
my $package = shift; |
|
414
|
13
|
|
|
13
|
|
123
|
no strict 'refs'; |
|
|
13
|
|
|
|
|
39
|
|
|
|
13
|
|
|
|
|
12099
|
|
|
415
|
13
|
|
|
|
|
58
|
my $ref = "${package}::__EO__"; |
|
416
|
13
|
100
|
|
|
|
128
|
if (!keys %$ref) { |
|
417
|
12
|
|
|
|
|
47
|
%$ref = (); |
|
418
|
|
|
|
|
|
|
} |
|
419
|
13
|
|
|
|
|
107
|
return *$ref{HASH}; |
|
420
|
|
|
|
|
|
|
} |
|
421
|
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
# fetch the event store of object or package. |
|
423
|
|
|
|
|
|
|
sub _event_store { |
|
424
|
79
|
|
|
79
|
|
134
|
my $eo = shift; |
|
425
|
79
|
100
|
100
|
|
|
514
|
return $eo->{$events} ||= {} if blessed $eo; |
|
426
|
13
|
|
|
|
|
45
|
my $store = _package_store($eo); |
|
427
|
13
|
50
|
100
|
|
|
190
|
return $store->{events} ||= {} if not blessed $eo; |
|
428
|
|
|
|
|
|
|
} |
|
429
|
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
# fetch the property store of object or package. |
|
431
|
|
|
|
|
|
|
sub _prop_store { |
|
432
|
0
|
|
|
0
|
|
0
|
my $eo = shift; |
|
433
|
0
|
0
|
0
|
|
|
0
|
return $eo->{$props} ||= {} if blessed $eo; |
|
434
|
0
|
|
|
|
|
0
|
my $store = _package_store($eo); |
|
435
|
0
|
0
|
0
|
|
|
0
|
return $store->{props} ||= {} if not blessed $eo; |
|
436
|
|
|
|
|
|
|
} |
|
437
|
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
# fetch a callback from its name. |
|
439
|
|
|
|
|
|
|
sub _get_callback_named { |
|
440
|
0
|
|
|
0
|
|
0
|
my ($eo, $event_name, $callback_name) = @_; |
|
441
|
0
|
|
|
|
|
0
|
foreach my $callback (@{ _get_callbacks($eo, $event_name) }) { |
|
|
0
|
|
|
|
|
0
|
|
|
442
|
0
|
0
|
|
|
|
0
|
return $callback if $callback->[2]{name} eq $callback_name |
|
443
|
|
|
|
|
|
|
} |
|
444
|
0
|
|
|
|
|
0
|
return; |
|
445
|
|
|
|
|
|
|
} |
|
446
|
|
|
|
|
|
|
|
|
447
|
|
|
|
|
|
|
# fetches callbacks of an event. |
|
448
|
|
|
|
|
|
|
# internal use only. |
|
449
|
|
|
|
|
|
|
sub _get_callbacks { |
|
450
|
13
|
|
|
13
|
|
65
|
my ($eo, $event_name, @args) = @_; |
|
451
|
13
|
|
|
|
|
28
|
my (%callbacks, %callback_names); |
|
452
|
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
# start out with two stores: the object and the package. |
|
454
|
|
|
|
|
|
|
my @stores = ( |
|
455
|
13
|
|
|
|
|
104
|
[ $event_name => $eo->{$events} ], |
|
456
|
|
|
|
|
|
|
[ $event_name => _event_store(blessed $eo) ] |
|
457
|
|
|
|
|
|
|
); |
|
458
|
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
# if there are any listening objects, add those stores. |
|
461
|
13
|
100
|
|
|
|
87
|
if (my $listeners = $eo->{$props}{listeners}) { |
|
462
|
3
|
|
|
|
|
7
|
my @delete; |
|
463
|
|
|
|
|
|
|
|
|
464
|
3
|
|
|
|
|
16
|
LISTENER: foreach my $i (0 .. $#$listeners) { |
|
465
|
3
|
50
|
|
|
|
21
|
my $l = $listeners->[$i] or next; |
|
466
|
3
|
|
|
|
|
11
|
my ($prefix, $lis) = @$l; |
|
467
|
3
|
|
|
|
|
11
|
my $listener_event_name = $prefix.q(.).$event_name; |
|
468
|
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
# object has been deallocated by garbage disposal, |
|
470
|
|
|
|
|
|
|
# so we can delete this listener. |
|
471
|
3
|
50
|
|
|
|
19
|
if (!$lis) { |
|
472
|
0
|
|
|
|
|
0
|
push @delete, $i; |
|
473
|
0
|
|
|
|
|
0
|
next LISTENER; |
|
474
|
|
|
|
|
|
|
} |
|
475
|
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
|
|
477
|
3
|
|
|
|
|
15
|
push @stores, [ $listener_event_name => $lis->{$events} ]; |
|
478
|
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
} |
|
480
|
|
|
|
|
|
|
|
|
481
|
|
|
|
|
|
|
# delete listeners if necessary. |
|
482
|
3
|
|
|
|
|
11
|
splice @$listeners, $_, 1 foreach @delete; |
|
483
|
|
|
|
|
|
|
|
|
484
|
|
|
|
|
|
|
} |
|
485
|
|
|
|
|
|
|
|
|
486
|
|
|
|
|
|
|
# add callbacks from each store. |
|
487
|
13
|
|
|
|
|
40
|
foreach my $st (@stores) { |
|
488
|
29
|
|
|
|
|
86
|
my ($event_name, $event_store) = @$st; |
|
489
|
29
|
100
|
|
|
|
99
|
my $store = $event_store->{$event_name} or next; |
|
490
|
15
|
|
|
|
|
53
|
foreach my $priority (keys %$store) { |
|
491
|
|
|
|
|
|
|
|
|
492
|
|
|
|
|
|
|
# create a group reference. |
|
493
|
24
|
|
|
|
|
85
|
my $group_id = "$eo/$event_name"; |
|
494
|
24
|
|
|
|
|
83
|
my $group = [ $eo, $event_name, \@args, $group_id ]; |
|
495
|
24
|
|
|
|
|
104
|
weaken($group->[0]); |
|
496
|
|
|
|
|
|
|
|
|
497
|
|
|
|
|
|
|
# add each callback set. inject callback name. |
|
498
|
24
|
|
|
|
|
41
|
foreach my $cb_ref (@{ $store->{$priority} }) { |
|
|
24
|
|
|
|
|
66
|
|
|
499
|
29
|
|
|
|
|
163
|
my %cb = %$cb_ref; # make a copy |
|
500
|
29
|
|
|
|
|
124
|
$cb{id} = "$group_id/$cb{name}"; |
|
501
|
29
|
|
|
|
|
125
|
$callbacks{ $cb{id} } = [ $priority, $group, \%cb ]; |
|
502
|
29
|
|
|
|
|
153
|
$callback_names{$group_id}{ $cb{name} } = $cb{id}; |
|
503
|
|
|
|
|
|
|
} |
|
504
|
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
} |
|
506
|
|
|
|
|
|
|
} |
|
507
|
|
|
|
|
|
|
|
|
508
|
13
|
50
|
|
|
|
135
|
return wantarray ? (\%callbacks, \%callback_names) : \%callbacks; |
|
509
|
|
|
|
|
|
|
} |
|
510
|
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
# fire a class monitor event. |
|
512
|
|
|
|
|
|
|
sub _monitor_fire { |
|
513
|
50
|
|
|
50
|
|
135
|
my ($pkg, $event_name, @args) = @_; |
|
514
|
50
|
50
|
|
|
|
160
|
my $m = $monitors{$pkg} or return; |
|
515
|
0
|
|
|
|
|
0
|
safe_fire($_, "monitor:$event_name" => @args) foreach @$m; |
|
516
|
|
|
|
|
|
|
} |
|
517
|
|
|
|
|
|
|
|
|
518
|
14
|
|
|
14
|
|
21850
|
sub DESTROY { shift->delete_all_events } |
|
519
|
|
|
|
|
|
|
|
|
520
|
|
|
|
|
|
|
############### |
|
521
|
|
|
|
|
|
|
### ALIASES ### |
|
522
|
|
|
|
|
|
|
############### |
|
523
|
|
|
|
|
|
|
|
|
524
|
|
|
|
|
|
|
sub register_event; |
|
525
|
|
|
|
|
|
|
sub register_events; |
|
526
|
|
|
|
|
|
|
sub delete_event; |
|
527
|
|
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
sub on; |
|
529
|
|
|
|
|
|
|
sub del; |
|
530
|
|
|
|
|
|
|
sub fire; |
|
531
|
|
|
|
|
|
|
|
|
532
|
|
|
|
|
|
|
BEGIN { |
|
533
|
13
|
|
|
13
|
|
96
|
*register_event = *register_callback; |
|
534
|
13
|
|
|
|
|
49
|
*register_events = *register_callbacks; |
|
535
|
13
|
|
|
|
|
41
|
*delete_event = *delete_callback; |
|
536
|
13
|
|
|
|
|
32
|
*on = *register_callback; |
|
537
|
13
|
|
|
|
|
36
|
*del = *delete_callback; |
|
538
|
13
|
|
|
|
|
1970
|
*fire = *fire_event; |
|
539
|
|
|
|
|
|
|
} |
|
540
|
|
|
|
|
|
|
|
|
541
|
|
|
|
|
|
|
1; |
|
542
|
|
|
|
|
|
|
|
|
543
|
|
|
|
|
|
|
=head1 NAME |
|
544
|
|
|
|
|
|
|
|
|
545
|
|
|
|
|
|
|
B - base class which allows you to attach callbacks to |
|
546
|
|
|
|
|
|
|
objects and then fire events on them. |
|
547
|
|
|
|
|
|
|
|
|
548
|
|
|
|
|
|
|
=head1 SYNOPSIS |
|
549
|
|
|
|
|
|
|
|
|
550
|
|
|
|
|
|
|
package Person; |
|
551
|
|
|
|
|
|
|
|
|
552
|
|
|
|
|
|
|
use warnings; |
|
553
|
|
|
|
|
|
|
use strict; |
|
554
|
|
|
|
|
|
|
use 5.010; |
|
555
|
|
|
|
|
|
|
use parent 'Evented::Object'; |
|
556
|
|
|
|
|
|
|
|
|
557
|
|
|
|
|
|
|
use Evented::Object; |
|
558
|
|
|
|
|
|
|
|
|
559
|
|
|
|
|
|
|
# Creates a new person object. This is nothing special. |
|
560
|
|
|
|
|
|
|
# Evented::Object does not require any specific constructor to be called. |
|
561
|
|
|
|
|
|
|
sub new { |
|
562
|
|
|
|
|
|
|
my ($class, %opts) = @_; |
|
563
|
|
|
|
|
|
|
bless \%opts, $class; |
|
564
|
|
|
|
|
|
|
} |
|
565
|
|
|
|
|
|
|
|
|
566
|
|
|
|
|
|
|
# Fires birthday event and increments age. |
|
567
|
|
|
|
|
|
|
sub have_birthday { |
|
568
|
|
|
|
|
|
|
my $person = shift; |
|
569
|
|
|
|
|
|
|
$person->fire(birthday => ++$person->{age}); |
|
570
|
|
|
|
|
|
|
} |
|
571
|
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
In some other package... |
|
573
|
|
|
|
|
|
|
|
|
574
|
|
|
|
|
|
|
package main; |
|
575
|
|
|
|
|
|
|
|
|
576
|
|
|
|
|
|
|
# Create a person named Jake at age 19. |
|
577
|
|
|
|
|
|
|
my $jake = Person->new(name => 'Jake', age => 19); |
|
578
|
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
# Add an event callback that assumes Jake is under 21. |
|
580
|
|
|
|
|
|
|
$jake->on(birthday => sub { |
|
581
|
|
|
|
|
|
|
my ($fire, $new_age) = @_; |
|
582
|
|
|
|
|
|
|
say 'not quite 21 yet...'; |
|
583
|
|
|
|
|
|
|
}, name => '21-soon'); |
|
584
|
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
# Add an event callback that checks if Jake is 21 |
|
586
|
|
|
|
|
|
|
# and cancels the above callback if so. |
|
587
|
|
|
|
|
|
|
$jake->on(birthday => sub { |
|
588
|
|
|
|
|
|
|
my ($fire, $new_age) = @_; |
|
589
|
|
|
|
|
|
|
if ($new_age == 21) { |
|
590
|
|
|
|
|
|
|
say 'time to get drunk!'; |
|
591
|
|
|
|
|
|
|
$fire->cancel('21-soon'); |
|
592
|
|
|
|
|
|
|
} |
|
593
|
|
|
|
|
|
|
}, name => 'finally-21', priority => 1); |
|
594
|
|
|
|
|
|
|
|
|
595
|
|
|
|
|
|
|
# Jake has two birthdays. |
|
596
|
|
|
|
|
|
|
|
|
597
|
|
|
|
|
|
|
# Jake's 20th birthday. |
|
598
|
|
|
|
|
|
|
$jake->have_birthday; |
|
599
|
|
|
|
|
|
|
|
|
600
|
|
|
|
|
|
|
# Jake's 21st birthday. |
|
601
|
|
|
|
|
|
|
$jake->have_birthday; |
|
602
|
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
# Because 21-soon has a lower priority than finally-21, |
|
604
|
|
|
|
|
|
|
# finally-21 will cancel 21-soon if Jake is 21. |
|
605
|
|
|
|
|
|
|
|
|
606
|
|
|
|
|
|
|
# The result: |
|
607
|
|
|
|
|
|
|
# |
|
608
|
|
|
|
|
|
|
# not quite 21 yet... |
|
609
|
|
|
|
|
|
|
# time to get drunk! |
|
610
|
|
|
|
|
|
|
|
|
611
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
612
|
|
|
|
|
|
|
|
|
613
|
|
|
|
|
|
|
B |
|
614
|
|
|
|
|
|
|
|
|
615
|
|
|
|
|
|
|
Evented::Object supplies an (obviously objective) interface to store and manage |
|
616
|
|
|
|
|
|
|
callbacks for events, fire events upon objects, and more. |
|
617
|
|
|
|
|
|
|
|
|
618
|
|
|
|
|
|
|
Evented::Object allows you to attach event callbacks to an object |
|
619
|
|
|
|
|
|
|
(i.e., a blessed hash reference) and then fire events on that object. Event |
|
620
|
|
|
|
|
|
|
fires are much like method calls, except that there can be many responders. |
|
621
|
|
|
|
|
|
|
|
|
622
|
|
|
|
|
|
|
Whereas many event systems involve globally unique event names, Evented::Object |
|
623
|
|
|
|
|
|
|
allows you to attach events on specific objects. The event callbacks, |
|
624
|
|
|
|
|
|
|
priority options, and other data are stored within the object itself. |
|
625
|
|
|
|
|
|
|
|
|
626
|
|
|
|
|
|
|
=head1 MANAGING CALLBACKS |
|
627
|
|
|
|
|
|
|
|
|
628
|
|
|
|
|
|
|
The Evented::Object package provides several convenient methods for managing an |
|
629
|
|
|
|
|
|
|
event-driven object. |
|
630
|
|
|
|
|
|
|
|
|
631
|
|
|
|
|
|
|
=head2 Evented::Object->new() |
|
632
|
|
|
|
|
|
|
|
|
633
|
|
|
|
|
|
|
Creates a new Evented::Object. |
|
634
|
|
|
|
|
|
|
|
|
635
|
|
|
|
|
|
|
Typically, this method is overriden by a child class of Evented::Object. |
|
636
|
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
my $eo = Evented::Object->new(); |
|
638
|
|
|
|
|
|
|
|
|
639
|
|
|
|
|
|
|
=head2 $eo->register_callback($event_name => \&callback, %options) |
|
640
|
|
|
|
|
|
|
|
|
641
|
|
|
|
|
|
|
Attaches an event callback the object. |
|
642
|
|
|
|
|
|
|
|
|
643
|
|
|
|
|
|
|
When the specified event is fired, each |
|
644
|
|
|
|
|
|
|
of the callbacks registered using this method will be called by descending |
|
645
|
|
|
|
|
|
|
priority order (numerically higher priority numbers are called first.) |
|
646
|
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
$eo->register_callback(myEvent => sub { |
|
648
|
|
|
|
|
|
|
... |
|
649
|
|
|
|
|
|
|
}, name => 'some.callback', priority => 200); |
|
650
|
|
|
|
|
|
|
|
|
651
|
|
|
|
|
|
|
B |
|
652
|
|
|
|
|
|
|
|
|
653
|
|
|
|
|
|
|
=over |
|
654
|
|
|
|
|
|
|
|
|
655
|
|
|
|
|
|
|
=item * |
|
656
|
|
|
|
|
|
|
|
|
657
|
|
|
|
|
|
|
B<$event_name> - name of the event. |
|
658
|
|
|
|
|
|
|
|
|
659
|
|
|
|
|
|
|
=item * |
|
660
|
|
|
|
|
|
|
|
|
661
|
|
|
|
|
|
|
B<\&callback> - CODE reference to be called when the event is fired. |
|
662
|
|
|
|
|
|
|
|
|
663
|
|
|
|
|
|
|
=item * |
|
664
|
|
|
|
|
|
|
|
|
665
|
|
|
|
|
|
|
B<%options> - I, a hash (NOT a hash reference) of any of the below |
|
666
|
|
|
|
|
|
|
options. |
|
667
|
|
|
|
|
|
|
|
|
668
|
|
|
|
|
|
|
=back |
|
669
|
|
|
|
|
|
|
|
|
670
|
|
|
|
|
|
|
B<%options> - event handler options |
|
671
|
|
|
|
|
|
|
|
|
672
|
|
|
|
|
|
|
All of these options are I, but the use of a callback name is |
|
673
|
|
|
|
|
|
|
B. |
|
674
|
|
|
|
|
|
|
|
|
675
|
|
|
|
|
|
|
=over |
|
676
|
|
|
|
|
|
|
|
|
677
|
|
|
|
|
|
|
=item * |
|
678
|
|
|
|
|
|
|
|
|
679
|
|
|
|
|
|
|
B - name of the callback being registered. must be unique to this |
|
680
|
|
|
|
|
|
|
particular event. |
|
681
|
|
|
|
|
|
|
|
|
682
|
|
|
|
|
|
|
=item * |
|
683
|
|
|
|
|
|
|
|
|
684
|
|
|
|
|
|
|
B - numerical priority of the callback. |
|
685
|
|
|
|
|
|
|
|
|
686
|
|
|
|
|
|
|
=item * |
|
687
|
|
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
B - name of a callback or an array reference of callback names to |
|
689
|
|
|
|
|
|
|
precede. |
|
690
|
|
|
|
|
|
|
|
|
691
|
|
|
|
|
|
|
=item * |
|
692
|
|
|
|
|
|
|
|
|
693
|
|
|
|
|
|
|
B - name of a callback or an array reference of callback names to |
|
694
|
|
|
|
|
|
|
succeed. |
|
695
|
|
|
|
|
|
|
|
|
696
|
|
|
|
|
|
|
=item * |
|
697
|
|
|
|
|
|
|
|
|
698
|
|
|
|
|
|
|
B - data that will be stored as C<< $fire->callback_data >> as the |
|
699
|
|
|
|
|
|
|
callback is fired. If C is a hash reference, its values can be fetched |
|
700
|
|
|
|
|
|
|
conveniently with C<< $fire->callback_data('key') >>. |
|
701
|
|
|
|
|
|
|
|
|
702
|
|
|
|
|
|
|
=item * |
|
703
|
|
|
|
|
|
|
|
|
704
|
|
|
|
|
|
|
B - if true, the evented object will prepended to the argument list |
|
705
|
|
|
|
|
|
|
(which is not the default behavior). note that this is enabled automatically |
|
706
|
|
|
|
|
|
|
when using the odd-argument version. |
|
707
|
|
|
|
|
|
|
|
|
708
|
|
|
|
|
|
|
=item * |
|
709
|
|
|
|
|
|
|
|
|
710
|
|
|
|
|
|
|
B - if true, the L will not |
|
711
|
|
|
|
|
|
|
be prepended to the argument list (which is the default behavior). |
|
712
|
|
|
|
|
|
|
|
|
713
|
|
|
|
|
|
|
=back |
|
714
|
|
|
|
|
|
|
|
|
715
|
|
|
|
|
|
|
Note: the order of objects will always be C<$eo>, C<$fire>, C<@args>, regardless |
|
716
|
|
|
|
|
|
|
of omissions. By default, the argument list is C<$fire>, C<@args>. |
|
717
|
|
|
|
|
|
|
|
|
718
|
|
|
|
|
|
|
You may have any number of C and any |
|
719
|
|
|
|
|
|
|
number of C options for any given callback. For instance, one callback |
|
720
|
|
|
|
|
|
|
may specify to be before 'b' and 'c' but after 'a'. Evented::Object will resolve |
|
721
|
|
|
|
|
|
|
these priorities to its best ability. |
|
722
|
|
|
|
|
|
|
|
|
723
|
|
|
|
|
|
|
In the case that the priorities can not be resolved (for instance, if a callback |
|
724
|
|
|
|
|
|
|
asks to be before 'a' and after 'b' while 'b' has already asked to be before |
|
725
|
|
|
|
|
|
|
'a'), the behavior of Evented::Object is not guaranteed to be consistent. In |
|
726
|
|
|
|
|
|
|
other words, please do your best to not request impossible priorities. |
|
727
|
|
|
|
|
|
|
|
|
728
|
|
|
|
|
|
|
In any case, C and C options are completely ignored when a |
|
729
|
|
|
|
|
|
|
C is explicitly specified. |
|
730
|
|
|
|
|
|
|
|
|
731
|
|
|
|
|
|
|
=head2 $eo->register_callback($event_name => \&callback, $cb_name, %options) |
|
732
|
|
|
|
|
|
|
|
|
733
|
|
|
|
|
|
|
If the list of options is odd, it is assumed that the first element is the |
|
734
|
|
|
|
|
|
|
callback name. In this case, the C option is also automatically |
|
735
|
|
|
|
|
|
|
enabled. |
|
736
|
|
|
|
|
|
|
|
|
737
|
|
|
|
|
|
|
$eo->register_callback(myEvent => sub { |
|
738
|
|
|
|
|
|
|
... |
|
739
|
|
|
|
|
|
|
}, 'some.callback, priority => 200); |
|
740
|
|
|
|
|
|
|
|
|
741
|
|
|
|
|
|
|
See the above method specification for parameters and supported options. |
|
742
|
|
|
|
|
|
|
|
|
743
|
|
|
|
|
|
|
=head2 $eo->register_callbacks(@events) |
|
744
|
|
|
|
|
|
|
|
|
745
|
|
|
|
|
|
|
Registers several event callbacks at once. |
|
746
|
|
|
|
|
|
|
|
|
747
|
|
|
|
|
|
|
The arguments should be a list of hash |
|
748
|
|
|
|
|
|
|
references. These references take the same options as |
|
749
|
|
|
|
|
|
|
C<< ->register_callback() >>. Returns a list of return values in the order that |
|
750
|
|
|
|
|
|
|
the events were specified. |
|
751
|
|
|
|
|
|
|
|
|
752
|
|
|
|
|
|
|
$eo->register_callbacks( |
|
753
|
|
|
|
|
|
|
{ myEvent => \&my_event_1, name => 'cb.1', priority => 200 }, |
|
754
|
|
|
|
|
|
|
{ myEvent => \&my_event_2, name => 'cb.2', priority => 100 } |
|
755
|
|
|
|
|
|
|
); |
|
756
|
|
|
|
|
|
|
|
|
757
|
|
|
|
|
|
|
B |
|
758
|
|
|
|
|
|
|
|
|
759
|
|
|
|
|
|
|
=over |
|
760
|
|
|
|
|
|
|
|
|
761
|
|
|
|
|
|
|
=item * |
|
762
|
|
|
|
|
|
|
|
|
763
|
|
|
|
|
|
|
B<@events> - array of hash references to pass to C<< ->register_callback() >>. |
|
764
|
|
|
|
|
|
|
|
|
765
|
|
|
|
|
|
|
=back |
|
766
|
|
|
|
|
|
|
|
|
767
|
|
|
|
|
|
|
=head2 $eo->delete_event($event_name) |
|
768
|
|
|
|
|
|
|
|
|
769
|
|
|
|
|
|
|
Deletes all callbacks registered for the supplied event. |
|
770
|
|
|
|
|
|
|
|
|
771
|
|
|
|
|
|
|
Returns number of callbacks deleted, false if none. |
|
772
|
|
|
|
|
|
|
|
|
773
|
|
|
|
|
|
|
$eo->delete_event('myEvent'); |
|
774
|
|
|
|
|
|
|
|
|
775
|
|
|
|
|
|
|
B |
|
776
|
|
|
|
|
|
|
|
|
777
|
|
|
|
|
|
|
=over |
|
778
|
|
|
|
|
|
|
|
|
779
|
|
|
|
|
|
|
=item * |
|
780
|
|
|
|
|
|
|
|
|
781
|
|
|
|
|
|
|
B<$event_name> - name of the event. |
|
782
|
|
|
|
|
|
|
|
|
783
|
|
|
|
|
|
|
=back |
|
784
|
|
|
|
|
|
|
|
|
785
|
|
|
|
|
|
|
=head2 $eo->delete_callback($event_name, $callback_name) |
|
786
|
|
|
|
|
|
|
|
|
787
|
|
|
|
|
|
|
Deletes an event callback from the object with the given callback name. |
|
788
|
|
|
|
|
|
|
|
|
789
|
|
|
|
|
|
|
Returns true if a callback was deleted. |
|
790
|
|
|
|
|
|
|
|
|
791
|
|
|
|
|
|
|
$eo->delete_callback(myEvent => 'my.callback'); |
|
792
|
|
|
|
|
|
|
|
|
793
|
|
|
|
|
|
|
B |
|
794
|
|
|
|
|
|
|
|
|
795
|
|
|
|
|
|
|
=over |
|
796
|
|
|
|
|
|
|
|
|
797
|
|
|
|
|
|
|
=item * |
|
798
|
|
|
|
|
|
|
|
|
799
|
|
|
|
|
|
|
B<$event_name> - name of the event. |
|
800
|
|
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
=item * |
|
802
|
|
|
|
|
|
|
|
|
803
|
|
|
|
|
|
|
B<$callback_name> - name of the callback being removed. |
|
804
|
|
|
|
|
|
|
|
|
805
|
|
|
|
|
|
|
=back |
|
806
|
|
|
|
|
|
|
|
|
807
|
|
|
|
|
|
|
=head2 $eo->delete_all_events() |
|
808
|
|
|
|
|
|
|
|
|
809
|
|
|
|
|
|
|
Deletes all events and all callbacks from the object. |
|
810
|
|
|
|
|
|
|
|
|
811
|
|
|
|
|
|
|
If you know that an |
|
812
|
|
|
|
|
|
|
evented object will no longer be used in your program, by calling this method |
|
813
|
|
|
|
|
|
|
you can be sure that no cyclical references from within callbacks will cause the |
|
814
|
|
|
|
|
|
|
object to be leaked. |
|
815
|
|
|
|
|
|
|
|
|
816
|
|
|
|
|
|
|
=head1 FIRING EVENTS |
|
817
|
|
|
|
|
|
|
|
|
818
|
|
|
|
|
|
|
=head2 $eo->fire_event($event_name => @arguments) |
|
819
|
|
|
|
|
|
|
|
|
820
|
|
|
|
|
|
|
Fires the specified event, calling each callback that was registered with |
|
821
|
|
|
|
|
|
|
C<< ->register_callback() >> in descending order of their priorities. |
|
822
|
|
|
|
|
|
|
|
|
823
|
|
|
|
|
|
|
Returns the L. |
|
824
|
|
|
|
|
|
|
|
|
825
|
|
|
|
|
|
|
$eo->fire_event('some_event'); |
|
826
|
|
|
|
|
|
|
|
|
827
|
|
|
|
|
|
|
$eo->fire_event(some_event => $some_argument, $some_other_argument); |
|
828
|
|
|
|
|
|
|
|
|
829
|
|
|
|
|
|
|
B |
|
830
|
|
|
|
|
|
|
|
|
831
|
|
|
|
|
|
|
=over |
|
832
|
|
|
|
|
|
|
|
|
833
|
|
|
|
|
|
|
=item * |
|
834
|
|
|
|
|
|
|
|
|
835
|
|
|
|
|
|
|
B<$event_name> - name of the event being fired. |
|
836
|
|
|
|
|
|
|
|
|
837
|
|
|
|
|
|
|
=item * |
|
838
|
|
|
|
|
|
|
|
|
839
|
|
|
|
|
|
|
B<@arguments> - I, list of arguments to pass to event callbacks. |
|
840
|
|
|
|
|
|
|
|
|
841
|
|
|
|
|
|
|
=back |
|
842
|
|
|
|
|
|
|
|
|
843
|
|
|
|
|
|
|
=head2 $eo->fire_once($event_name => @arguments) |
|
844
|
|
|
|
|
|
|
|
|
845
|
|
|
|
|
|
|
Fires the specified event, calling each callback that was registered with |
|
846
|
|
|
|
|
|
|
C<< ->register_callback() >> in descending order of their priorities. |
|
847
|
|
|
|
|
|
|
|
|
848
|
|
|
|
|
|
|
Then, all callbacks for the event are deleted. This method is useful for |
|
849
|
|
|
|
|
|
|
situations where an event will never be fired more than once. |
|
850
|
|
|
|
|
|
|
|
|
851
|
|
|
|
|
|
|
Returns the L. |
|
852
|
|
|
|
|
|
|
|
|
853
|
|
|
|
|
|
|
$eo->fire_once('some_event'); |
|
854
|
|
|
|
|
|
|
$eo->fire_event(some_event => $some_argument, $some_other_argument); |
|
855
|
|
|
|
|
|
|
# the second does nothing because the first deleted the callbacks |
|
856
|
|
|
|
|
|
|
|
|
857
|
|
|
|
|
|
|
B |
|
858
|
|
|
|
|
|
|
|
|
859
|
|
|
|
|
|
|
=over |
|
860
|
|
|
|
|
|
|
|
|
861
|
|
|
|
|
|
|
=item * |
|
862
|
|
|
|
|
|
|
|
|
863
|
|
|
|
|
|
|
B<$event_name> - name of the event being fired. |
|
864
|
|
|
|
|
|
|
|
|
865
|
|
|
|
|
|
|
=item * |
|
866
|
|
|
|
|
|
|
|
|
867
|
|
|
|
|
|
|
B<@arguments> - I, list of arguments to pass to event callbacks. |
|
868
|
|
|
|
|
|
|
|
|
869
|
|
|
|
|
|
|
=back |
|
870
|
|
|
|
|
|
|
|
|
871
|
|
|
|
|
|
|
=head2 $eo->fire_events_together(@events) |
|
872
|
|
|
|
|
|
|
|
|
873
|
|
|
|
|
|
|
The C function can be used as a method on evented |
|
874
|
|
|
|
|
|
|
objects. See the documentation for the function in L"PROCEDURAL FUNCTIONS">. |
|
875
|
|
|
|
|
|
|
|
|
876
|
|
|
|
|
|
|
=head2 $eo->prepare_event(event_name => @arguments) |
|
877
|
|
|
|
|
|
|
|
|
878
|
|
|
|
|
|
|
Prepares a single event for firing. |
|
879
|
|
|
|
|
|
|
|
|
880
|
|
|
|
|
|
|
Returns an L representing the pending callbacks. |
|
881
|
|
|
|
|
|
|
|
|
882
|
|
|
|
|
|
|
# an example using the fire option return_check. |
|
883
|
|
|
|
|
|
|
$eo->prepare_event(some_event => @arguments)->fire('return_check'); |
|
884
|
|
|
|
|
|
|
|
|
885
|
|
|
|
|
|
|
=head2 $eo->prepare_together(@events) |
|
886
|
|
|
|
|
|
|
|
|
887
|
|
|
|
|
|
|
The preparatory method equivalent to C<< ->fire_events_together >>. |
|
888
|
|
|
|
|
|
|
|
|
889
|
|
|
|
|
|
|
Returns an L representing the pending callbacks. |
|
890
|
|
|
|
|
|
|
|
|
891
|
|
|
|
|
|
|
=head2 $eo->prepare(...) |
|
892
|
|
|
|
|
|
|
|
|
893
|
|
|
|
|
|
|
A smart method that uses the best guess between C<< ->prepare_event >> and |
|
894
|
|
|
|
|
|
|
C<< ->prepare_together >>. |
|
895
|
|
|
|
|
|
|
|
|
896
|
|
|
|
|
|
|
# uses ->prepare_event() |
|
897
|
|
|
|
|
|
|
$eo->prepare(some_event => @arguments); |
|
898
|
|
|
|
|
|
|
|
|
899
|
|
|
|
|
|
|
# uses ->prepare_together() |
|
900
|
|
|
|
|
|
|
$eo->prepare( |
|
901
|
|
|
|
|
|
|
[ some_event => @arguments ], |
|
902
|
|
|
|
|
|
|
[ some_other => @other_arg ] |
|
903
|
|
|
|
|
|
|
); |
|
904
|
|
|
|
|
|
|
|
|
905
|
|
|
|
|
|
|
=head1 LISTENERS |
|
906
|
|
|
|
|
|
|
|
|
907
|
|
|
|
|
|
|
An evented object can I for event notifications from another evented |
|
908
|
|
|
|
|
|
|
object using the method L"$eo-Eadd_listener($other_eo, $prefix)">. |
|
909
|
|
|
|
|
|
|
|
|
910
|
|
|
|
|
|
|
Consider a scenario where you have a class whose objects represent a farm. You |
|
911
|
|
|
|
|
|
|
have another class which represents a cow. You would like to use the same |
|
912
|
|
|
|
|
|
|
callback for all of the moos that occur on the farm, regardless of which cow |
|
913
|
|
|
|
|
|
|
initiated it. |
|
914
|
|
|
|
|
|
|
|
|
915
|
|
|
|
|
|
|
Rather than attaching an event callback to every cow, you can instead make the |
|
916
|
|
|
|
|
|
|
farm a listener of the cow. Then, you can attach a single callback to your farm. |
|
917
|
|
|
|
|
|
|
If your cow's event for mooing is C, your farm's event for any mooing is |
|
918
|
|
|
|
|
|
|
C. |
|
919
|
|
|
|
|
|
|
|
|
920
|
|
|
|
|
|
|
When an event is fired on an object, the same fire object is used for callbacks |
|
921
|
|
|
|
|
|
|
belonging to both the evented object and its listening objects. Therefore, |
|
922
|
|
|
|
|
|
|
callback names should be unique not only to the listener object but to the |
|
923
|
|
|
|
|
|
|
object being listened on as well. |
|
924
|
|
|
|
|
|
|
|
|
925
|
|
|
|
|
|
|
You should also note the values of the |
|
926
|
|
|
|
|
|
|
L: |
|
927
|
|
|
|
|
|
|
|
|
928
|
|
|
|
|
|
|
=over |
|
929
|
|
|
|
|
|
|
|
|
930
|
|
|
|
|
|
|
=item * |
|
931
|
|
|
|
|
|
|
|
|
932
|
|
|
|
|
|
|
B<< $fire->event_name >> - name of the event from the perspective of the |
|
933
|
|
|
|
|
|
|
listener; i.e. C (NOT C) |
|
934
|
|
|
|
|
|
|
|
|
935
|
|
|
|
|
|
|
=item * |
|
936
|
|
|
|
|
|
|
|
|
937
|
|
|
|
|
|
|
B<< $fire->object >> - object being listened to; i.e. C<$cow> (NOT C<$farm>) |
|
938
|
|
|
|
|
|
|
|
|
939
|
|
|
|
|
|
|
=back |
|
940
|
|
|
|
|
|
|
|
|
941
|
|
|
|
|
|
|
This also means that stopping the event from a listener object will cancel |
|
942
|
|
|
|
|
|
|
I remaining callbacks. |
|
943
|
|
|
|
|
|
|
|
|
944
|
|
|
|
|
|
|
=head2 $eo->add_listener($other_eo, $prefix) |
|
945
|
|
|
|
|
|
|
|
|
946
|
|
|
|
|
|
|
Makes the passed evented object a listener of this evented object. |
|
947
|
|
|
|
|
|
|
|
|
948
|
|
|
|
|
|
|
See L"LISTENERS">. |
|
949
|
|
|
|
|
|
|
|
|
950
|
|
|
|
|
|
|
$cow->add_listener($farm, 'cow'); |
|
951
|
|
|
|
|
|
|
|
|
952
|
|
|
|
|
|
|
B |
|
953
|
|
|
|
|
|
|
|
|
954
|
|
|
|
|
|
|
=over |
|
955
|
|
|
|
|
|
|
|
|
956
|
|
|
|
|
|
|
=item * |
|
957
|
|
|
|
|
|
|
|
|
958
|
|
|
|
|
|
|
B<$other_eo> - evented object that will listen. |
|
959
|
|
|
|
|
|
|
|
|
960
|
|
|
|
|
|
|
=item * |
|
961
|
|
|
|
|
|
|
|
|
962
|
|
|
|
|
|
|
B<$prefix> - string that event names will be prefixed with on the listener. |
|
963
|
|
|
|
|
|
|
|
|
964
|
|
|
|
|
|
|
=back |
|
965
|
|
|
|
|
|
|
|
|
966
|
|
|
|
|
|
|
=head2 $eo->delete_listener($other_eo) |
|
967
|
|
|
|
|
|
|
|
|
968
|
|
|
|
|
|
|
Removes a listener of this evented object. |
|
969
|
|
|
|
|
|
|
|
|
970
|
|
|
|
|
|
|
See L"LISTENERS">. |
|
971
|
|
|
|
|
|
|
|
|
972
|
|
|
|
|
|
|
$cow->delete_listener($farm); |
|
973
|
|
|
|
|
|
|
|
|
974
|
|
|
|
|
|
|
B |
|
975
|
|
|
|
|
|
|
|
|
976
|
|
|
|
|
|
|
=over |
|
977
|
|
|
|
|
|
|
|
|
978
|
|
|
|
|
|
|
=item * |
|
979
|
|
|
|
|
|
|
|
|
980
|
|
|
|
|
|
|
B<$other_eo> - evented object that will listen. |
|
981
|
|
|
|
|
|
|
|
|
982
|
|
|
|
|
|
|
=back |
|
983
|
|
|
|
|
|
|
|
|
984
|
|
|
|
|
|
|
=head1 CLASS MONITORS |
|
985
|
|
|
|
|
|
|
|
|
986
|
|
|
|
|
|
|
An evented object can be registered as a "monitor" of a specific class/package. |
|
987
|
|
|
|
|
|
|
|
|
988
|
|
|
|
|
|
|
I event callbacks that are added from that class to I evented object |
|
989
|
|
|
|
|
|
|
of I type will trigger an event on the monitor object. |
|
990
|
|
|
|
|
|
|
|
|
991
|
|
|
|
|
|
|
An example scenario of when this might be useful is an evented object for |
|
992
|
|
|
|
|
|
|
debugging all events being registered by a certain package. It would log all of |
|
993
|
|
|
|
|
|
|
them, making it easier to find a problem. |
|
994
|
|
|
|
|
|
|
|
|
995
|
|
|
|
|
|
|
=head2 $eo->monitor_events($pkg) |
|
996
|
|
|
|
|
|
|
|
|
997
|
|
|
|
|
|
|
Registers an evented object as the class monitor for a specific package. |
|
998
|
|
|
|
|
|
|
|
|
999
|
|
|
|
|
|
|
See L"CLASS MONITORS">. |
|
1000
|
|
|
|
|
|
|
|
|
1001
|
|
|
|
|
|
|
my $some_eo = Evented::Object->new; |
|
1002
|
|
|
|
|
|
|
my $other_eo = Evented::Object->new; |
|
1003
|
|
|
|
|
|
|
|
|
1004
|
|
|
|
|
|
|
$some_eo->on('monitor:register_callback', sub { |
|
1005
|
|
|
|
|
|
|
my ($event, $eo, $event_name, $cb) = @_; |
|
1006
|
|
|
|
|
|
|
# $eo == $other_eo |
|
1007
|
|
|
|
|
|
|
# $event_name == "blah" |
|
1008
|
|
|
|
|
|
|
# $cb == callback hash from ->register_callback() |
|
1009
|
|
|
|
|
|
|
say "Registered $$cb{name} to $eo for $event_name"; |
|
1010
|
|
|
|
|
|
|
}); |
|
1011
|
|
|
|
|
|
|
|
|
1012
|
|
|
|
|
|
|
$some_eo->monitor_events('Some::Class'); |
|
1013
|
|
|
|
|
|
|
|
|
1014
|
|
|
|
|
|
|
package Some::Class; |
|
1015
|
|
|
|
|
|
|
$other_eo->on(blah => sub{}); # will trigger the callback above |
|
1016
|
|
|
|
|
|
|
|
|
1017
|
|
|
|
|
|
|
=over |
|
1018
|
|
|
|
|
|
|
|
|
1019
|
|
|
|
|
|
|
=item * |
|
1020
|
|
|
|
|
|
|
|
|
1021
|
|
|
|
|
|
|
B<$pkg> - package whose event activity you wish to monitor. |
|
1022
|
|
|
|
|
|
|
|
|
1023
|
|
|
|
|
|
|
=back |
|
1024
|
|
|
|
|
|
|
|
|
1025
|
|
|
|
|
|
|
=head2 $eo->stop_monitoring($pkg) |
|
1026
|
|
|
|
|
|
|
|
|
1027
|
|
|
|
|
|
|
Removes an evented object from its current position as a monitor for a specific |
|
1028
|
|
|
|
|
|
|
package. |
|
1029
|
|
|
|
|
|
|
|
|
1030
|
|
|
|
|
|
|
See L"CLASS MONITORS">. |
|
1031
|
|
|
|
|
|
|
|
|
1032
|
|
|
|
|
|
|
$some_eo->stop_monitoring('Some::Class'); |
|
1033
|
|
|
|
|
|
|
|
|
1034
|
|
|
|
|
|
|
=over |
|
1035
|
|
|
|
|
|
|
|
|
1036
|
|
|
|
|
|
|
=item * |
|
1037
|
|
|
|
|
|
|
|
|
1038
|
|
|
|
|
|
|
B<$pkg> - package whose event activity you're monitoring. |
|
1039
|
|
|
|
|
|
|
|
|
1040
|
|
|
|
|
|
|
=back |
|
1041
|
|
|
|
|
|
|
|
|
1042
|
|
|
|
|
|
|
=head1 PROCEDURAL FUNCTIONS |
|
1043
|
|
|
|
|
|
|
|
|
1044
|
|
|
|
|
|
|
The Evented::Object package provides some functions for use. These functions |
|
1045
|
|
|
|
|
|
|
typically are associated with more than one evented object or none at all. |
|
1046
|
|
|
|
|
|
|
|
|
1047
|
|
|
|
|
|
|
=head2 fire_events_together(@events) |
|
1048
|
|
|
|
|
|
|
|
|
1049
|
|
|
|
|
|
|
Fires multiple events at the same time. |
|
1050
|
|
|
|
|
|
|
|
|
1051
|
|
|
|
|
|
|
This allows you to fire multiple similar |
|
1052
|
|
|
|
|
|
|
events on several evented objects at the same time. It essentially pretends that |
|
1053
|
|
|
|
|
|
|
the callbacks are all for the same event and all on the same object. |
|
1054
|
|
|
|
|
|
|
|
|
1055
|
|
|
|
|
|
|
It follows priorities throughout all of the events and all of the objects, so it |
|
1056
|
|
|
|
|
|
|
is ideal for firing similar or identical events on multiple objects. |
|
1057
|
|
|
|
|
|
|
|
|
1058
|
|
|
|
|
|
|
The same L is used throughout. |
|
1059
|
|
|
|
|
|
|
This means that callback names must unique among all of these |
|
1060
|
|
|
|
|
|
|
objects and events. It also means that stopping an event from any callback will |
|
1061
|
|
|
|
|
|
|
cancel all remaining callbacks, regardless to which event or which object they |
|
1062
|
|
|
|
|
|
|
belong. |
|
1063
|
|
|
|
|
|
|
|
|
1064
|
|
|
|
|
|
|
The function takes a list of array references in the form of: |
|
1065
|
|
|
|
|
|
|
C<< [ $evented_object, event_name => @arguments ] >> |
|
1066
|
|
|
|
|
|
|
|
|
1067
|
|
|
|
|
|
|
Evented::Object::fire_events_together( |
|
1068
|
|
|
|
|
|
|
[ $server, user_joined_channel => $user, $channel ], |
|
1069
|
|
|
|
|
|
|
[ $channel, user_joined => $user ], |
|
1070
|
|
|
|
|
|
|
[ $user, joined_channel => $channel ] |
|
1071
|
|
|
|
|
|
|
); |
|
1072
|
|
|
|
|
|
|
|
|
1073
|
|
|
|
|
|
|
C<< ->fire_events_together >> can also be used as a method |
|
1074
|
|
|
|
|
|
|
on any evented object. |
|
1075
|
|
|
|
|
|
|
|
|
1076
|
|
|
|
|
|
|
$eo->fire_events_together( |
|
1077
|
|
|
|
|
|
|
[ some_event => @arguments ], |
|
1078
|
|
|
|
|
|
|
[ some_other => @other_arg ] |
|
1079
|
|
|
|
|
|
|
); |
|
1080
|
|
|
|
|
|
|
|
|
1081
|
|
|
|
|
|
|
The above example would formerly be achieved as: |
|
1082
|
|
|
|
|
|
|
|
|
1083
|
|
|
|
|
|
|
Evented::Object::fire_events_together( |
|
1084
|
|
|
|
|
|
|
[ $eo, some_event => @arguments ], |
|
1085
|
|
|
|
|
|
|
[ $eo, some_other => @other_arg ] |
|
1086
|
|
|
|
|
|
|
); |
|
1087
|
|
|
|
|
|
|
|
|
1088
|
|
|
|
|
|
|
However, other evented objects may be specified even when this is used as a |
|
1089
|
|
|
|
|
|
|
method. Basically, anywhere that an object is missing will fall back to the |
|
1090
|
|
|
|
|
|
|
object on which the method was called. |
|
1091
|
|
|
|
|
|
|
|
|
1092
|
|
|
|
|
|
|
$eo->fire_events_together( |
|
1093
|
|
|
|
|
|
|
[ $other_eo, some_event => @arguments ], |
|
1094
|
|
|
|
|
|
|
[ some_other => @other_arg ] # no object, falls back to $eo |
|
1095
|
|
|
|
|
|
|
); |
|
1096
|
|
|
|
|
|
|
|
|
1097
|
|
|
|
|
|
|
Returns the L. |
|
1098
|
|
|
|
|
|
|
|
|
1099
|
|
|
|
|
|
|
B |
|
1100
|
|
|
|
|
|
|
|
|
1101
|
|
|
|
|
|
|
=over |
|
1102
|
|
|
|
|
|
|
|
|
1103
|
|
|
|
|
|
|
=item * |
|
1104
|
|
|
|
|
|
|
|
|
1105
|
|
|
|
|
|
|
B<@events> - array of events in the form of |
|
1106
|
|
|
|
|
|
|
C<< [$eo, event_name => @arguments] >>. |
|
1107
|
|
|
|
|
|
|
|
|
1108
|
|
|
|
|
|
|
=back |
|
1109
|
|
|
|
|
|
|
|
|
1110
|
|
|
|
|
|
|
=head2 safe_fire($eo, $event_name, @args) |
|
1111
|
|
|
|
|
|
|
|
|
1112
|
|
|
|
|
|
|
Safely fires an event. In other words, if the C<$eo> is not an evented |
|
1113
|
|
|
|
|
|
|
object or is not blessed at all, the call will be ignored. This eliminates the |
|
1114
|
|
|
|
|
|
|
need to use C and C<< ->isa() >> on a value for testing whether it is |
|
1115
|
|
|
|
|
|
|
an evented object. |
|
1116
|
|
|
|
|
|
|
|
|
1117
|
|
|
|
|
|
|
Evented::Object::safe_fire($eo, myEvent => 'my argument'); |
|
1118
|
|
|
|
|
|
|
|
|
1119
|
|
|
|
|
|
|
B |
|
1120
|
|
|
|
|
|
|
|
|
1121
|
|
|
|
|
|
|
=over |
|
1122
|
|
|
|
|
|
|
|
|
1123
|
|
|
|
|
|
|
=item * |
|
1124
|
|
|
|
|
|
|
|
|
1125
|
|
|
|
|
|
|
B<$eo> - evented object. |
|
1126
|
|
|
|
|
|
|
|
|
1127
|
|
|
|
|
|
|
=item * |
|
1128
|
|
|
|
|
|
|
|
|
1129
|
|
|
|
|
|
|
B<$event_name> - name of the event. |
|
1130
|
|
|
|
|
|
|
|
|
1131
|
|
|
|
|
|
|
=item * |
|
1132
|
|
|
|
|
|
|
|
|
1133
|
|
|
|
|
|
|
B<@args> - arguments for the event fire. |
|
1134
|
|
|
|
|
|
|
|
|
1135
|
|
|
|
|
|
|
=back |
|
1136
|
|
|
|
|
|
|
|
|
1137
|
|
|
|
|
|
|
=head1 ALIASES |
|
1138
|
|
|
|
|
|
|
|
|
1139
|
|
|
|
|
|
|
A number of aliases exist for convenience, but please only use them if you're |
|
1140
|
|
|
|
|
|
|
certain that other subclassing will not interfere. |
|
1141
|
|
|
|
|
|
|
|
|
1142
|
|
|
|
|
|
|
=head2 $eo->on(...) |
|
1143
|
|
|
|
|
|
|
|
|
1144
|
|
|
|
|
|
|
Alias for C<< $eo->register_callback() >>. |
|
1145
|
|
|
|
|
|
|
|
|
1146
|
|
|
|
|
|
|
=head2 $eo->del(...) |
|
1147
|
|
|
|
|
|
|
|
|
1148
|
|
|
|
|
|
|
If one argument provided, alias for C<< $eo->delete_event >>. |
|
1149
|
|
|
|
|
|
|
|
|
1150
|
|
|
|
|
|
|
If two arguments provided, alias for C<< $eo->delete_callback >>. |
|
1151
|
|
|
|
|
|
|
|
|
1152
|
|
|
|
|
|
|
=head2 $eo->fire(...) |
|
1153
|
|
|
|
|
|
|
|
|
1154
|
|
|
|
|
|
|
Alias for C<< $eo->fire_event() >>. |
|
1155
|
|
|
|
|
|
|
|
|
1156
|
|
|
|
|
|
|
=head2 $eo->register_event(...) |
|
1157
|
|
|
|
|
|
|
|
|
1158
|
|
|
|
|
|
|
Alias for C<< $eo->register_callback() >>. |
|
1159
|
|
|
|
|
|
|
|
|
1160
|
|
|
|
|
|
|
=head2 $eo->register_events(...) |
|
1161
|
|
|
|
|
|
|
|
|
1162
|
|
|
|
|
|
|
Alias for C<< $eo->register_callbacks() >>. |
|
1163
|
|
|
|
|
|
|
|
|
1164
|
|
|
|
|
|
|
=head2 $fire->eo |
|
1165
|
|
|
|
|
|
|
|
|
1166
|
|
|
|
|
|
|
Alias for C<< $fire->object >>. |
|
1167
|
|
|
|
|
|
|
|
|
1168
|
|
|
|
|
|
|
=head1 AUTHOR |
|
1169
|
|
|
|
|
|
|
|
|
1170
|
|
|
|
|
|
|
L |
|
1171
|
|
|
|
|
|
|
|
|
1172
|
|
|
|
|
|
|
Copyright E 2011-2020. Released under New BSD license. |
|
1173
|
|
|
|
|
|
|
|
|
1174
|
|
|
|
|
|
|
Comments, complaints, and recommendations are accepted. Bugs may be reported on |
|
1175
|
|
|
|
|
|
|
L. |