line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# $Id: Prima.pm,v 1.7 2010/03/24 21:59:53 dk Exp $
|
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
# Prima event loop bridge for POE::Kernel.
|
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
package POE::Loop::Prima;
|
6
|
|
|
|
|
|
|
|
7
|
1
|
|
|
1
|
|
3382
|
use strict;
|
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
42
|
|
8
|
1
|
|
|
1
|
|
7
|
use warnings;
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
558
|
|
9
|
|
|
|
|
|
|
our $VERSION = '1.02';
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
# Include common signal handling.
|
12
|
1
|
|
|
1
|
|
537
|
use POE::Loop::PerlSignals;
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
package POE::Kernel;
|
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
use strict;
|
17
|
|
|
|
|
|
|
use warnings;
|
18
|
|
|
|
|
|
|
no warnings 'redefine';
|
19
|
|
|
|
|
|
|
use Prima;
|
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
my $_watcher_timer;
|
22
|
|
|
|
|
|
|
my @fileno_watcher;
|
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
#------------------------------------------------------------------------------
|
25
|
|
|
|
|
|
|
# Loop construction and destruction.
|
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
sub loop_initialize
|
28
|
|
|
|
|
|
|
{
|
29
|
|
|
|
|
|
|
$::application = Prima::Application-> create()
|
30
|
|
|
|
|
|
|
unless $::application;
|
31
|
|
|
|
|
|
|
}
|
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
sub loop_finalize
|
34
|
|
|
|
|
|
|
{
|
35
|
|
|
|
|
|
|
my $self = shift;
|
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
undef $_watcher_timer;
|
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
foreach my $fd (0..$#fileno_watcher) {
|
40
|
|
|
|
|
|
|
next unless defined $fileno_watcher[$fd];
|
41
|
|
|
|
|
|
|
foreach my $mode (MODE_RD, MODE_WR, MODE_EX) {
|
42
|
|
|
|
|
|
|
POE::Kernel::_warn(
|
43
|
|
|
|
|
|
|
"Mode $mode watcher for fileno $fd is defined during loop finalize"
|
44
|
|
|
|
|
|
|
) if defined $fileno_watcher[$fd]->[$mode];
|
45
|
|
|
|
|
|
|
}
|
46
|
|
|
|
|
|
|
}
|
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
if ( $::application) {
|
49
|
|
|
|
|
|
|
$::application-> destroy;
|
50
|
|
|
|
|
|
|
undef $::application;
|
51
|
|
|
|
|
|
|
}
|
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
$self-> loop_ignore_all_signals();
|
54
|
|
|
|
|
|
|
}
|
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
#------------------------------------------------------------------------------
|
57
|
|
|
|
|
|
|
# Signal handler maintenance functions.
|
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
# This function sets us up a signal when whichever window is passed to
|
60
|
|
|
|
|
|
|
# it closes.
|
61
|
|
|
|
|
|
|
sub loop_attach_uidestroy
|
62
|
|
|
|
|
|
|
{
|
63
|
|
|
|
|
|
|
my ( $self, $window) = @_;
|
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
$window-> onDestroy( sub {
|
66
|
|
|
|
|
|
|
return unless $self-> _data_ses_count();
|
67
|
|
|
|
|
|
|
$self-> _dispatch_event(
|
68
|
|
|
|
|
|
|
$self, $self,
|
69
|
|
|
|
|
|
|
EN_SIGNAL, ET_SIGNAL, [ 'UIDESTROY' ],
|
70
|
|
|
|
|
|
|
__FILE__, __LINE__, time(), -__LINE__
|
71
|
|
|
|
|
|
|
);
|
72
|
|
|
|
|
|
|
return 0;
|
73
|
|
|
|
|
|
|
} );
|
74
|
|
|
|
|
|
|
}
|
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
#------------------------------------------------------------------------------
|
77
|
|
|
|
|
|
|
# Maintain time watchers.
|
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
my $last_time = time();
|
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
sub _loop_event_callback
|
82
|
|
|
|
|
|
|
{
|
83
|
|
|
|
|
|
|
my $self = $poe_kernel;
|
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
if ( TRACE_STATISTICS) {
|
86
|
|
|
|
|
|
|
$self-> _data_stat_add('idle_seconds', time() - $last_time);
|
87
|
|
|
|
|
|
|
$last_time = time();
|
88
|
|
|
|
|
|
|
}
|
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
$self->_data_ev_dispatch_due();
|
91
|
|
|
|
|
|
|
$self->_test_if_kernel_is_idle();
|
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
$_watcher_timer-> stop;
|
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
# Return false to stop.
|
96
|
|
|
|
|
|
|
return 0;
|
97
|
|
|
|
|
|
|
}
|
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
sub loop_pause_time_watcher
|
100
|
|
|
|
|
|
|
{
|
101
|
|
|
|
|
|
|
$_watcher_timer-> stop if $_watcher_timer;
|
102
|
|
|
|
|
|
|
}
|
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
sub loop_resume_time_watcher
|
105
|
|
|
|
|
|
|
{
|
106
|
|
|
|
|
|
|
my ($self, $next_time) = @_;
|
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
$next_time -= time();
|
109
|
|
|
|
|
|
|
$next_time *= 1000;
|
110
|
|
|
|
|
|
|
$next_time = 0 if $next_time < 0;
|
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
$_watcher_timer = Prima::Timer-> new(
|
113
|
|
|
|
|
|
|
owner => $::application,
|
114
|
|
|
|
|
|
|
onTick => \&_loop_event_callback,
|
115
|
|
|
|
|
|
|
) unless $_watcher_timer;
|
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
$_watcher_timer-> stop;
|
118
|
|
|
|
|
|
|
$_watcher_timer-> timeout( $next_time);
|
119
|
|
|
|
|
|
|
$_watcher_timer-> start;
|
120
|
|
|
|
|
|
|
}
|
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
*loop_reset_time_watcher = \&loop_resume_time_watcher;
|
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
#------------------------------------------------------------------------------
|
125
|
|
|
|
|
|
|
# Maintain filehandle watchers.
|
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
my %mask = (
|
128
|
|
|
|
|
|
|
MODE_RD , [ fe::Read, 'onRead' ],
|
129
|
|
|
|
|
|
|
MODE_WR , [ fe::Write, 'onWrite' ],
|
130
|
|
|
|
|
|
|
MODE_EX , [ fe::Exception, 'onException' ],
|
131
|
|
|
|
|
|
|
);
|
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
sub _loop_select_callback
|
134
|
|
|
|
|
|
|
{
|
135
|
|
|
|
|
|
|
my ( $self, $obj) = ( $poe_kernel, @_ );
|
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
if (TRACE_FILES) {
|
138
|
|
|
|
|
|
|
POE::Kernel::_warn " got $mask{$obj->{mode}}->[1] callback for " . $obj-> file;
|
139
|
|
|
|
|
|
|
}
|
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
$self-> _data_handle_enqueue_ready( $obj->{mode}, $obj-> {fileno} );
|
142
|
|
|
|
|
|
|
$self-> _test_if_kernel_is_idle();
|
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
# Return false to stop
|
145
|
|
|
|
|
|
|
return 0;
|
146
|
|
|
|
|
|
|
}
|
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
sub loop_watch_filehandle
|
149
|
|
|
|
|
|
|
{
|
150
|
|
|
|
|
|
|
my ($self, $handle, $mode) = @_;
|
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
my $fileno = fileno($handle);
|
153
|
|
|
|
|
|
|
my $mask = $mask{ $mode };
|
154
|
|
|
|
|
|
|
die "Bad mode $mode" unless defined $mask;
|
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
# Overwriting a pre-existing watcher?
|
157
|
|
|
|
|
|
|
if (defined $fileno_watcher[$fileno]->[$mode]) {
|
158
|
|
|
|
|
|
|
$fileno_watcher[$fileno]->[$mode]-> destroy;
|
159
|
|
|
|
|
|
|
undef $fileno_watcher[$fileno]->[$mode];
|
160
|
|
|
|
|
|
|
}
|
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
if (TRACE_FILES) {
|
163
|
|
|
|
|
|
|
POE::Kernel::_warn " new file $handle in mode $mode";
|
164
|
|
|
|
|
|
|
}
|
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
# Register the new watcher.
|
167
|
|
|
|
|
|
|
my $obj = Prima::File-> new(
|
168
|
|
|
|
|
|
|
owner => $::application,
|
169
|
|
|
|
|
|
|
file => $handle,
|
170
|
|
|
|
|
|
|
mask => $mask-> [0],
|
171
|
|
|
|
|
|
|
$mask-> [1] => \&_loop_select_callback,
|
172
|
|
|
|
|
|
|
);
|
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
$obj-> {mode} = $mode;
|
175
|
|
|
|
|
|
|
$obj-> {fileno} = $fileno;
|
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
$fileno_watcher[$fileno]->[$mode] = $obj;
|
178
|
|
|
|
|
|
|
}
|
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
*loop_resume_filehandle = \&loop_watch_filehandle;
|
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
sub loop_ignore_filehandle
|
183
|
|
|
|
|
|
|
{
|
184
|
|
|
|
|
|
|
my ($self, $handle, $mode) = @_;
|
185
|
|
|
|
|
|
|
my $fileno = fileno($handle);
|
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
if (TRACE_FILES) {
|
188
|
|
|
|
|
|
|
POE::Kernel::_warn " destroy file $handle in mode $mode";
|
189
|
|
|
|
|
|
|
}
|
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
if (defined $fileno_watcher[$fileno]->[$mode]) {
|
192
|
|
|
|
|
|
|
$fileno_watcher[$fileno]->[$mode]-> destroy;
|
193
|
|
|
|
|
|
|
undef $fileno_watcher[$fileno]->[$mode];
|
194
|
|
|
|
|
|
|
}
|
195
|
|
|
|
|
|
|
}
|
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
*loop_pause_filehandle = \&loop_ignore_filehandle;
|
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
#------------------------------------------------------------------------------
|
200
|
|
|
|
|
|
|
# The event loop itself.
|
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
sub loop_do_timeslice
|
203
|
|
|
|
|
|
|
{
|
204
|
|
|
|
|
|
|
my $self = shift;
|
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
# Check for a hung kernel.
|
207
|
|
|
|
|
|
|
$self-> _test_if_kernel_is_idle();
|
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
my $now = time if TRACE_STATISTICS;
|
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
$::application-> yield() if $::application;
|
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
$self-> _data_stat_add('idle_seconds', time - $now) if TRACE_STATISTICS;
|
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
# Dispatch whatever events are due. Update the next dispatch time.
|
216
|
|
|
|
|
|
|
$self-> _data_ev_dispatch_due();
|
217
|
|
|
|
|
|
|
}
|
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
sub loop_run
|
220
|
|
|
|
|
|
|
{
|
221
|
|
|
|
|
|
|
my $self = shift;
|
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
# Run for as long as there are sessions to service.
|
224
|
|
|
|
|
|
|
while ($self->_data_ses_count()) {
|
225
|
|
|
|
|
|
|
$self->loop_do_timeslice();
|
226
|
|
|
|
|
|
|
}
|
227
|
|
|
|
|
|
|
}
|
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
sub loop_halt {}
|
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
sub skip_tests
|
232
|
|
|
|
|
|
|
{
|
233
|
|
|
|
|
|
|
return "Prima tests require the Prima module"
|
234
|
|
|
|
|
|
|
if do { eval "use Prima"; $@ };
|
235
|
|
|
|
|
|
|
}
|
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
1;
|
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
__END__
|