File Coverage

blib/lib/POE/Resource/FileHandles.pm
Criterion Covered Total %
statement 153 217 70.5
branch 50 80 62.5
condition 8 15 53.3
subroutine 25 25 100.0
pod n/a
total 236 337 70.0


line stmt bran cond sub pod time code
1             # Manage file handles, associated descriptors, and read/write modes
2             # thereon.
3              
4             package POE::Resource::FileHandles;
5              
6 175     175   787 use vars qw($VERSION);
  175         263  
  175         9572  
7             $VERSION = '1.365'; # NOTE - Should be #.### (three decimal places)
8              
9             # These methods are folded into POE::Kernel;
10             package POE::Kernel;
11              
12 175     175   817 use strict;
  175         244  
  175         5658  
13              
14 175     175   746 use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK);
  175         348  
  175         10320  
15 175     175   836 use IO::Handle ();
  175         334  
  175         2577  
16 175     175   88860 use FileHandle ();
  175         541858  
  175         19541  
17              
18             ### Some portability things.
19              
20             # Provide dummy constants so things at least compile. These constants
21             # aren't used if we're RUNNING_IN_HELL, but Perl needs to see them.
22              
23             BEGIN {
24             # older perls than 5.10 needs a kick in the arse to AUTOLOAD the constant...
25 175 50   175   888 eval "F_GETFL" if $] < 5.010;
26              
27 175 50       8001 if ( ! defined &Fcntl::F_GETFL ) {
28 0 0       0 if ( ! defined prototype "F_GETFL" ) {
29 0         0 *F_GETFL = sub { 0 };
  0         0  
30 0         0 *F_SETFL = sub { 0 };
  0         0  
31             } else {
32 0         0 *F_GETFL = sub () { 0 };
33 0         0 *F_SETFL = sub () { 0 };
34             }
35             }
36             }
37              
38             ### A local reference to POE::Kernel's queue.
39              
40             my $kr_queue;
41              
42             ### Fileno structure. This tracks the sessions that are watching a
43             ### file, by its file number. It used to track by file handle, but
44             ### several handles can point to the same underlying fileno. This is
45             ### more unique.
46              
47             my %kr_filenos;
48 175     175   531994 BEGIN { $poe_kernel->[KR_FILENOS] = \%kr_filenos; }
49              
50             sub FNO_MODE_RD () { MODE_RD } # [ [ (fileno read mode structure)
51             # --- BEGIN SUB STRUCT 1 --- #
52             sub FMO_REFCOUNT () { 0 } # $fileno_total_use_count,
53             sub FMO_ST_ACTUAL () { 1 } # $requested_file_state (see HS_PAUSED)
54             sub FMO_SESSIONS () { 2 } # { $session_id =>
55             # { $file_descriptor =>
56             # --- BEGIN SUB STRUCT 2 --- #
57             sub HSS_HANDLE () { 0 } # [ $blessed_handle,
58             sub HSS_SESSION () { 1 } # $blessed_session,
59             sub HSS_STATE () { 2 } # $event_name,
60             sub HSS_ARGS () { 3 } # \@callback_arguments
61             # ],
62             # },
63             # --- CEASE SUB STRUCT 2 --- # },
64             # --- CEASE SUB STRUCT 1 --- # ],
65             #
66             sub FNO_MODE_WR () { MODE_WR } # [ (write mode structure is the same)
67             # ],
68             #
69             sub FNO_MODE_EX () { MODE_EX } # [ (expedite mode struct is the same)
70             # ],
71             #
72             sub FNO_TOT_REFCOUNT () { 3 } # $total_number_of_file_watchers,
73             # ]
74              
75             ### These are the values for FMO_ST_ACTUAL.
76              
77             sub HS_STOPPED () { 0x00 } # The file has stopped generating events.
78             sub HS_PAUSED () { 0x01 } # The file temporarily stopped making events.
79             sub HS_RUNNING () { 0x02 } # The file is running and can generate events.
80              
81             ### Handle to session.
82              
83             my %kr_ses_to_handle;
84             # { $session_id =>
85             # $fileno =>
86             # --- BEGIN SUB STRUCT --- # [
87             sub SH_HANDLE () { 0 } # $blessed_file_handle,
88             sub SH_REFCOUNT () { 1 } # $total_reference_count,
89             sub SH_MODECOUNT () { 2 } # [ $read_reference_count, (MODE_RD)
90             # $write_reference_count, (MODE_WR)
91             # $expedite_reference_count, (MODE_EX)
92             # --- CEASE SUB STRUCT --- # ],
93             # ],
94             # ...
95             # },
96             # },
97              
98             sub _data_handle_relocate_kernel_id {
99 4     4   20 my ($self, $old_id, $new_id) = @_;
100              
101 4         93 foreach my $fd_rec (values %kr_filenos) {
102 0         0 my $rd_rec = $fd_rec->[FNO_MODE_RD][FMO_SESSIONS];
103 0 0       0 $rd_rec->{$new_id} = delete $rd_rec->{$old_id} if exists $rd_rec->{$old_id};
104              
105 0         0 my $wr_rec = $fd_rec->[FNO_MODE_WR][FMO_SESSIONS];
106 0 0       0 $wr_rec->{$new_id} = delete $wr_rec->{$old_id} if exists $wr_rec->{$old_id};
107              
108 0         0 my $ex_rec = $fd_rec->[FNO_MODE_EX][FMO_SESSIONS];
109 0 0       0 $ex_rec->{$new_id} = delete $ex_rec->{$old_id} if exists $ex_rec->{$old_id};
110             }
111              
112 4 50       34 $kr_ses_to_handle{$new_id} = delete $kr_ses_to_handle{$old_id}
113             if exists $kr_ses_to_handle{$old_id};
114             }
115              
116             ### Begin-run initialization.
117              
118             sub _data_handle_initialize {
119 173     173   328 my ($self, $queue) = @_;
120 173         350 $kr_queue = $queue;
121             }
122              
123             ### End-run leak checking.
124              
125             sub _data_handle_finalize {
126 190     190   1153 my $finalized_ok = 1;
127              
128 190         841 while (my ($fd, $fd_rec) = each(%kr_filenos)) {
129 0         0 my ($rd, $wr, $ex, $tot) = @$fd_rec;
130 0         0 $finalized_ok = 0;
131              
132 0         0 _warn "!!! Leaked fileno: $fd (total refcnt=$tot)\n";
133              
134 0         0 _warn(
135             "!!!\tRead:\n",
136             "!!!\t\trefcnt = $rd->[FMO_REFCOUNT]\n",
137             );
138 0         0 while (my ($sid, $ses_rec) = each(%{$rd->[FMO_SESSIONS]})) {
  0         0  
139 0         0 _warn "!!!\t\tsession $sid\n";
140 0         0 while (my ($fd, $hnd_rec) = each(%{$ses_rec})) {
  0         0  
141 0         0 _warn(
142             "!!!\t\t\thandle = $hnd_rec->[HSS_HANDLE]\n",
143             "!!!\t\t\tsession = $hnd_rec->[HSS_SESSION]\n",
144             "!!!\t\t\tevent = $hnd_rec->[HSS_STATE]\n",
145 0         0 "!!!\t\t\targs = (@{$hnd_rec->[HSS_ARGS]})\n",
146             );
147             }
148             }
149              
150             _warn(
151 0         0 "!!!\tWrite:\n",
152             "!!!\t\trefcnt = $wr->[FMO_REFCOUNT]\n",
153             );
154 0         0 while (my ($sid, $ses_rec) = each(%{$wr->[FMO_SESSIONS]})) {
  0         0  
155 0         0 _warn "!!!\t\tsession = $sid\n";
156 0         0 while (my ($fd, $hnd_rec) = each(%{$ses_rec})) {
  0         0  
157 0         0 _warn(
158             "!!!\t\t\thandle = $hnd_rec->[HSS_HANDLE]\n",
159             "!!!\t\t\tsession = $hnd_rec->[HSS_SESSION]\n",
160             "!!!\t\t\tevent = $hnd_rec->[HSS_STATE]\n",
161 0         0 "!!!\t\t\targs = (@{$hnd_rec->[HSS_ARGS]})\n",
162             );
163             }
164             }
165              
166             _warn(
167 0         0 "!!!\tException:\n",
168             "!!!\t\trefcnt = $ex->[FMO_REFCOUNT]\n",
169             );
170 0         0 while (my ($sid, $ses_rec) = each(%{$ex->[FMO_SESSIONS]})) {
  0         0  
171 0         0 _warn "!!!\t\tsession = $sid\n";
172 0         0 while (my ($fd, $hnd_rec) = each(%{$ses_rec})) {
  0         0  
173 0         0 _warn(
174             "!!!\t\t\thandle = $hnd_rec->[HSS_HANDLE]\n",
175             "!!!\t\t\tsession = $hnd_rec->[HSS_SESSION]\n",
176             "!!!\t\t\tevent = $hnd_rec->[HSS_STATE]\n",
177 0         0 "!!!\t\t\targs = (@{$hnd_rec->[HSS_ARGS]})\n",
178             );
179             }
180             }
181             }
182              
183 190         949 while (my ($ses_id, $hnd_rec) = each(%kr_ses_to_handle)) {
184 0         0 $finalized_ok = 0;
185 0         0 _warn "!!! Leaked file descriptor in $ses_id\n";
186 0         0 while (my ($fd, $rc) = each(%$hnd_rec)) {
187 0         0 _warn(
188             "!!!\tDescriptor: $fd (tot refcnt=$rc->[SH_REFCOUNT])\n",
189             "!!!\t\tRead refcnt: $rc->[SH_MODECOUNT]->[MODE_RD]\n",
190             "!!!\t\tWrite refcnt: $rc->[SH_MODECOUNT]->[MODE_WR]\n",
191             "!!!\t\tException refcnt: $rc->[SH_MODECOUNT]->[MODE_EX]\n",
192             );
193             }
194             }
195              
196 190         365 return $finalized_ok;
197             }
198              
199             ### Enqueue "select" events for a list of file descriptors in a given
200             ### access mode.
201              
202             sub _data_handle_enqueue_ready {
203 1247     1247   4461 my ($self, $mode) = splice(@_, 0, 2);
204              
205 1247         3419 my $now = monotime();
206 1247         2715 foreach my $fileno (@_) {
207 1806         2016 if (ASSERT_DATA) {
208             _trap "internal inconsistency: undefined fileno" unless defined $fileno;
209             }
210              
211             # By-pass the event queue for things that come over the pipe:
212             # this reduces signal latency
213 1806         4065 if( USE_SIGNAL_PIPE ) {
214             # _warn "fileno=$fileno signal_pipe_read=$POE::Kernel::signal_pipe_read_fd";
215 1806 100       2646 if( $fileno == $POE::Kernel::signal_pipe_read_fd ) {
216 1396         4204 $self->_data_sig_pipe_read( $fileno, $mode );
217 216         859 next;
218             }
219             }
220              
221             # Avoid autoviviying an empty $kr_filenos record if the fileno has
222             # been deactivated. This can happen if a file descriptor is ready
223             # in multiple modes, and an earlier dispatch removes it before a
224             # later dispatch happens.
225 538 100       1427 next unless exists $kr_filenos{$fileno};
226              
227             # Gather and dispatch all the events for this fileno/mode pair.
228              
229 1608         3460 foreach my $select (
  1606         2720  
230 1606         5603 map { values %$_ }
231             values %{ $kr_filenos{$fileno}[$mode][FMO_SESSIONS] }
232             ) {
233 1588         5028 $self->_dispatch_event(
234             $select->[HSS_SESSION], $select->[HSS_SESSION],
235             $select->[HSS_STATE], ET_SELECT, [
236             $select->[HSS_HANDLE], # EA_SEL_HANDLE
237             $mode, # EA_SEL_MODE
238 1598         5559 @{$select->[HSS_ARGS]}, # EA_SEL_ARGS
239             ],
240             __FILE__, __LINE__, undef, $now, -__LINE__
241             );
242             }
243             }
244              
245 1587         7360 $self->_data_ses_gc_sweep();
246             }
247              
248             ### Test whether POE is tracking a file handle.
249              
250             sub _data_handle_is_good {
251 2291     1463   5241 my ($self, $handle, $mode) = @_;
252              
253             # Don't bother if the kernel isn't tracking the file.
254 1463 100       4130 return 0 unless exists $kr_filenos{fileno $handle};
255              
256             # Don't bother if the kernel isn't tracking the file mode.
257 1454 100       4250 return 0 unless $kr_filenos{fileno $handle}->[$mode]->[FMO_REFCOUNT];
258              
259 1450         3974 return 1;
260             }
261              
262             ### Add a select to the session, and possibly begin a watcher.
263              
264             sub _data_handle_add {
265 1169     1169   6463 my ($self, $handle, $mode, $session, $event, $args) = @_;
266 1169         1764 my $fd = fileno($handle);
267              
268             # First time watching the file descriptor. Do some heavy setup.
269             #
270             # NB - This means we can't optimize away the delete() calls here and
271             # there, because they probably ensure that the structure exists.
272 1169 100       3323 unless (exists $kr_filenos{$fd}) {
273              
274 890         7425 $kr_filenos{$fd} =
275             [ [ 0, # FMO_REFCOUNT MODE_RD
276             HS_PAUSED, # FMO_ST_ACTUAL
277             { }, # FMO_SESSIONS
278             ],
279             [ 0, # FMO_REFCOUNT MODE_WR
280             HS_PAUSED, # FMO_ST_ACTUAL
281             { }, # FMO_SESSIONS
282             ],
283             [ 0, # FMO_REFCOUNT MODE_EX
284             HS_PAUSED, # FMO_ST_ACTUAL
285             { }, # FMO_SESSIONS
286             ],
287             0, # FNO_TOT_REFCOUNT
288             ];
289              
290 890         1247 if (TRACE_FILES) {
291             _warn " adding $handle fd ($fd) in mode ($mode)";
292             }
293              
294 890         4632 $self->_data_handle_condition( $handle );
295             }
296              
297             # Cache some high-level lookups.
298 1037         2810 my $kr_fileno = $kr_filenos{$fd};
299 1169         1724 my $kr_fno_rec = $kr_fileno->[$mode];
300              
301             # The session is already watching this fileno in this mode.
302              
303 1169         3061 my $sid = $session->ID;
304 1169 100       3198 if ($kr_fno_rec->[FMO_SESSIONS]->{$sid}) {
305              
306             # The session is also watching it by the same handle. Treat this
307             # as a "resume" in this mode.
308              
309 499 50       1206 if (exists $kr_fno_rec->[FMO_SESSIONS]->{$sid}->{$fd}) {
310 109         196 if (TRACE_FILES) {
311             _warn(" running $handle fileno($fd) mode($mode)");
312             }
313 109         178 $self->loop_resume_filehandle($handle, $mode);
314 109         364 $kr_fno_rec->[FMO_ST_ACTUAL] = HS_RUNNING;
315             }
316              
317             # The session is watching it by a different handle. It can't be
318             # done yet, but maybe later when drivers are added to the mix.
319             #
320             # TODO - This can occur if someone closes a filehandle without
321             # calling select_foo() to deregister it from POE. In that case,
322             # the operating system reuses the file descriptor, but we still
323             # have something registered for it here.
324              
325             else {
326 54         281 foreach my $watch_sid (keys %{$kr_fno_rec->[FMO_SESSIONS]}) {
  54         86  
327 0         0 foreach my $hdl_rec (
  0         0  
328             values %{$kr_fno_rec->[FMO_SESSIONS]->{$watch_sid}}
329             ) {
330 0         0 my $other_handle = $hdl_rec->[HSS_HANDLE];
331              
332 0         0 my $why;
333 0 0       0 unless (defined(fileno $other_handle)) {
    0          
334 0         0 $why = "closed";
335             }
336             elsif (fileno($handle) == fileno($other_handle)) {
337 0         0 $why = "open";
338             }
339             else {
340 0         0 $why = "open with different file descriptor";
341             }
342              
343 0 0       0 if ($sid eq $watch_sid) {
344 0         0 _die(
345             "A session was caught watching two different file handles that\n",
346             "reference the same file descriptor in the same mode ($mode).\n",
347             "This error is usually caused by a file descriptor leak. The\n",
348             "most common cause is explicitly closing a filehandle without\n",
349             "first unregistering it from POE.\n",
350             "\n",
351             "Some possibly helpful information:\n",
352             " Session : ",
353             $self->_data_alias_loggable($sid), "\n",
354             " Old handle : $other_handle (currently $why)\n",
355             " New handle : $handle\n",
356             "\n",
357             "Please correct the program and try again.\n",
358             );
359             }
360             else {
361 0         0 _die(
362             "Two sessions were caught watching the same file descriptor\n",
363             "in the same mode ($mode). This error is usually caused by\n",
364             "a file descriptor leak. The most common cause is explicitly\n",
365             "closing a filehandle without first unregistering it from POE.\n",
366             "\n",
367             "Some possibly helpful information:\n",
368             " Old session: ",
369             $self->_data_alias_loggable($hdl_rec->[HSS_SESSION]->ID), "\n",
370             " Old handle : $other_handle (currently $why)\n",
371             " New session: ",
372             $self->_data_alias_loggable($sid), "\n",
373             " New handle : $handle\n",
374             "\n",
375             "Please correct the program and try again.\n",
376             );
377             }
378             }
379             }
380 0         0 _trap "internal inconsistency";
381             }
382             }
383              
384             # The session is not watching this fileno in this mode. Record
385             # the session/handle pair.
386              
387             else {
388 670         2894 $kr_fno_rec->[FMO_SESSIONS]->{$sid}->{$fd} = [
389             $handle, # HSS_HANDLE
390             $session, # HSS_SESSION
391             $event, # HSS_STATE
392             $args, # HSS_ARGS
393             ];
394              
395             # Fix reference counts.
396 670         947 $kr_fileno->[FNO_TOT_REFCOUNT]++;
397 1060         2496 $kr_fno_rec->[FMO_REFCOUNT]++;
398              
399             # If this is the first time a file is watched in this mode, then
400             # have the event loop bridge watch it.
401              
402 1060 50       2023 if ($kr_fno_rec->[FMO_REFCOUNT] == 1) {
403 1060         4466 $self->loop_watch_filehandle($handle, $mode);
404 1060         1826 $kr_fno_rec->[FMO_ST_ACTUAL] = HS_RUNNING;
405             }
406             }
407              
408             # If the session hasn't already been watching the filehandle, then
409             # register the filehandle in the session's structure.
410              
411 1115 100       5044 unless (exists $kr_ses_to_handle{$sid}->{$fd}) {
412 968         2710 $kr_ses_to_handle{$sid}->{$fd} = [
413             $handle, # SH_HANDLE
414             0, # SH_REFCOUNT
415             [ 0, # SH_MODECOUNT / MODE_RD
416             0, # SH_MODECOUNT / MODE_WR
417             0 # SH_MODECOUNT / MODE_EX
418             ]
419             ];
420 1022         7821 $self->_data_ses_refcount_inc($sid);
421             }
422              
423             # Modify the session's handle structure's reference counts, so the
424             # session knows it has a reason to live.
425              
426 1037         2516 my $ss_handle = $kr_ses_to_handle{$sid}->{$fd};
427 1037 100       3704 unless ($ss_handle->[SH_MODECOUNT]->[$mode]) {
428 1114         40454 $ss_handle->[SH_MODECOUNT]->[$mode]++;
429 1114         3581 $ss_handle->[SH_REFCOUNT]++;
430             }
431             }
432              
433             ### Condition a file handle so that it is ready for select et al
434             sub _data_handle_condition {
435 1549     1159   2657 my( $self, $handle ) = @_;
436              
437             # For DOSISH systems like OS/2. Wrapped in eval{} in case it's a
438             # tied handle that doesn't support binmode.
439 1549         3433 eval { binmode *$handle };
  1159         3192  
440              
441             # Turn off blocking on the handle. Requires a sufficiently
442             # advanced Perl as not to be broken. Otherwise we must skip tied
443             # filehandles or plain files.
444             #
445             # Perl-5.6.2 and older seem to hate tied FHs or plain files, so we
446             # be careful!
447             #
448             # ok 115 - regular file: handle removed fully
449             # Bad filehandle: GEN11
450             # at /home/cpan/poe/blib/lib/POE/Resource/FileHandles.pm line 442.
451             # Compilation failed in require
452             # at t/20_resources/10_perl/filehandles.t line 9.
453              
454 1159 50 0     8448 IO::Handle::blocking($handle, 0) if (
      33        
455             $] >= 5.008001 or not (tied *$handle or -f $handle)
456             );
457              
458             # Turn off buffering.
459             # you may be tempted to use $handle->autoflush(1) BUT DON'T DO THAT! ( things blow up )
460 1159         10258 CORE::select((CORE::select($handle), $| = 1)[0]);
461             }
462              
463             ### Remove a select from the kernel, and possibly trigger the
464             ### session's destruction.
465              
466             sub _data_handle_remove {
467 1580     1580   2297 my ($self, $handle, $mode, $sid) = @_;
468 1580         2350 my $fd = fileno($handle);
469              
470             # Make sure the handle is deregistered with the kernel.
471              
472 1580 100 66     7102 if (defined($fd) and exists($kr_filenos{$fd})) {
473 1035         1455 my $kr_fileno = $kr_filenos{$fd};
474 1035         1843 my $kr_fno_rec = $kr_fileno->[$mode];
475              
476             # Make sure the handle was registered to the requested session.
477              
478 1035 100 66     4991 if (
479             exists($kr_fno_rec->[FMO_SESSIONS]->{$sid}) and
480             exists($kr_fno_rec->[FMO_SESSIONS]->{$sid}->{$fd})
481             ) {
482              
483 908         1778 TRACE_FILES and
484             _warn(
485             " removing handle ($handle) fileno ($fd) mode ($mode) from " .
486             $self->_data_alias_loggable($sid) . Carp::shortmess()
487             );
488              
489             # Remove the handle from the kernel's session record.
490              
491 908         2843 my $handle_rec = delete $kr_fno_rec->[FMO_SESSIONS]->{$sid}->{$fd};
492              
493 908         1402 my $kill_session = $handle_rec->[HSS_SESSION];
494 908         1318 my $kill_event = $handle_rec->[HSS_STATE];
495              
496             # Remove any events destined for that handle.
497             my $my_select = sub {
498 1808 50   1808   7589 return 0 unless $_[0]->[EV_TYPE] & ET_SELECT;
499 0 0       0 return 0 unless $_[0]->[EV_SESSION] == $kill_session;
500 0 0       0 return 0 unless $_[0]->[EV_NAME] eq $kill_event;
501 0 0       0 return 0 unless $_[0]->[EV_ARGS]->[EA_SEL_HANDLE] == $handle;
502 0 0       0 return 0 unless $_[0]->[EV_ARGS]->[EA_SEL_MODE] == $mode;
503 0         0 return 1;
504 908         5112 };
505              
506 908         3682 foreach ($kr_queue->remove_items($my_select)) {
507 0         0 my ($time, $id, $event) = @$_;
508 0         0 $self->_data_ev_refcount_dec(
509             $event->[EV_SOURCE]->ID(),
510             $event->[EV_SESSION]->ID(),
511             );
512              
513 0         0 TRACE_EVENTS and _warn(
514             " removing select event $id ``$event->[EV_NAME]''" .
515             Carp::shortmess
516             );
517             }
518              
519             # Decrement the handle's reference count.
520              
521 908         1464 $kr_fno_rec->[FMO_REFCOUNT]--;
522              
523 908         857 if (ASSERT_DATA) {
524             _trap "
fileno mode refcount went below zero"
525             if $kr_fno_rec->[FMO_REFCOUNT] < 0;
526             }
527              
528             # If the "mode" count drops to zero, then stop selecting the
529             # handle.
530              
531 908 50       2131 unless ($kr_fno_rec->[FMO_REFCOUNT]) {
532 908         2156 $self->loop_ignore_filehandle($handle, $mode);
533 908         2535 $kr_fno_rec->[FMO_ST_ACTUAL] = HS_STOPPED;
534              
535             # The session is not watching handles anymore. Remove the
536             # session entirely the fileno structure.
537 908         1637 delete $kr_fno_rec->[FMO_SESSIONS]->{$sid}
538 908 100       1077 unless keys %{$kr_fno_rec->[FMO_SESSIONS]->{$sid}};
539             }
540              
541             # Decrement the kernel record's handle reference count. If the
542             # handle is done being used, then delete it from the kernel's
543             # record structure. This initiates Perl's garbage collection on
544             # it, as soon as whatever else in "user space" frees it.
545              
546 908         3615 $kr_fileno->[FNO_TOT_REFCOUNT]--;
547              
548 908         1334 if (ASSERT_DATA) {
549             _trap "
fileno refcount went below zero"
550             if $kr_fileno->[FNO_TOT_REFCOUNT] < 0;
551             }
552              
553 908 100       1270 unless ($kr_fileno->[FNO_TOT_REFCOUNT]) {
554 888         1558 if (TRACE_FILES) {
555             _warn " deleting handle ($handle) fileno ($fd) entirely";
556             }
557 888         3977 delete $kr_filenos{$fd};
558             }
559             }
560 452         432 elsif (TRACE_FILES) {
561             _warn(
562             " session doesn't own handle ($handle) fileno ($fd) mode ($mode)"
563             );
564             }
565             }
566 452         4525 elsif (TRACE_FILES) {
567             _warn(
568             " handle ($handle) fileno ($fd) is not registered with POE::Kernel" .
569             Carp::shortmess()
570              
571             );
572             }
573              
574             # SS_HANDLES - Remove the select from the session, assuming there is
575             # a session to remove it from. TODO Key it on fileno?
576              
577 778 100 100     4704 if (
578             exists($kr_ses_to_handle{$sid}) and
579             exists($kr_ses_to_handle{$sid}->{$fd})
580             ) {
581              
582             # Remove it from the session's read, write or expedite mode.
583              
584 385         794 my $ss_handle = $kr_ses_to_handle{$sid}->{$fd};
585 1003 100       14394 if ($ss_handle->[SH_MODECOUNT]->[$mode]) {
586              
587             # Hmm... what is this? Was POE going to support multiple selects?
588              
589 1127         3698 $ss_handle->[SH_MODECOUNT]->[$mode] = 0;
590              
591             # Decrement the reference count, and delete the handle if it's done.
592              
593 1018         1908 $ss_handle->[SH_REFCOUNT]--;
594              
595 964         1447 if (ASSERT_DATA) {
596             _trap "
refcount went below zero"
597             if $ss_handle->[SH_REFCOUNT] < 0;
598             }
599              
600 908 100       1356 unless ($ss_handle->[SH_REFCOUNT]) {
601 888         1082 delete $kr_ses_to_handle{$sid}->{$fd};
602 888         1777 $self->_data_ses_refcount_dec($sid);
603 816         2758 delete $kr_ses_to_handle{$sid}
604 888 100       1530 unless keys %{$kr_ses_to_handle{$sid}};
605             }
606             }
607 452         1353 elsif (TRACE_FILES) {
608             _warn(
609             " handle ($handle) fileno ($fd) is not registered with",
610             $self->_data_alias_loggable($sid)
611             );
612             }
613             }
614             }
615              
616             ### Resume a filehandle. If there are no events in the queue for this
617             ### handle/mode pair, then we go ahead and set the actual state now.
618             ### Otherwise it must wait until the queue empties.
619              
620             sub _data_handle_resume {
621 1012     560   1716 my ($self, $handle, $mode) = @_;
622              
623 1012         2979 my $kr_fileno = $kr_filenos{fileno($handle)};
624 729         2152 my $kr_fno_rec = $kr_fileno->[$mode];
625              
626 616         909 if (TRACE_FILES) {
627             _warn(
628             " resume test: $handle fileno(" . fileno($handle) . ") mode($mode)"
629             );
630             }
631              
632 560         2641 $self->loop_resume_filehandle($handle, $mode);
633 560         2214 $kr_fno_rec->[FMO_ST_ACTUAL] = HS_RUNNING;
634             }
635              
636             ### Pause a filehandle. If there are no events in the queue for this
637             ### handle/mode pair, then we go ahead and set the actual state now.
638             ### Otherwise it must wait until the queue empties.
639              
640             sub _data_handle_pause {
641 1253     885   3919 my ($self, $handle, $mode) = @_;
642              
643 885         1902 my $kr_fileno = $kr_filenos{fileno($handle)};
644 885         1526 my $kr_fno_rec = $kr_fileno->[$mode];
645              
646 885         917 if (TRACE_FILES) {
647             _warn(
648             " pause test: $handle fileno(" . fileno($handle) . ") mode($mode)"
649             );
650             }
651              
652 885         5043 $self->loop_pause_filehandle($handle, $mode);
653 885         3514 $kr_fno_rec->[FMO_ST_ACTUAL] = HS_PAUSED;
654             }
655              
656             ### Return the number of active filehandles in the entire system.
657              
658             sub _data_handle_count {
659 2480     2046   10580 return scalar keys %kr_filenos;
660             }
661              
662             ### Return the number of active handles for a single session.
663              
664             sub _data_handle_count_ses {
665 4500     4500   5574 my ($self, $sid) = @_;
666 4500 100       16589 return 0 unless exists $kr_ses_to_handle{$sid};
667 1099         1166 return scalar keys %{$kr_ses_to_handle{$sid}};
  1099         4215  
668             }
669              
670             ### Clear all the handles owned by a session.
671              
672             sub _data_handle_clear_session {
673 775     775   1160 my ($self, $sid) = @_;
674              
675 775 100       2113 return unless exists $kr_ses_to_handle{$sid}; # avoid autoviv
676 5         6 foreach (values %{$kr_ses_to_handle{$sid}}) {
  5         14  
677 6         12 my $handle = $_->[SH_HANDLE];
678 6         8 my $refcount = $_->[SH_MODECOUNT];
679              
680 6 100       25 $self->_data_handle_remove($handle, MODE_RD, $sid) if $refcount->[MODE_RD];
681 6 100       22 $self->_data_handle_remove($handle, MODE_WR, $sid) if $refcount->[MODE_WR];
682 6 100       29 $self->_data_handle_remove($handle, MODE_EX, $sid) if $refcount->[MODE_EX];
683             }
684             }
685              
686             # TODO Testing accessors. Maybe useful for introspection. May need
687             # modification before that.
688              
689             sub _data_handle_fno_refcounts {
690 7     7   57 my ($self, $fd) = @_;
691             return(
692 7         39 $kr_filenos{$fd}->[FNO_TOT_REFCOUNT],
693             $kr_filenos{$fd}->[FNO_MODE_RD]->[FMO_REFCOUNT],
694             $kr_filenos{$fd}->[FNO_MODE_WR]->[FMO_REFCOUNT],
695             $kr_filenos{$fd}->[FNO_MODE_EX]->[FMO_REFCOUNT],
696             )
697             }
698              
699             sub _data_handle_fno_states {
700 13     13   4562 my ($self, $fd) = @_;
701             return(
702 13         63 $kr_filenos{$fd}->[FNO_MODE_RD]->[FMO_ST_ACTUAL],
703             $kr_filenos{$fd}->[FNO_MODE_WR]->[FMO_ST_ACTUAL],
704             $kr_filenos{$fd}->[FNO_MODE_EX]->[FMO_ST_ACTUAL],
705             );
706             }
707              
708             sub _data_handle_fno_sessions {
709 7     7   2902 my ($self, $fd) = @_;
710              
711             return(
712 7         40 $kr_filenos{$fd}->[FNO_MODE_RD]->[FMO_SESSIONS],
713             $kr_filenos{$fd}->[FNO_MODE_WR]->[FMO_SESSIONS],
714             $kr_filenos{$fd}->[FNO_MODE_EX]->[FMO_SESSIONS],
715             );
716             }
717              
718             sub _data_handle_handles {
719 8     8   258 my $self = shift;
720 8         41 return %kr_ses_to_handle;
721             }
722              
723             1;
724              
725             __END__