line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Reflex::Role::Reactive; |
2
|
|
|
|
|
|
|
# vim: ts=2 sw=2 noexpandtab |
3
|
|
|
|
|
|
|
$Reflex::Role::Reactive::VERSION = '0.100'; |
4
|
8
|
|
|
8
|
|
7951
|
use Moose::Role; |
|
8
|
|
|
|
|
24987
|
|
|
8
|
|
|
|
|
40
|
|
5
|
|
|
|
|
|
|
|
6
|
8
|
|
|
8
|
|
28691
|
use Scalar::Util qw(weaken blessed); |
|
8
|
|
|
|
|
11
|
|
|
8
|
|
|
|
|
464
|
|
7
|
8
|
|
|
8
|
|
31
|
use Carp qw(carp croak); |
|
8
|
|
|
|
|
13
|
|
|
8
|
|
|
|
|
319
|
|
8
|
8
|
|
|
8
|
|
3033
|
use Reflex; |
|
8
|
|
|
|
|
14
|
|
|
8
|
|
|
|
|
55
|
|
9
|
8
|
|
|
8
|
|
401
|
use Reflex::Callback::Promise; |
|
8
|
|
|
|
|
11
|
|
|
8
|
|
|
|
|
85
|
|
10
|
8
|
|
|
8
|
|
7489
|
use Reflex::Callback::CodeRef; |
|
8
|
|
|
|
|
13
|
|
|
8
|
|
|
|
|
460
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
8
|
|
|
END { |
13
|
|
|
|
|
|
|
#warn join "; ", keys %watchers; |
14
|
|
|
|
|
|
|
#warn join "; ", keys %watchings; |
15
|
|
|
|
|
|
|
} |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
our @CARP_NOT = (__PACKAGE__); |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
# Singleton POE::Session. |
20
|
|
|
|
|
|
|
# TODO - Extract the POE bits into another role if we want to support |
21
|
|
|
|
|
|
|
# other event loops at the top level rather than beneath POE. |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
# TODO - How to prevent these from being redefined? |
24
|
|
|
|
|
|
|
# TODO - Such as if POE is loaded elsewhere first? |
25
|
|
|
|
|
|
|
# |
26
|
|
|
|
|
|
|
#sub POE::Kernel::ASSERT_DEFAULT () { 1 } |
27
|
|
|
|
|
|
|
#sub POE::Kernel::CATCH_EXCEPTIONS () { 0 } |
28
|
|
|
|
|
|
|
#sub POE::Kernel::USE_SIGCHLD () { 1 } |
29
|
|
|
|
|
|
|
|
30
|
8
|
|
|
8
|
|
3374
|
use POE; |
|
8
|
|
|
|
|
220106
|
|
|
8
|
|
|
|
|
50
|
|
31
|
8
|
|
|
8
|
|
340559
|
use Reflex::POE::Session; |
|
8
|
|
|
|
|
25
|
|
|
8
|
|
|
|
|
17767
|
|
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
# Disable a warning. |
34
|
|
|
|
|
|
|
POE::Kernel->run(); |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
my %session_object_count; |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
my $singleton_session_id; |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
sub _create_singleton_session { |
41
|
|
|
|
|
|
|
$singleton_session_id = POE::Session->create( |
42
|
|
|
|
|
|
|
inline_states => { |
43
|
|
|
|
|
|
|
# Make the session conveniently accessible. |
44
|
|
|
|
|
|
|
# Although we're using the $singleton_session_id, so why bother? |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
_start => sub { |
47
|
|
|
|
|
|
|
# No-op to satisfy assertions. |
48
|
9
|
|
|
9
|
|
6185
|
$_[KERNEL]->alias_set("alias_" . $_[SESSION]->ID); |
49
|
9
|
|
|
|
|
343
|
undef; |
50
|
|
|
|
|
|
|
}, |
51
|
|
|
|
|
|
|
_stop => sub { |
52
|
|
|
|
|
|
|
# Session has become defunct. |
53
|
8
|
|
|
8
|
|
3466
|
$singleton_session_id = undef; |
54
|
8
|
|
|
|
|
23
|
undef; |
55
|
|
|
|
|
|
|
}, |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
### Timer manipulators and callbacks. |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
timer_due => sub { |
60
|
20
|
|
|
20
|
|
2436366
|
my $envelope = $_[ARG0]; |
61
|
20
|
|
|
|
|
83
|
my ($cb_object, $cb_method, $event_class) = @$envelope; |
62
|
20
|
|
|
|
|
1826
|
$cb_object->$cb_method( |
63
|
|
|
|
|
|
|
$event_class->new(_emitters => [ $cb_object ]) |
64
|
|
|
|
|
|
|
); |
65
|
|
|
|
|
|
|
}, |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
### I/O manipulators and callbacks. |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
select_ready => sub { |
70
|
0
|
|
|
0
|
|
0
|
my ($handle, $envelope, $mode) = @_[ARG0, ARG2]; |
71
|
0
|
|
|
|
|
0
|
my ($cb_object, $cb_method, $event_class) = @$envelope; |
72
|
0
|
|
|
|
|
0
|
$cb_object->$cb_method( |
73
|
|
|
|
|
|
|
$event_class->new( |
74
|
|
|
|
|
|
|
_emitters => [ $cb_object ], |
75
|
|
|
|
|
|
|
handle => $handle, |
76
|
|
|
|
|
|
|
) |
77
|
|
|
|
|
|
|
); |
78
|
|
|
|
|
|
|
}, |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
### Signals. |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
signal_happened => sub { |
83
|
2
|
|
|
2
|
|
316
|
my $signal_class = pop @_; |
84
|
2
|
|
|
|
|
26
|
$signal_class->deliver(@_[ARG0..$#_]); |
85
|
2
|
|
|
|
|
12
|
$_[KERNEL]->sig_handled(); |
86
|
|
|
|
|
|
|
}, |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
### Cross-session emit() is converted into these events. |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
deliver_callback => sub { |
91
|
10
|
|
|
10
|
|
736
|
my ($callback, $event, $args) = @_[ARG0, ARG1, ARG2]; |
92
|
10
|
|
|
|
|
30
|
$callback->deliver($event, $args); |
93
|
|
|
|
|
|
|
}, |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
# call_gate() uses this to call methods in the right session. |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
call_gate_method => sub { |
98
|
11
|
|
|
11
|
|
630
|
my ($object, $method, @args) = @_[ARG0..$#_]; |
99
|
11
|
|
|
|
|
69
|
return $object->$method(@args); |
100
|
|
|
|
|
|
|
}, |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
call_gate_coderef => sub { |
103
|
0
|
|
|
0
|
|
0
|
my ($coderef, @args) = @_[ARG0..$#_]; |
104
|
0
|
|
|
|
|
0
|
return $coderef->(@args); |
105
|
|
|
|
|
|
|
}, |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
# Catch dynamic events. |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
_default => sub { |
110
|
0
|
|
|
0
|
|
0
|
my ($event, $args) = @_[ARG0, ARG1]; |
111
|
|
|
|
|
|
|
|
112
|
0
|
0
|
|
|
|
0
|
return $event->deliver($args) if ( |
113
|
|
|
|
|
|
|
"$event" =~ /^Reflex::POE::Event(?:::|=)/ |
114
|
|
|
|
|
|
|
); |
115
|
|
|
|
|
|
|
|
116
|
0
|
0
|
|
|
|
0
|
return if Reflex::POE::Session->deliver($_[SENDER]->ID, $event, $args); |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
# Unhandled event. |
119
|
|
|
|
|
|
|
# TODO - Should anything special be done in this case? |
120
|
|
|
|
|
|
|
}, |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
### Support POE::Wheel classes. |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
# Deliver to wheels based on the wheel ID. Different wheels pass |
125
|
|
|
|
|
|
|
# their IDs in different ARGn offsets, so we need a few of these. |
126
|
|
|
|
|
|
|
wheel_event_0 => sub { |
127
|
0
|
|
|
0
|
|
0
|
$_[CALLER_FILE] =~ m{/([^/.]+)\.pm}; |
128
|
0
|
|
|
|
|
0
|
"Reflex::POE::Wheel:\:$1"->deliver(0, @_[ARG0..$#_]); |
129
|
|
|
|
|
|
|
}, |
130
|
|
|
|
|
|
|
wheel_event_1 => sub { |
131
|
11
|
|
|
11
|
|
1130
|
$_[CALLER_FILE] =~ m{/([^/.]+)\.pm}; |
132
|
11
|
|
|
|
|
73
|
"Reflex::POE::Wheel:\:$1"->deliver(1, @_[ARG0..$#_]); |
133
|
|
|
|
|
|
|
}, |
134
|
|
|
|
|
|
|
wheel_event_2 => sub { |
135
|
0
|
|
|
0
|
|
0
|
$_[CALLER_FILE] =~ m{/([^/.]+)\.pm}; |
136
|
0
|
|
|
|
|
0
|
"Reflex::POE::Wheel:\:$1"->deliver(2, @_[ARG0..$#_]); |
137
|
|
|
|
|
|
|
}, |
138
|
|
|
|
|
|
|
wheel_event_3 => sub { |
139
|
4
|
|
|
4
|
|
1727
|
$_[CALLER_FILE] =~ m{/([^/.]+)\.pm}; |
140
|
4
|
|
|
|
|
30
|
"Reflex::POE::Wheel:\:$1"->deliver(3, @_[ARG0..$#_]); |
141
|
|
|
|
|
|
|
}, |
142
|
|
|
|
|
|
|
wheel_event_4 => sub { |
143
|
2
|
|
|
2
|
|
88
|
$_[CALLER_FILE] =~ m{/([^/.]+)\.pm}; |
144
|
2
|
|
|
|
|
18
|
"Reflex::POE::Wheel:\:$1"->deliver(4, @_[ARG0..$#_]); |
145
|
|
|
|
|
|
|
}, |
146
|
|
|
|
|
|
|
}, |
147
|
9
|
|
|
9
|
|
484
|
)->ID(); |
148
|
|
|
|
|
|
|
} |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
sub session_id { |
151
|
205
|
100
|
|
205
|
1
|
425
|
_create_singleton_session() unless defined $singleton_session_id; |
152
|
205
|
|
|
|
|
2167
|
$singleton_session_id; |
153
|
|
|
|
|
|
|
} |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
# What's watching me. |
156
|
|
|
|
|
|
|
# watchers()->{$watcher->get_id} = \@callbacks |
157
|
|
|
|
|
|
|
has watchers => ( |
158
|
|
|
|
|
|
|
isa => 'HashRef', |
159
|
|
|
|
|
|
|
is => 'rw', |
160
|
|
|
|
|
|
|
lazy => 1, |
161
|
|
|
|
|
|
|
default => sub { {} }, |
162
|
|
|
|
|
|
|
); |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
# What's watching me. |
165
|
|
|
|
|
|
|
# watchers_by_event()->{$event}->{$watcher->get_id} = \@callbacks |
166
|
|
|
|
|
|
|
has watchers_by_event => ( |
167
|
|
|
|
|
|
|
isa => 'HashRef', |
168
|
|
|
|
|
|
|
is => 'rw', |
169
|
|
|
|
|
|
|
lazy => 1, |
170
|
|
|
|
|
|
|
default => sub { {} }, |
171
|
|
|
|
|
|
|
); |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
# What I'm watching. |
174
|
|
|
|
|
|
|
# watched_objects()->{$watched->get_id}->{$event} = \@interests |
175
|
|
|
|
|
|
|
has watched_object_events => ( |
176
|
|
|
|
|
|
|
isa => 'HashRef', |
177
|
|
|
|
|
|
|
is => 'rw', |
178
|
|
|
|
|
|
|
lazy => 1, |
179
|
|
|
|
|
|
|
default => sub { {} }, |
180
|
|
|
|
|
|
|
); |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
has watched_objects => ( |
183
|
|
|
|
|
|
|
isa => 'HashRef', |
184
|
|
|
|
|
|
|
is => 'rw', |
185
|
|
|
|
|
|
|
lazy => 1, |
186
|
|
|
|
|
|
|
default => sub { {} }, |
187
|
|
|
|
|
|
|
); |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
# TODO - Needs to be class, not object based! |
190
|
|
|
|
|
|
|
#has role => ( |
191
|
|
|
|
|
|
|
# is => 'ro', |
192
|
|
|
|
|
|
|
# isa => 'Str', |
193
|
|
|
|
|
|
|
# default => sub { |
194
|
|
|
|
|
|
|
# my $self = shift; |
195
|
|
|
|
|
|
|
# my $role = ref($self); |
196
|
|
|
|
|
|
|
# $role =~ s/^Reflex:://; |
197
|
|
|
|
|
|
|
# $role =~ tr[a-zA-Z0-9][_]cs; |
198
|
|
|
|
|
|
|
# return lc $role; |
199
|
|
|
|
|
|
|
# }, |
200
|
|
|
|
|
|
|
#); |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
has promise => ( |
203
|
|
|
|
|
|
|
is => 'rw', |
204
|
|
|
|
|
|
|
isa => 'Maybe[Reflex::Callback::Promise]', |
205
|
|
|
|
|
|
|
default => undef, |
206
|
|
|
|
|
|
|
); |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
has emits_seen => ( |
209
|
|
|
|
|
|
|
is => 'rw', |
210
|
|
|
|
|
|
|
isa => 'HashRef[Str]', |
211
|
|
|
|
|
|
|
default => sub { {} }, |
212
|
|
|
|
|
|
|
); |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
my $next_id = 1; |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
has _id => ( |
217
|
|
|
|
|
|
|
isa => 'Int', |
218
|
|
|
|
|
|
|
is => 'ro', |
219
|
|
|
|
|
|
|
default => sub { $next_id++ }, |
220
|
|
|
|
|
|
|
); |
221
|
|
|
|
|
|
|
|
222
|
134
|
|
|
134
|
0
|
2956
|
sub get_id { return shift()->_id() } |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
# Base class. |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
31
|
0
|
|
sub BUILD {} |
227
|
|
|
|
|
|
|
after BUILD => sub { |
228
|
|
|
|
|
|
|
my ($self, $args) = @_; |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
# Set up all emitters and watchers. |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
foreach my $setup ( |
233
|
|
|
|
|
|
|
grep { |
234
|
|
|
|
|
|
|
$_->does('Reflex::Trait::EmitsOnChange') || $_->does('Reflex::Trait::Watched') |
235
|
|
|
|
|
|
|
} |
236
|
|
|
|
|
|
|
$self->meta()->get_all_attributes() |
237
|
|
|
|
|
|
|
) { |
238
|
|
|
|
|
|
|
my $callback = $setup->setup(); |
239
|
|
|
|
|
|
|
next unless defined $callback; |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
# TODO - Better way to detect CodeRef? |
242
|
|
|
|
|
|
|
if (ref($callback) eq "CODE") { |
243
|
|
|
|
|
|
|
my $member = $setup->name(); |
244
|
|
|
|
|
|
|
$self->$member( $callback->($self) ); # TODO - Proper parameters! |
245
|
|
|
|
|
|
|
next; |
246
|
|
|
|
|
|
|
} |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
# TODO - Better way to detect HashRef? |
249
|
|
|
|
|
|
|
if (ref($callback) eq "HASH") { |
250
|
|
|
|
|
|
|
my $member = $setup->name(); |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
my @types = ( |
253
|
|
|
|
|
|
|
grep { $_ ne "Undef" } |
254
|
|
|
|
|
|
|
split /\s*\|\s*/, |
255
|
|
|
|
|
|
|
$setup->type_constraint() |
256
|
|
|
|
|
|
|
); |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
croak "Hashref 'setup' can't determine the class from 'isa'" if ( |
259
|
|
|
|
|
|
|
@types < 1 |
260
|
|
|
|
|
|
|
); |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
croak "Hashref 'setup' can't set up more than one class from 'isa'" if ( |
263
|
|
|
|
|
|
|
@types > 1 |
264
|
|
|
|
|
|
|
); |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
my $type = $types[0]; |
267
|
|
|
|
|
|
|
$self->$member( $type->new($callback) ); |
268
|
|
|
|
|
|
|
next; |
269
|
|
|
|
|
|
|
} |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
croak "Unknown 'setup' value: $callback"; |
272
|
|
|
|
|
|
|
} |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
# Discrete callbacks. |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
CALLBACK: while (my ($param, $value) = each %$args) { |
277
|
|
|
|
|
|
|
next unless $param =~ /^on_(\S+)/; |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
my $event = $1; |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
if (ref($value) eq "CODE") { |
282
|
|
|
|
|
|
|
$value = Reflex::Callback::CodeRef->new( |
283
|
|
|
|
|
|
|
object => $self, |
284
|
|
|
|
|
|
|
code_ref => $value, |
285
|
|
|
|
|
|
|
); |
286
|
|
|
|
|
|
|
} |
287
|
|
|
|
|
|
|
elsif (ref($value) eq "ARRAY") { |
288
|
|
|
|
|
|
|
$value = Reflex::Callback::Method->new( |
289
|
|
|
|
|
|
|
object => $value->[0], |
290
|
|
|
|
|
|
|
method_name => $value->[1], |
291
|
|
|
|
|
|
|
); |
292
|
|
|
|
|
|
|
} |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
# There is an object, so we have a watcher. |
295
|
|
|
|
|
|
|
if ($value->object()) { |
296
|
|
|
|
|
|
|
$value->object()->watch($self, $event => $value); |
297
|
|
|
|
|
|
|
next CALLBACK; |
298
|
|
|
|
|
|
|
} |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
# TODO - Who is the watcher? |
301
|
|
|
|
|
|
|
# TODO - Optimization! watch() takes multiple event/callback |
302
|
|
|
|
|
|
|
# pairs. We can combine them into a hash and call watch() once. |
303
|
|
|
|
|
|
|
$self->watch($self, $event => $value); |
304
|
|
|
|
|
|
|
next CALLBACK; |
305
|
|
|
|
|
|
|
} |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
# The session has an object. |
308
|
|
|
|
|
|
|
$session_object_count{$self->session_id()}++; |
309
|
|
|
|
|
|
|
}; |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
# TODO - Does Moose have sugar for passing named parameters? |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
# Self is watching something. Register the interest with self. |
314
|
|
|
|
|
|
|
sub watch { |
315
|
35
|
|
|
35
|
1
|
79
|
my ($self, $watched, %callbacks) = @_; |
316
|
|
|
|
|
|
|
|
317
|
35
|
|
|
|
|
71
|
my $watched_id = $watched->get_id(); |
318
|
|
|
|
|
|
|
|
319
|
35
|
|
|
|
|
141
|
while (my ($event, $callback) = each %callbacks) { |
320
|
35
|
|
|
|
|
66
|
$event =~ s/^on_//; |
321
|
|
|
|
|
|
|
|
322
|
35
|
50
|
|
|
|
98
|
if (ref $callback) { |
323
|
35
|
50
|
|
|
|
94
|
if (blessed($callback)) { |
|
|
0
|
|
|
|
|
|
324
|
35
|
50
|
|
|
|
164
|
unless ($callback->isa('Reflex::Callback')) { |
325
|
0
|
|
|
|
|
0
|
croak "Can't use $callback as a callback"; |
326
|
|
|
|
|
|
|
} |
327
|
|
|
|
|
|
|
} |
328
|
|
|
|
|
|
|
elsif (ref($callback) eq "CODE") { |
329
|
|
|
|
|
|
|
# Coerce sub{} into Reflex::Callback. |
330
|
0
|
|
|
|
|
0
|
$callback = Reflex::Callback::CodeRef->new( |
331
|
|
|
|
|
|
|
object => $self, |
332
|
|
|
|
|
|
|
code_ref => $callback, |
333
|
|
|
|
|
|
|
); |
334
|
|
|
|
|
|
|
} |
335
|
|
|
|
|
|
|
else { |
336
|
0
|
|
|
|
|
0
|
croak "Can't use $callback as a callback." |
337
|
|
|
|
|
|
|
} |
338
|
|
|
|
|
|
|
} |
339
|
|
|
|
|
|
|
else { |
340
|
|
|
|
|
|
|
# Coerce method name into a callback. |
341
|
0
|
|
|
|
|
0
|
$callback = Reflex::Callback::Method->new( |
342
|
|
|
|
|
|
|
object => $self, |
343
|
|
|
|
|
|
|
method_name => $callback, |
344
|
|
|
|
|
|
|
); |
345
|
|
|
|
|
|
|
} |
346
|
|
|
|
|
|
|
|
347
|
35
|
|
|
|
|
108
|
my $interest = { |
348
|
|
|
|
|
|
|
callback => $callback, |
349
|
|
|
|
|
|
|
event => $event, |
350
|
|
|
|
|
|
|
watched => $watched, |
351
|
|
|
|
|
|
|
}; |
352
|
|
|
|
|
|
|
|
353
|
35
|
|
|
|
|
84
|
weaken $interest->{watched}; |
354
|
35
|
100
|
|
|
|
814
|
unless (exists $self->watched_objects()->{$watched_id}) { |
355
|
24
|
|
|
|
|
591
|
$self->watched_objects()->{$watched_id} = $watched; |
356
|
24
|
|
|
|
|
517
|
weaken $self->watched_objects()->{$watched_id}; |
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
# Keep this object's session alive. |
359
|
|
|
|
|
|
|
#$POE::Kernel::poe_kernel->refcount_increment($self->session_id, "in_use"); |
360
|
|
|
|
|
|
|
} |
361
|
|
|
|
|
|
|
|
362
|
35
|
|
|
|
|
37
|
push @{$self->watched_object_events()->{$watched_id}->{$event}}, $interest; |
|
35
|
|
|
|
|
821
|
|
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
# Tell what I'm watching that it's being watched. |
365
|
|
|
|
|
|
|
|
366
|
35
|
|
|
|
|
134
|
$watched->_is_watched($self, $event, $callback); |
367
|
|
|
|
|
|
|
} |
368
|
|
|
|
|
|
|
|
369
|
35
|
|
|
|
|
79
|
undef; |
370
|
|
|
|
|
|
|
} |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
# Self is no longer being watched. Remove interest from self. |
373
|
|
|
|
|
|
|
sub _stop_watchers { |
374
|
32
|
|
|
32
|
|
42
|
my ($self, $watcher, $events) = @_; |
375
|
|
|
|
|
|
|
|
376
|
32
|
|
|
|
|
67
|
my $watcher_id = $watcher->get_id(); |
377
|
32
|
50
|
|
|
|
41
|
my @events = @{$events || []}; |
|
32
|
|
|
|
|
164
|
|
378
|
|
|
|
|
|
|
|
379
|
32
|
50
|
|
|
|
67
|
unless (@events) { |
380
|
|
|
|
|
|
|
my %events = ( |
381
|
36
|
|
|
|
|
101
|
map { $_->{event} => $_->{event} } |
382
|
25
|
|
|
|
|
57
|
map { @$_ } |
383
|
32
|
|
|
|
|
40
|
values %{$self->watchers()} |
|
32
|
|
|
|
|
724
|
|
384
|
|
|
|
|
|
|
); |
385
|
32
|
|
|
|
|
85
|
@events = keys %events; |
386
|
|
|
|
|
|
|
} |
387
|
|
|
|
|
|
|
|
388
|
32
|
|
|
|
|
57
|
foreach my $event (@events) { |
389
|
35
|
|
|
|
|
864
|
delete $self->watchers_by_event()->{$event}->{$watcher_id}; |
390
|
|
|
|
|
|
|
delete $self->watchers_by_event()->{$event} unless ( |
391
|
35
|
50
|
|
|
|
35
|
scalar keys %{$self->watchers_by_event()->{$event}} |
|
35
|
|
|
|
|
828
|
|
392
|
|
|
|
|
|
|
); |
393
|
35
|
|
|
|
|
51
|
pop @{$self->watchers()->{$watcher_id}}; |
|
35
|
|
|
|
|
820
|
|
394
|
|
|
|
|
|
|
} |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
delete $self->watchers()->{$watcher_id} unless ( |
397
|
|
|
|
|
|
|
exists $self->watchers()->{$watcher_id} and |
398
|
32
|
100
|
100
|
|
|
729
|
@{$self->watchers()->{$watcher_id}} |
|
25
|
|
|
|
|
570
|
|
399
|
|
|
|
|
|
|
); |
400
|
|
|
|
|
|
|
} |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
sub _is_watched { |
403
|
35
|
|
|
35
|
|
52
|
my ($self, $watcher, $event, $callback) = @_; |
404
|
|
|
|
|
|
|
|
405
|
35
|
|
|
|
|
84
|
my $interest = { |
406
|
|
|
|
|
|
|
callback => $callback, |
407
|
|
|
|
|
|
|
event => $event, |
408
|
|
|
|
|
|
|
watcher => $watcher , |
409
|
|
|
|
|
|
|
}; |
410
|
35
|
|
|
|
|
76
|
weaken $interest->{watcher}; |
411
|
|
|
|
|
|
|
|
412
|
35
|
|
|
|
|
64
|
my $watcher_id = $watcher->get_id(); |
413
|
|
|
|
|
|
|
|
414
|
35
|
|
|
|
|
39
|
push @{$self->watchers_by_event()->{$event}->{$watcher_id}}, $interest; |
|
35
|
|
|
|
|
801
|
|
415
|
35
|
|
|
|
|
27
|
push @{$self->watchers()->{$watcher_id}}, $interest; |
|
35
|
|
|
|
|
724
|
|
416
|
|
|
|
|
|
|
} |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
my %loaded_event_types; |
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
sub re_emit { |
421
|
34
|
|
|
34
|
0
|
159
|
my ($self, $event, %override_args) = @_; |
422
|
|
|
|
|
|
|
|
423
|
34
|
|
|
|
|
882
|
my $new_event = $event->_clone(%override_args); |
424
|
34
|
|
|
|
|
177
|
$new_event->push_emitter($self); |
425
|
|
|
|
|
|
|
|
426
|
34
|
|
|
|
|
142
|
$self->_emit_event($new_event); |
427
|
|
|
|
|
|
|
} |
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
sub emit { |
430
|
37
|
|
|
37
|
1
|
180
|
my ($self, %args) = @_; |
431
|
|
|
|
|
|
|
|
432
|
37
|
|
|
|
|
80
|
my $event_type = delete $args{-type}; |
433
|
37
|
100
|
66
|
|
|
158
|
$event_type = 'Reflex::Event' unless ( |
434
|
|
|
|
|
|
|
defined $event_type and length $event_type |
435
|
|
|
|
|
|
|
); |
436
|
|
|
|
|
|
|
|
437
|
37
|
|
|
|
|
60
|
my $event_name = delete $args{-name}; |
438
|
37
|
50
|
33
|
|
|
144
|
$event_name = "generic" unless ( |
439
|
|
|
|
|
|
|
defined $event_name and length $event_name |
440
|
|
|
|
|
|
|
); |
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
# TODO - Needs consideration: |
443
|
|
|
|
|
|
|
# TODO - Underscores for Reflex parameters? |
444
|
|
|
|
|
|
|
# TODO - Must be a hash reference. Would be nice if non-hashref |
445
|
|
|
|
|
|
|
# errors were pushed to the caller. |
446
|
|
|
|
|
|
|
|
447
|
37
|
|
|
|
|
1178
|
my $event = $event_type->new( |
448
|
|
|
|
|
|
|
_name => $event_name, |
449
|
|
|
|
|
|
|
_emitters => [ $self ], |
450
|
|
|
|
|
|
|
%args |
451
|
|
|
|
|
|
|
); |
452
|
|
|
|
|
|
|
|
453
|
37
|
|
|
|
|
120
|
$self->_emit_event($event); |
454
|
|
|
|
|
|
|
} |
455
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
sub _emit_event { |
457
|
71
|
|
|
71
|
|
82
|
my ($self, $event) = @_; |
458
|
|
|
|
|
|
|
|
459
|
71
|
|
|
|
|
1802
|
my $event_name = $event->_name(); |
460
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
# Look for self-handling of the event. |
462
|
|
|
|
|
|
|
# TODO - can() calls are also candidates for caching. |
463
|
|
|
|
|
|
|
# (AKA: Cache as cache can()?) |
464
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
# TODO - Using the class name here is weak. |
466
|
|
|
|
|
|
|
# It would be sweetest if we could find a better role name. |
467
|
|
|
|
|
|
|
|
468
|
71
|
|
|
|
|
171
|
my $caller_role = caller(1); # ref($self); # TODO - Need something better! |
469
|
71
|
|
|
|
|
244
|
$caller_role =~ s/^Reflex::(?:Role::)?//; |
470
|
71
|
|
|
|
|
155
|
$caller_role =~ tr[a-zA-Z0-9][_]cs; |
471
|
|
|
|
|
|
|
|
472
|
71
|
|
|
|
|
211
|
my $self_method = "on_" . lc($caller_role) . "_" . $event_name; |
473
|
|
|
|
|
|
|
#warn $self_method; |
474
|
71
|
50
|
|
|
|
403
|
if ($self->can($self_method)) { |
475
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
# Already seen this; we're recursing! Break it up! |
477
|
0
|
0
|
|
|
|
0
|
if ($self->emits_seen()->{"$self -> $self_method"}) { |
478
|
0
|
|
|
|
|
0
|
$self->emits_seen({}); |
479
|
0
|
|
|
|
|
0
|
$poe_kernel->post( |
480
|
|
|
|
|
|
|
$self->session_id(), 'call_gate_method', |
481
|
|
|
|
|
|
|
$self, $self_method, $event, |
482
|
|
|
|
|
|
|
); |
483
|
0
|
|
|
|
|
0
|
return; |
484
|
|
|
|
|
|
|
} |
485
|
|
|
|
|
|
|
|
486
|
|
|
|
|
|
|
# Not recursing yet. Give it a try! |
487
|
0
|
|
|
|
|
0
|
$self->emits_seen()->{"$self -> $self_method"} = 1; |
488
|
0
|
|
|
|
|
0
|
$self->$self_method($event); |
489
|
0
|
|
|
|
|
0
|
return; |
490
|
|
|
|
|
|
|
} |
491
|
|
|
|
|
|
|
|
492
|
|
|
|
|
|
|
# This event isn't watched. |
493
|
|
|
|
|
|
|
|
494
|
71
|
|
|
|
|
81
|
my $deliver_event = $event_name; |
495
|
|
|
|
|
|
|
|
496
|
|
|
|
|
|
|
#warn $deliver_event; |
497
|
71
|
100
|
|
|
|
1844
|
unless (exists $self->watchers_by_event()->{$deliver_event}) { |
498
|
4
|
50
|
|
|
|
144
|
if ($self->promise()) { |
499
|
0
|
|
|
|
|
0
|
$self->promise()->deliver($event); |
500
|
0
|
|
|
|
|
0
|
return; |
501
|
|
|
|
|
|
|
} |
502
|
|
|
|
|
|
|
|
503
|
|
|
|
|
|
|
# TODO - At this point, do we walk up the ownership tree looking |
504
|
|
|
|
|
|
|
# for a promise? That would allow events to bubble out of objects. |
505
|
|
|
|
|
|
|
|
506
|
4
|
|
|
|
|
10
|
$deliver_event = "promise"; |
507
|
|
|
|
|
|
|
#warn $event unless exists $self->watchers_by_event()->{$deliver_event}; |
508
|
4
|
50
|
|
|
|
99
|
return unless exists $self->watchers_by_event()->{$deliver_event}; |
509
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
# Fall through if the promise exists. |
511
|
|
|
|
|
|
|
} |
512
|
|
|
|
|
|
|
|
513
|
|
|
|
|
|
|
# This event is watched. Broadcast it to watchers. |
514
|
|
|
|
|
|
|
# TODO - Accessor calls are expensive. Optimize them away. |
515
|
|
|
|
|
|
|
|
516
|
67
|
|
|
|
|
91
|
while ( |
517
|
|
|
|
|
|
|
my ($watcher, $callbacks) = each %{ |
518
|
134
|
|
|
|
|
4157
|
$self->watchers_by_event()->{$deliver_event} |
519
|
|
|
|
|
|
|
} |
520
|
|
|
|
|
|
|
) { |
521
|
67
|
|
|
|
|
129
|
CALLBACK: foreach my $callback_rec (@$callbacks) { |
522
|
70
|
|
|
|
|
109
|
my $callback = $callback_rec->{callback}; |
523
|
|
|
|
|
|
|
|
524
|
|
|
|
|
|
|
# Same session. Just deliver it. |
525
|
|
|
|
|
|
|
# TODO - Break recursive callbacks? |
526
|
70
|
100
|
|
|
|
221
|
if ( |
527
|
|
|
|
|
|
|
$callback_rec->{watcher}->session_id() eq |
528
|
|
|
|
|
|
|
$POE::Kernel::poe_kernel->get_active_session()->ID |
529
|
|
|
|
|
|
|
) { |
530
|
60
|
|
|
|
|
525
|
$callback->deliver($event); |
531
|
60
|
|
|
|
|
8023
|
next CALLBACK; |
532
|
|
|
|
|
|
|
} |
533
|
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
# Different session. Post it through. |
535
|
|
|
|
|
|
|
$poe_kernel->post( |
536
|
|
|
|
|
|
|
$callback_rec->{watcher}->session_id(), 'deliver_callback', |
537
|
|
|
|
|
|
|
$callback, $event, |
538
|
10
|
|
|
|
|
41
|
$callback_rec->{watcher}, $self, # keep objects alive a bit |
539
|
|
|
|
|
|
|
); |
540
|
|
|
|
|
|
|
} |
541
|
|
|
|
|
|
|
} |
542
|
|
|
|
|
|
|
} |
543
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
sub deliver { |
545
|
0
|
|
|
0
|
0
|
0
|
die "@_"; |
546
|
|
|
|
|
|
|
} |
547
|
|
|
|
|
|
|
|
548
|
|
|
|
|
|
|
# An object is demolished. |
549
|
|
|
|
|
|
|
# The filehash should destroy everything it watches. |
550
|
|
|
|
|
|
|
# All interests of this object must be manually demolished. |
551
|
|
|
|
|
|
|
|
552
|
|
|
|
|
|
|
sub _shutdown { |
553
|
37
|
|
|
37
|
|
42
|
my $self = shift; |
554
|
|
|
|
|
|
|
|
555
|
|
|
|
|
|
|
# Anything that was watching us, no longer is. |
556
|
|
|
|
|
|
|
|
557
|
|
|
|
|
|
|
my %watchers = ( |
558
|
20
|
|
|
|
|
70
|
map { $_->{watcher} => $_->{watcher} } |
559
|
9
|
|
|
|
|
36
|
map { @$_ } |
560
|
37
|
|
|
|
|
41
|
values %{$self->watchers()} |
|
37
|
|
|
|
|
1009
|
|
561
|
|
|
|
|
|
|
); |
562
|
|
|
|
|
|
|
|
563
|
37
|
|
|
|
|
86
|
foreach my $watcher (values %watchers) { |
564
|
9
|
|
|
|
|
45
|
$watcher->ignore($self); |
565
|
|
|
|
|
|
|
} |
566
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
# Anything we were watching, no longer is being. |
568
|
|
|
|
|
|
|
|
569
|
37
|
|
|
|
|
41
|
foreach my $watched (values %{$self->watched_objects()}) { |
|
37
|
|
|
|
|
925
|
|
570
|
5
|
|
|
|
|
12
|
$self->ignore($watched); |
571
|
|
|
|
|
|
|
} |
572
|
|
|
|
|
|
|
} |
573
|
|
|
|
|
|
|
|
574
|
|
|
|
|
|
|
sub DEMOLISH { |
575
|
37
|
|
|
37
|
0
|
2208
|
my $self = shift; |
576
|
37
|
|
|
|
|
152
|
$self->_shutdown(); |
577
|
|
|
|
|
|
|
} |
578
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
sub ignore { |
580
|
32
|
|
|
32
|
1
|
445
|
my ($self, $watched, @events) = @_; |
581
|
|
|
|
|
|
|
|
582
|
32
|
50
|
|
|
|
68
|
croak "ignore requires at least an object" unless defined $watched; |
583
|
|
|
|
|
|
|
|
584
|
32
|
|
|
|
|
81
|
my $watched_id = $watched->get_id(); |
585
|
|
|
|
|
|
|
|
586
|
32
|
50
|
|
|
|
76
|
if (@events) { |
587
|
0
|
|
|
|
|
0
|
delete @{$self->watched_object_events()->{$watched_id}}{@events}; |
|
0
|
|
|
|
|
0
|
|
588
|
0
|
0
|
|
|
|
0
|
unless (scalar keys %{$self->watched_object_events()->{$watched_id}}) { |
|
0
|
|
|
|
|
0
|
|
589
|
0
|
|
|
|
|
0
|
delete $self->watched_object_events()->{$watched_id}; |
590
|
0
|
|
|
|
|
0
|
delete $self->watched_objects()->{$watched_id}; |
591
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
# Decrement the session's use count. |
593
|
|
|
|
|
|
|
#$POE::Kernel::poe_kernel->refcount_decrement($self->session_id, "in_use"); |
594
|
|
|
|
|
|
|
} |
595
|
0
|
|
|
|
|
0
|
$watched->_stop_watchers($self, \@events); |
596
|
|
|
|
|
|
|
} |
597
|
|
|
|
|
|
|
else { |
598
|
8
|
50
|
|
8
|
|
67
|
use Carp qw(cluck); cluck "whaaaa" unless defined $watched; |
|
8
|
|
|
|
|
9
|
|
|
8
|
|
|
|
|
3622
|
|
|
32
|
|
|
|
|
69
|
|
599
|
32
|
|
|
|
|
863
|
delete $self->watched_object_events()->{$watched_id}; |
600
|
32
|
|
|
|
|
759
|
delete $self->watched_objects()->{$watched_id}; |
601
|
32
|
|
|
|
|
136
|
$watched->_stop_watchers($self); |
602
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
# Decrement the session's use count. |
604
|
|
|
|
|
|
|
#$POE::Kernel::poe_kernel->refcount_decrement($self->session_id, "in_use"); |
605
|
|
|
|
|
|
|
} |
606
|
|
|
|
|
|
|
} |
607
|
|
|
|
|
|
|
|
608
|
|
|
|
|
|
|
# http://en.wikipedia.org/wiki/Call_gate |
609
|
|
|
|
|
|
|
|
610
|
|
|
|
|
|
|
sub call_gate { |
611
|
71
|
|
|
71
|
1
|
109
|
my ($self, $method) = @_; |
612
|
|
|
|
|
|
|
|
613
|
|
|
|
|
|
|
# POE::Kernel has already gone away. |
614
|
71
|
50
|
|
|
|
144
|
return 0 unless $POE::Kernel::poe_kernel; |
615
|
|
|
|
|
|
|
|
616
|
71
|
100
|
|
|
|
136
|
return 1 if ( |
617
|
|
|
|
|
|
|
$self->session_id() eq $POE::Kernel::poe_kernel->get_active_session()->ID() |
618
|
|
|
|
|
|
|
); |
619
|
|
|
|
|
|
|
|
620
|
11
|
|
|
|
|
94
|
$POE::Kernel::poe_kernel->call( |
621
|
|
|
|
|
|
|
$self->session_id(), "call_gate_method", $self, $method, @_[2..$#_] |
622
|
|
|
|
|
|
|
); |
623
|
|
|
|
|
|
|
|
624
|
11
|
|
|
|
|
737
|
return 0; |
625
|
|
|
|
|
|
|
} |
626
|
|
|
|
|
|
|
|
627
|
|
|
|
|
|
|
sub run_within_session { |
628
|
0
|
|
|
0
|
1
|
0
|
my ($self, $method) = @_; |
629
|
|
|
|
|
|
|
|
630
|
0
|
0
|
|
|
|
0
|
if ( |
631
|
|
|
|
|
|
|
$self->session_id() eq $POE::Kernel::poe_kernel->get_active_session()->ID() |
632
|
|
|
|
|
|
|
) { |
633
|
0
|
0
|
|
|
|
0
|
if (ref($method) =~ /^CODE/) { |
634
|
0
|
|
|
|
|
0
|
return $method->(@_[2..$#_]); |
635
|
|
|
|
|
|
|
} |
636
|
0
|
|
|
|
|
0
|
return $self->$method(@_[2..$#_]); |
637
|
|
|
|
|
|
|
} |
638
|
|
|
|
|
|
|
|
639
|
0
|
0
|
|
|
|
0
|
if (ref($method) =~ /^CODE/) { |
640
|
0
|
|
|
|
|
0
|
return $POE::Kernel::poe_kernel->call( |
641
|
|
|
|
|
|
|
$self->session_id(), "call_gate_coderef", $method, @_[2..$#_] |
642
|
|
|
|
|
|
|
); |
643
|
|
|
|
|
|
|
} |
644
|
|
|
|
|
|
|
|
645
|
0
|
|
|
|
|
0
|
return $POE::Kernel::poe_kernel->call( |
646
|
|
|
|
|
|
|
$self->session_id(), "call_gate_method", $self, $method, @_[2..$#_] |
647
|
|
|
|
|
|
|
); |
648
|
|
|
|
|
|
|
} |
649
|
|
|
|
|
|
|
|
650
|
|
|
|
|
|
|
sub run_all { |
651
|
9
|
|
|
9
|
1
|
80
|
POE::Kernel->run(); |
652
|
9
|
|
|
|
|
7197
|
$singleton_session_id = undef; |
653
|
|
|
|
|
|
|
} |
654
|
|
|
|
|
|
|
|
655
|
|
|
|
|
|
|
# TODO - Added semantics to wait for a specific event. |
656
|
|
|
|
|
|
|
# Need to document that. |
657
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
sub next { |
659
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
660
|
0
|
0
|
|
|
|
|
$self->promise() || $self->promise(Reflex::Callback::Promise->new()); |
661
|
|
|
|
|
|
|
|
662
|
0
|
0
|
|
|
|
|
return $self->promise()->next() unless @_; |
663
|
|
|
|
|
|
|
|
664
|
|
|
|
|
|
|
# TODO - It's user friendly to accept a list and build a hash |
665
|
|
|
|
|
|
|
# internally, but that adds runtime CPU overhead. On the other |
666
|
|
|
|
|
|
|
# hand, passing in a hashref with dummy values kind of sucks for the |
667
|
|
|
|
|
|
|
# user. I'd like to discuss the relative merits and costs of each |
668
|
|
|
|
|
|
|
# option with someone. |
669
|
|
|
|
|
|
|
|
670
|
0
|
|
|
|
|
|
my %which = map { $_ => 1 } @_; |
|
0
|
|
|
|
|
|
|
671
|
0
|
|
|
|
|
|
while (my $next = $self->promise()->next()) { |
672
|
0
|
0
|
|
|
|
|
return $next if exists $which{$next->{name}}; |
673
|
|
|
|
|
|
|
} |
674
|
|
|
|
|
|
|
} |
675
|
|
|
|
|
|
|
|
676
|
|
|
|
|
|
|
1; |
677
|
|
|
|
|
|
|
|
678
|
|
|
|
|
|
|
__END__ |
679
|
|
|
|
|
|
|
|
680
|
|
|
|
|
|
|
=pod |
681
|
|
|
|
|
|
|
|
682
|
|
|
|
|
|
|
=encoding UTF-8 |
683
|
|
|
|
|
|
|
|
684
|
|
|
|
|
|
|
=for :stopwords Rocco Caputo |
685
|
|
|
|
|
|
|
|
686
|
|
|
|
|
|
|
=head1 NAME |
687
|
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
Reflex::Role::Reactive - Make an object reactive (aka, event driven). |
689
|
|
|
|
|
|
|
|
690
|
|
|
|
|
|
|
=head1 VERSION |
691
|
|
|
|
|
|
|
|
692
|
|
|
|
|
|
|
This document describes version 0.100, released on April 02, 2017. |
693
|
|
|
|
|
|
|
|
694
|
|
|
|
|
|
|
=head1 SYNOPSIS |
695
|
|
|
|
|
|
|
|
696
|
|
|
|
|
|
|
With Moose: |
697
|
|
|
|
|
|
|
|
698
|
|
|
|
|
|
|
package Object; |
699
|
|
|
|
|
|
|
use Moose; |
700
|
|
|
|
|
|
|
with 'Reflex::Role::Reactive'; |
701
|
|
|
|
|
|
|
|
702
|
|
|
|
|
|
|
...; |
703
|
|
|
|
|
|
|
|
704
|
|
|
|
|
|
|
1; |
705
|
|
|
|
|
|
|
|
706
|
|
|
|
|
|
|
Without Moose: |
707
|
|
|
|
|
|
|
|
708
|
|
|
|
|
|
|
# Sorry, roles are defined and composed using Moose. |
709
|
|
|
|
|
|
|
# However, Reflex::Base may be used the old fashioned way. |
710
|
|
|
|
|
|
|
|
711
|
|
|
|
|
|
|
=head1 DESCRIPTION |
712
|
|
|
|
|
|
|
|
713
|
|
|
|
|
|
|
Reflex::Role::Reactive provides Reflex's event-driven features to |
714
|
|
|
|
|
|
|
other objects. It provides public methods that help use reactive |
715
|
|
|
|
|
|
|
objects and to write them. |
716
|
|
|
|
|
|
|
|
717
|
|
|
|
|
|
|
=for Pod::Coverage BUILD DEMOLISH deliver get_id re_emit |
718
|
|
|
|
|
|
|
|
719
|
|
|
|
|
|
|
=head1 Public Attributes |
720
|
|
|
|
|
|
|
|
721
|
|
|
|
|
|
|
=head2 session_id |
722
|
|
|
|
|
|
|
|
723
|
|
|
|
|
|
|
Each Reflex object is associated with a POE session, although a single |
724
|
|
|
|
|
|
|
session may (and usually does) drive several objects. Reflex objects |
725
|
|
|
|
|
|
|
expose session_id() for times where it's important to know which |
726
|
|
|
|
|
|
|
session owns them. Usually when interfacing between Reflex and POE. |
727
|
|
|
|
|
|
|
|
728
|
|
|
|
|
|
|
session_id() is rarely needed, especially since Reflex provides helper |
729
|
|
|
|
|
|
|
classes for working with POE modules. Please see one or more of: |
730
|
|
|
|
|
|
|
L<Reflex::POE::Event>, L<Reflex::POE::Postback>, |
731
|
|
|
|
|
|
|
L<Reflex::POE::Session>, L<Reflex::POE::Wheel> and |
732
|
|
|
|
|
|
|
L<Reflex::POE::Wheel::Run>. |
733
|
|
|
|
|
|
|
|
734
|
|
|
|
|
|
|
sub method { |
735
|
|
|
|
|
|
|
my $self = shift; |
736
|
|
|
|
|
|
|
print( |
737
|
|
|
|
|
|
|
"I, $self, am driven by POE::Sesson ID ", |
738
|
|
|
|
|
|
|
$self->session_id(), "\n" |
739
|
|
|
|
|
|
|
); |
740
|
|
|
|
|
|
|
} |
741
|
|
|
|
|
|
|
|
742
|
|
|
|
|
|
|
=head2 watch |
743
|
|
|
|
|
|
|
|
744
|
|
|
|
|
|
|
watch() allows one object (the watcher) to register interest in |
745
|
|
|
|
|
|
|
events emitted by another. It takes three named parameters: |
746
|
|
|
|
|
|
|
"watched" must contain a Reflex object (either a Reflex::Role::Reactive |
747
|
|
|
|
|
|
|
consumer, or a Reflex::Base subclass). "event" contains the name of |
748
|
|
|
|
|
|
|
an event that the watched object emits. Finally, "callback" contains |
749
|
|
|
|
|
|
|
a Reflex::Callback that will be invoked when the event occurs. |
750
|
|
|
|
|
|
|
|
751
|
|
|
|
|
|
|
use Reflex::Callbacks(cb_method); |
752
|
|
|
|
|
|
|
|
753
|
|
|
|
|
|
|
$self->watch( |
754
|
|
|
|
|
|
|
watched => $an_object_maybe_myself, |
755
|
|
|
|
|
|
|
event => "occurrence", |
756
|
|
|
|
|
|
|
callback => cb_method($self, "method_name"), |
757
|
|
|
|
|
|
|
); |
758
|
|
|
|
|
|
|
|
759
|
|
|
|
|
|
|
=head2 emit |
760
|
|
|
|
|
|
|
|
761
|
|
|
|
|
|
|
Emit an event. This triggers callbacks for anything waiting for the |
762
|
|
|
|
|
|
|
event from the object that emitted it. Callback invocation is often |
763
|
|
|
|
|
|
|
synchronous, but this isn't guaranteed. Later versions of Reflex will |
764
|
|
|
|
|
|
|
support remote objects, where the emitter and callback may not be in |
765
|
|
|
|
|
|
|
the same room. |
766
|
|
|
|
|
|
|
|
767
|
|
|
|
|
|
|
Emit takes two named parameters so far: "event" names the event being |
768
|
|
|
|
|
|
|
emitted and is required. "args" allows data to be passed along with |
769
|
|
|
|
|
|
|
the event, and it should contain a hashref of named values. |
770
|
|
|
|
|
|
|
|
771
|
|
|
|
|
|
|
Reflex::Stream emits a "failure" event when things don't go as |
772
|
|
|
|
|
|
|
planned: |
773
|
|
|
|
|
|
|
|
774
|
|
|
|
|
|
|
sub _emit_failure { |
775
|
|
|
|
|
|
|
my ($self, $errfun) = @_; |
776
|
|
|
|
|
|
|
|
777
|
|
|
|
|
|
|
$self->emit( |
778
|
|
|
|
|
|
|
-name => "failure", |
779
|
|
|
|
|
|
|
data => undef, |
780
|
|
|
|
|
|
|
errnum => ($!+0), |
781
|
|
|
|
|
|
|
errstr => "$!", |
782
|
|
|
|
|
|
|
errfun => $errfun, |
783
|
|
|
|
|
|
|
); |
784
|
|
|
|
|
|
|
|
785
|
|
|
|
|
|
|
return; |
786
|
|
|
|
|
|
|
} |
787
|
|
|
|
|
|
|
|
788
|
|
|
|
|
|
|
=head2 ignore |
789
|
|
|
|
|
|
|
|
790
|
|
|
|
|
|
|
The ignore() method tells Reflex that one object has lost interest in |
791
|
|
|
|
|
|
|
events from another. It requires at least one parameter, the object |
792
|
|
|
|
|
|
|
to be ignored. Additional parameters may name specific events to |
793
|
|
|
|
|
|
|
ignore. |
794
|
|
|
|
|
|
|
|
795
|
|
|
|
|
|
|
Ignore an object entirely: |
796
|
|
|
|
|
|
|
|
797
|
|
|
|
|
|
|
$self->ignore($an_object_maybe_myself); |
798
|
|
|
|
|
|
|
|
799
|
|
|
|
|
|
|
Ignore just specific events: |
800
|
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
my @events = qw(success failure); |
802
|
|
|
|
|
|
|
$self->ignore($an_object_maybe_myself, @events); |
803
|
|
|
|
|
|
|
|
804
|
|
|
|
|
|
|
An object may destruct while it's being watched and/or is watching |
805
|
|
|
|
|
|
|
other objects. DEMOLISH will ensure that all watchers related to the |
806
|
|
|
|
|
|
|
outgoing object are cleaned up. Therefore it's usually more |
807
|
|
|
|
|
|
|
convenient to just destroy things when done with them. |
808
|
|
|
|
|
|
|
|
809
|
|
|
|
|
|
|
=head2 call_gate |
810
|
|
|
|
|
|
|
|
811
|
|
|
|
|
|
|
call_gate() is a helper that ensures a method is called from the same |
812
|
|
|
|
|
|
|
POE::Session instance that owns its object. It's mainly of interest |
813
|
|
|
|
|
|
|
to authors of POE modules and their Reflex interfaces. Other users |
814
|
|
|
|
|
|
|
may never need it. |
815
|
|
|
|
|
|
|
|
816
|
|
|
|
|
|
|
POE consumers often return responses to the sessions that made |
817
|
|
|
|
|
|
|
requests. For Reflex objects to receive these responses, they must |
818
|
|
|
|
|
|
|
first send their requests from the right sessions. call_gate() helps |
819
|
|
|
|
|
|
|
by ensuring the proper session is active. |
820
|
|
|
|
|
|
|
|
821
|
|
|
|
|
|
|
call_gate() takes one required positional parameter: the name of the |
822
|
|
|
|
|
|
|
method calling call_gate(). Any other parameters are passed back to |
823
|
|
|
|
|
|
|
the method, re-creating @_ as it was originally. |
824
|
|
|
|
|
|
|
|
825
|
|
|
|
|
|
|
call_gate() immediately returns 1 if it's called from the correct |
826
|
|
|
|
|
|
|
session. Otherwise it re-invokes the method in the proper session and |
827
|
|
|
|
|
|
|
returns 0. |
828
|
|
|
|
|
|
|
|
829
|
|
|
|
|
|
|
It's important to put call_gate() first in methods that need it, and |
830
|
|
|
|
|
|
|
for them to return immediately fi call_gate() returns false. |
831
|
|
|
|
|
|
|
|
832
|
|
|
|
|
|
|
This method from Reflex::Signal makes sure the signal is watched by |
833
|
|
|
|
|
|
|
the same session that owns the object doing the watching: |
834
|
|
|
|
|
|
|
|
835
|
|
|
|
|
|
|
sub start_watching { |
836
|
|
|
|
|
|
|
my $self = shift; |
837
|
|
|
|
|
|
|
return unless $self->call_gate("start_watching"); |
838
|
|
|
|
|
|
|
$POE::Kernel::poe_kernel->sig($self->name(), "signal_happened"); |
839
|
|
|
|
|
|
|
} |
840
|
|
|
|
|
|
|
|
841
|
|
|
|
|
|
|
=head2 run_within_session |
842
|
|
|
|
|
|
|
|
843
|
|
|
|
|
|
|
run_within_session() is another helper method to ensure some code is |
844
|
|
|
|
|
|
|
running in the POE session that POE modules may expect. It takes one |
845
|
|
|
|
|
|
|
required positional parameter, a code reference to invoke or the name |
846
|
|
|
|
|
|
|
of a method to call on $self. Any other parameters are passed to the |
847
|
|
|
|
|
|
|
code that will be executed. |
848
|
|
|
|
|
|
|
|
849
|
|
|
|
|
|
|
For example the IRC bot in eg/eg-13-irc-bot.pl wants to register |
850
|
|
|
|
|
|
|
callbacks with POE::Component::IRC. It calls a couple $bot->yield() |
851
|
|
|
|
|
|
|
methods within the object's session. This helps the component know |
852
|
|
|
|
|
|
|
where to send its responses: |
853
|
|
|
|
|
|
|
|
854
|
|
|
|
|
|
|
sub BUILD { |
855
|
|
|
|
|
|
|
my $self = shift; |
856
|
|
|
|
|
|
|
|
857
|
|
|
|
|
|
|
# Set up $self->component() to contain |
858
|
|
|
|
|
|
|
# a POE::Component::IRC object. |
859
|
|
|
|
|
|
|
|
860
|
|
|
|
|
|
|
...; |
861
|
|
|
|
|
|
|
|
862
|
|
|
|
|
|
|
# Register this object's interest in the component, |
863
|
|
|
|
|
|
|
# via the session that owns this object. |
864
|
|
|
|
|
|
|
$self->run_within_session( |
865
|
|
|
|
|
|
|
sub { |
866
|
|
|
|
|
|
|
$self->component()->yield(register => "all"); |
867
|
|
|
|
|
|
|
$self->component()->yield(connect => {}); |
868
|
|
|
|
|
|
|
} |
869
|
|
|
|
|
|
|
) |
870
|
|
|
|
|
|
|
} |
871
|
|
|
|
|
|
|
|
872
|
|
|
|
|
|
|
=head2 next |
873
|
|
|
|
|
|
|
|
874
|
|
|
|
|
|
|
Wait for the next event promised by an object. Requires the object to |
875
|
|
|
|
|
|
|
emit an event that isn't already explicitly handled. All Reflex |
876
|
|
|
|
|
|
|
objects will run in the background while next() blocks. |
877
|
|
|
|
|
|
|
|
878
|
|
|
|
|
|
|
next() returns the next event emitted by an object. Objects cease to |
879
|
|
|
|
|
|
|
run while your code processes the event, so be quick about it. |
880
|
|
|
|
|
|
|
|
881
|
|
|
|
|
|
|
Here's most of eg/eg-32-promise-tiny.pl, which shows how to next() on |
882
|
|
|
|
|
|
|
events from a Reflex::Interval. |
883
|
|
|
|
|
|
|
|
884
|
|
|
|
|
|
|
use Reflex::Interval; |
885
|
|
|
|
|
|
|
|
886
|
|
|
|
|
|
|
my $t = Reflex::Interval->new( |
887
|
|
|
|
|
|
|
interval => 1, |
888
|
|
|
|
|
|
|
auto_repeat => 1, |
889
|
|
|
|
|
|
|
); |
890
|
|
|
|
|
|
|
|
891
|
|
|
|
|
|
|
while (my $event = $t->next()) { |
892
|
|
|
|
|
|
|
print "next() returned event '$event->{name}'...\n"; |
893
|
|
|
|
|
|
|
} |
894
|
|
|
|
|
|
|
|
895
|
|
|
|
|
|
|
It's tempting to rename this method next(). |
896
|
|
|
|
|
|
|
|
897
|
|
|
|
|
|
|
=head2 run_all |
898
|
|
|
|
|
|
|
|
899
|
|
|
|
|
|
|
Run all active Reflex objects until they destruct. This will not |
900
|
|
|
|
|
|
|
return discrete events, like next() does. It will not return at all |
901
|
|
|
|
|
|
|
before the program is done. It returns no meaningful value yet. |
902
|
|
|
|
|
|
|
|
903
|
|
|
|
|
|
|
run_all() is useful when you don't care to next() on objects |
904
|
|
|
|
|
|
|
individually. You just want the program to run 'til it's done. |
905
|
|
|
|
|
|
|
|
906
|
|
|
|
|
|
|
=head1 EXAMPLES |
907
|
|
|
|
|
|
|
|
908
|
|
|
|
|
|
|
Many of the examples in the distribution's eg directory use Reflex |
909
|
|
|
|
|
|
|
objects. Explore and enjoy! |
910
|
|
|
|
|
|
|
|
911
|
|
|
|
|
|
|
=head1 SEE ALSO |
912
|
|
|
|
|
|
|
|
913
|
|
|
|
|
|
|
Please see those modules/websites for more information related to this module. |
914
|
|
|
|
|
|
|
|
915
|
|
|
|
|
|
|
=over 4 |
916
|
|
|
|
|
|
|
|
917
|
|
|
|
|
|
|
=item * |
918
|
|
|
|
|
|
|
|
919
|
|
|
|
|
|
|
L<Reflex|Reflex> |
920
|
|
|
|
|
|
|
|
921
|
|
|
|
|
|
|
=item * |
922
|
|
|
|
|
|
|
|
923
|
|
|
|
|
|
|
L<Moose::Manual::Concepts> |
924
|
|
|
|
|
|
|
|
925
|
|
|
|
|
|
|
=item * |
926
|
|
|
|
|
|
|
|
927
|
|
|
|
|
|
|
L<Reflex> |
928
|
|
|
|
|
|
|
|
929
|
|
|
|
|
|
|
=item * |
930
|
|
|
|
|
|
|
|
931
|
|
|
|
|
|
|
L<Reflex::Base> |
932
|
|
|
|
|
|
|
|
933
|
|
|
|
|
|
|
=item * |
934
|
|
|
|
|
|
|
|
935
|
|
|
|
|
|
|
L<Reflex/ACKNOWLEDGEMENTS> |
936
|
|
|
|
|
|
|
|
937
|
|
|
|
|
|
|
=item * |
938
|
|
|
|
|
|
|
|
939
|
|
|
|
|
|
|
L<Reflex/ASSISTANCE> |
940
|
|
|
|
|
|
|
|
941
|
|
|
|
|
|
|
=item * |
942
|
|
|
|
|
|
|
|
943
|
|
|
|
|
|
|
L<Reflex/AUTHORS> |
944
|
|
|
|
|
|
|
|
945
|
|
|
|
|
|
|
=item * |
946
|
|
|
|
|
|
|
|
947
|
|
|
|
|
|
|
L<Reflex/BUGS> |
948
|
|
|
|
|
|
|
|
949
|
|
|
|
|
|
|
=item * |
950
|
|
|
|
|
|
|
|
951
|
|
|
|
|
|
|
L<Reflex/BUGS> |
952
|
|
|
|
|
|
|
|
953
|
|
|
|
|
|
|
=item * |
954
|
|
|
|
|
|
|
|
955
|
|
|
|
|
|
|
L<Reflex/CONTRIBUTORS> |
956
|
|
|
|
|
|
|
|
957
|
|
|
|
|
|
|
=item * |
958
|
|
|
|
|
|
|
|
959
|
|
|
|
|
|
|
L<Reflex/COPYRIGHT> |
960
|
|
|
|
|
|
|
|
961
|
|
|
|
|
|
|
=item * |
962
|
|
|
|
|
|
|
|
963
|
|
|
|
|
|
|
L<Reflex/LICENSE> |
964
|
|
|
|
|
|
|
|
965
|
|
|
|
|
|
|
=item * |
966
|
|
|
|
|
|
|
|
967
|
|
|
|
|
|
|
L<Reflex/TODO> |
968
|
|
|
|
|
|
|
|
969
|
|
|
|
|
|
|
=back |
970
|
|
|
|
|
|
|
|
971
|
|
|
|
|
|
|
=head1 BUGS AND LIMITATIONS |
972
|
|
|
|
|
|
|
|
973
|
|
|
|
|
|
|
You can make new bug reports, and view existing ones, through the |
974
|
|
|
|
|
|
|
web interface at L<http://rt.cpan.org/Public/Dist/Display.html?Name=Reflex>. |
975
|
|
|
|
|
|
|
|
976
|
|
|
|
|
|
|
=head1 AUTHOR |
977
|
|
|
|
|
|
|
|
978
|
|
|
|
|
|
|
Rocco Caputo <rcaputo@cpan.org> |
979
|
|
|
|
|
|
|
|
980
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
981
|
|
|
|
|
|
|
|
982
|
|
|
|
|
|
|
This software is copyright (c) 2017 by Rocco Caputo. |
983
|
|
|
|
|
|
|
|
984
|
|
|
|
|
|
|
This is free software; you can redistribute it and/or modify it under |
985
|
|
|
|
|
|
|
the same terms as the Perl 5 programming language system itself. |
986
|
|
|
|
|
|
|
|
987
|
|
|
|
|
|
|
=head1 AVAILABILITY |
988
|
|
|
|
|
|
|
|
989
|
|
|
|
|
|
|
The latest version of this module is available from the Comprehensive Perl |
990
|
|
|
|
|
|
|
Archive Network (CPAN). Visit L<http://www.perl.com/CPAN/> to find a CPAN |
991
|
|
|
|
|
|
|
site near you, or see L<https://metacpan.org/module/Reflex/>. |
992
|
|
|
|
|
|
|
|
993
|
|
|
|
|
|
|
=head1 DISCLAIMER OF WARRANTY |
994
|
|
|
|
|
|
|
|
995
|
|
|
|
|
|
|
BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY |
996
|
|
|
|
|
|
|
FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT |
997
|
|
|
|
|
|
|
WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER |
998
|
|
|
|
|
|
|
PARTIES PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, |
999
|
|
|
|
|
|
|
EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE |
1000
|
|
|
|
|
|
|
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR |
1001
|
|
|
|
|
|
|
PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE |
1002
|
|
|
|
|
|
|
SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME |
1003
|
|
|
|
|
|
|
THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION. |
1004
|
|
|
|
|
|
|
|
1005
|
|
|
|
|
|
|
IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING |
1006
|
|
|
|
|
|
|
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR |
1007
|
|
|
|
|
|
|
REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE LIABLE |
1008
|
|
|
|
|
|
|
TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR |
1009
|
|
|
|
|
|
|
CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE |
1010
|
|
|
|
|
|
|
SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING |
1011
|
|
|
|
|
|
|
RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A |
1012
|
|
|
|
|
|
|
FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF |
1013
|
|
|
|
|
|
|
SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH |
1014
|
|
|
|
|
|
|
DAMAGES. |
1015
|
|
|
|
|
|
|
|
1016
|
|
|
|
|
|
|
=cut |