1# Manage file handles, associated descriptors, and read/write modes
2# thereon.
3
4package POE::Resource::FileHandles;
5
6use vars qw($VERSION);
7$VERSION = '1.368'; # NOTE - Should be #.### (three decimal places)
8
9# These methods are folded into POE::Kernel;
10package POE::Kernel;
11
12use strict;
13
14use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK);
15use IO::Handle ();
16use FileHandle ();
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
23BEGIN {
24  # older perls than 5.10 needs a kick in the arse to AUTOLOAD the constant...
25  eval "F_GETFL" if $] < 5.010;
26
27  if ( ! defined &Fcntl::F_GETFL ) {
28    if ( ! defined prototype "F_GETFL" ) {
29      *F_GETFL = sub { 0 };
30      *F_SETFL = sub { 0 };
31    } else {
32      *F_GETFL = sub () { 0 };
33      *F_SETFL = sub () { 0 };
34    }
35  }
36}
37
38### A local reference to POE::Kernel's queue.
39
40my $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
47my %kr_filenos;
48BEGIN { $poe_kernel->[KR_FILENOS] = \%kr_filenos; }
49
50sub FNO_MODE_RD      () { MODE_RD } # [ [ (fileno read mode structure)
51# --- BEGIN SUB STRUCT 1 ---        #
52sub FMO_REFCOUNT     () { 0      }  #     $fileno_total_use_count,
53sub FMO_ST_ACTUAL    () { 1      }  #     $requested_file_state (see HS_PAUSED)
54sub FMO_SESSIONS     () { 2      }  #     { $session_id =>
55                                    #       { $file_descriptor =>
56# --- BEGIN SUB STRUCT 2 ---        #
57sub HSS_HANDLE       () { 0      }  #         [ $blessed_handle,
58sub HSS_SESSION      () { 1      }  #           $blessed_session,
59sub HSS_STATE        () { 2      }  #           $event_name,
60sub HSS_ARGS         () { 3      }  #           \@callback_arguments
61                                    #         ],
62                                    #       },
63# --- CEASE SUB STRUCT 2 ---        #     },
64# --- CEASE SUB STRUCT 1 ---        #   ],
65                                    #
66sub FNO_MODE_WR      () { MODE_WR } #   [ (write mode structure is the same)
67                                    #   ],
68                                    #
69sub FNO_MODE_EX      () { MODE_EX } #   [ (expedite mode struct is the same)
70                                    #   ],
71                                    #
72sub FNO_TOT_REFCOUNT () { 3      }  #   $total_number_of_file_watchers,
73                                    # ]
74
75### These are the values for FMO_ST_ACTUAL.
76
77sub HS_STOPPED   () { 0x00 }   # The file has stopped generating events.
78sub HS_PAUSED    () { 0x01 }   # The file temporarily stopped making events.
79sub HS_RUNNING   () { 0x02 }   # The file is running and can generate events.
80
81### Handle to session.
82
83my %kr_ses_to_handle;
84                            #    { $session_id =>
85                            #      $fileno =>
86# --- BEGIN SUB STRUCT ---  #        [
87sub SH_HANDLE     () {  0 } #          $blessed_file_handle,
88sub SH_REFCOUNT   () {  1 } #          $total_reference_count,
89sub 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
98sub _data_handle_relocate_kernel_id {
99  my ($self, $old_id, $new_id) = @_;
100
101  foreach my $fd_rec (values %kr_filenos) {
102    my $rd_rec = $fd_rec->[FNO_MODE_RD][FMO_SESSIONS];
103    $rd_rec->{$new_id} = delete $rd_rec->{$old_id} if exists $rd_rec->{$old_id};
104
105    my $wr_rec = $fd_rec->[FNO_MODE_WR][FMO_SESSIONS];
106    $wr_rec->{$new_id} = delete $wr_rec->{$old_id} if exists $wr_rec->{$old_id};
107
108    my $ex_rec = $fd_rec->[FNO_MODE_EX][FMO_SESSIONS];
109    $ex_rec->{$new_id} = delete $ex_rec->{$old_id} if exists $ex_rec->{$old_id};
110  }
111
112  $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
118sub _data_handle_initialize {
119  my ($self, $queue) = @_;
120  $kr_queue = $queue;
121}
122
123### End-run leak checking.
124
125sub _data_handle_finalize {
126  my $finalized_ok = 1;
127
128  while (my ($fd, $fd_rec) = each(%kr_filenos)) {
129    my ($rd, $wr, $ex, $tot) = @$fd_rec;
130    $finalized_ok = 0;
131
132    _warn "!!! Leaked fileno: $fd (total refcnt=$tot)\n";
133
134    _warn(
135      "!!!\tRead:\n",
136      "!!!\t\trefcnt  = $rd->[FMO_REFCOUNT]\n",
137    );
138    while (my ($sid, $ses_rec) = each(%{$rd->[FMO_SESSIONS]})) {
139      _warn "!!!\t\tsession $sid\n";
140      while (my ($fd, $hnd_rec) = each(%{$ses_rec})) {
141        _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          "!!!\t\t\targs    = (@{$hnd_rec->[HSS_ARGS]})\n",
146        );
147      }
148    }
149
150    _warn(
151      "!!!\tWrite:\n",
152      "!!!\t\trefcnt  = $wr->[FMO_REFCOUNT]\n",
153    );
154    while (my ($sid, $ses_rec) = each(%{$wr->[FMO_SESSIONS]})) {
155      _warn "!!!\t\tsession = $sid\n";
156      while (my ($fd, $hnd_rec) = each(%{$ses_rec})) {
157        _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          "!!!\t\t\targs    = (@{$hnd_rec->[HSS_ARGS]})\n",
162        );
163      }
164    }
165
166    _warn(
167      "!!!\tException:\n",
168      "!!!\t\trefcnt  = $ex->[FMO_REFCOUNT]\n",
169    );
170    while (my ($sid, $ses_rec) = each(%{$ex->[FMO_SESSIONS]})) {
171      _warn "!!!\t\tsession = $sid\n";
172      while (my ($fd, $hnd_rec) = each(%{$ses_rec})) {
173        _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          "!!!\t\t\targs    = (@{$hnd_rec->[HSS_ARGS]})\n",
178        );
179      }
180    }
181  }
182
183  while (my ($ses_id, $hnd_rec) = each(%kr_ses_to_handle)) {
184    $finalized_ok = 0;
185    _warn "!!! Leaked file descriptor in $ses_id\n";
186    while (my ($fd, $rc) = each(%$hnd_rec)) {
187      _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  return $finalized_ok;
197}
198
199### Enqueue "select" events for a list of file descriptors in a given
200### access mode.
201
202sub _data_handle_enqueue_ready {
203  my ($self, $mode) = splice(@_, 0, 2);
204
205  my $now = monotime();
206  foreach my $fileno (@_) {
207    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    if( USE_SIGNAL_PIPE ) {
214      # _warn "fileno=$fileno signal_pipe_read=$POE::Kernel::signal_pipe_read_fd";
215      if( $fileno == $POE::Kernel::signal_pipe_read_fd ) {
216        $self->_data_sig_pipe_read( $fileno, $mode );
217        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    next unless exists $kr_filenos{$fileno};
226
227    # Gather and dispatch all the events for this fileno/mode pair.
228
229    foreach my $select (
230      map { values %$_ }
231      values %{ $kr_filenos{$fileno}[$mode][FMO_SESSIONS] }
232    ) {
233      $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          @{$select->[HSS_ARGS]}, # EA_SEL_ARGS
239        ],
240        __FILE__, __LINE__, undef, $now, -__LINE__
241      );
242    }
243  }
244
245  $self->_data_ses_gc_sweep();
246}
247
248### Test whether POE is tracking a file handle.
249
250sub _data_handle_is_good {
251  my ($self, $handle, $mode) = @_;
252
253  # Don't bother if the kernel isn't tracking the file.
254  return 0 unless exists $kr_filenos{fileno $handle};
255
256  # Don't bother if the kernel isn't tracking the file mode.
257  return 0 unless $kr_filenos{fileno $handle}->[$mode]->[FMO_REFCOUNT];
258
259  return 1;
260}
261
262### Add a select to the session, and possibly begin a watcher.
263
264sub _data_handle_add {
265  my ($self, $handle, $mode, $session, $event, $args) = @_;
266  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  unless (exists $kr_filenos{$fd}) {
273
274    $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    if (TRACE_FILES) {
291      _warn "<fh> adding $handle fd ($fd) in mode ($mode)";
292    }
293
294    $self->_data_handle_condition( $handle );
295  }
296
297  # Cache some high-level lookups.
298  my $kr_fileno  = $kr_filenos{$fd};
299  my $kr_fno_rec = $kr_fileno->[$mode];
300
301  # The session is already watching this fileno in this mode.
302
303  my $sid = $session->ID;
304  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    if (exists $kr_fno_rec->[FMO_SESSIONS]->{$sid}->{$fd}) {
310      if (TRACE_FILES) {
311        _warn("<fh> running $handle fileno($fd) mode($mode)");
312      }
313      $self->loop_resume_filehandle($handle, $mode);
314      $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      foreach my $watch_sid (keys %{$kr_fno_rec->[FMO_SESSIONS]}) {
327        foreach my $hdl_rec (
328          values %{$kr_fno_rec->[FMO_SESSIONS]->{$watch_sid}}
329        ) {
330          my $other_handle = $hdl_rec->[HSS_HANDLE];
331
332          my $why;
333          unless (defined(fileno $other_handle)) {
334            $why = "closed";
335          }
336          elsif (fileno($handle) == fileno($other_handle)) {
337            $why = "open";
338          }
339          else {
340            $why = "open with different file descriptor";
341          }
342
343          if ($sid eq $watch_sid) {
344            _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            _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      _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    $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    $kr_fileno->[FNO_TOT_REFCOUNT]++;
397    $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    if ($kr_fno_rec->[FMO_REFCOUNT] == 1) {
403      $self->loop_watch_filehandle($handle, $mode);
404      $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  unless (exists $kr_ses_to_handle{$sid}->{$fd}) {
412    $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    $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  my $ss_handle = $kr_ses_to_handle{$sid}->{$fd};
427  unless ($ss_handle->[SH_MODECOUNT]->[$mode]) {
428    $ss_handle->[SH_MODECOUNT]->[$mode]++;
429    $ss_handle->[SH_REFCOUNT]++;
430  }
431}
432
433### Condition a file handle so that it is ready for select et al
434sub _data_handle_condition {
435    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    eval { binmode *$handle };
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    IO::Handle::blocking($handle, 0) if (
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    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
466sub _data_handle_remove {
467  my ($self, $handle, $mode, $sid) = @_;
468  my $fd = fileno($handle);
469
470  # Make sure the handle is deregistered with the kernel.
471
472  if (defined($fd) and exists($kr_filenos{$fd})) {
473    my $kr_fileno  = $kr_filenos{$fd};
474    my $kr_fno_rec = $kr_fileno->[$mode];
475
476    # Make sure the handle was registered to the requested session.
477
478    if (
479      exists($kr_fno_rec->[FMO_SESSIONS]->{$sid}) and
480      exists($kr_fno_rec->[FMO_SESSIONS]->{$sid}->{$fd})
481    ) {
482
483      TRACE_FILES and
484        _warn(
485          "<fh> 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      my $handle_rec = delete $kr_fno_rec->[FMO_SESSIONS]->{$sid}->{$fd};
492
493      my $kill_session = $handle_rec->[HSS_SESSION];
494      my $kill_event   = $handle_rec->[HSS_STATE];
495
496      # Remove any events destined for that handle.
497      my $my_select = sub {
498        return 0 unless $_[0]->[EV_TYPE]    &  ET_SELECT;
499        return 0 unless $_[0]->[EV_SESSION] == $kill_session;
500        return 0 unless $_[0]->[EV_NAME]    eq $kill_event;
501        return 0 unless $_[0]->[EV_ARGS]->[EA_SEL_HANDLE] == $handle;
502        return 0 unless $_[0]->[EV_ARGS]->[EA_SEL_MODE]   == $mode;
503        return 1;
504      };
505
506      foreach ($kr_queue->remove_items($my_select)) {
507        my ($time, $id, $event) = @$_;
508        $self->_data_ev_refcount_dec(
509          $event->[EV_SOURCE]->ID(),
510          $event->[EV_SESSION]->ID(),
511        );
512
513        TRACE_EVENTS and _warn(
514          "<ev> removing select event $id ``$event->[EV_NAME]''" .
515          Carp::shortmess
516        );
517      }
518
519      # Decrement the handle's reference count.
520
521      $kr_fno_rec->[FMO_REFCOUNT]--;
522
523      if (ASSERT_DATA) {
524        _trap "<dt> 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      unless ($kr_fno_rec->[FMO_REFCOUNT]) {
532        $self->loop_ignore_filehandle($handle, $mode);
533        $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        delete $kr_fno_rec->[FMO_SESSIONS]->{$sid}
538          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      $kr_fileno->[FNO_TOT_REFCOUNT]--;
547
548      if (ASSERT_DATA) {
549        _trap "<dt> fileno refcount went below zero"
550          if $kr_fileno->[FNO_TOT_REFCOUNT] < 0;
551      }
552
553      unless ($kr_fileno->[FNO_TOT_REFCOUNT]) {
554        if (TRACE_FILES) {
555          _warn "<fh> deleting handle ($handle) fileno ($fd) entirely";
556        }
557        delete $kr_filenos{$fd};
558      }
559    }
560    elsif (TRACE_FILES) {
561      _warn(
562        "<fh> session doesn't own handle ($handle) fileno ($fd) mode ($mode)"
563      );
564    }
565  }
566  elsif (TRACE_FILES) {
567    _warn(
568      "<fh> 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  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    my $ss_handle = $kr_ses_to_handle{$sid}->{$fd};
585    if ($ss_handle->[SH_MODECOUNT]->[$mode]) {
586
587      # Hmm... what is this?  Was POE going to support multiple selects?
588
589      $ss_handle->[SH_MODECOUNT]->[$mode] = 0;
590
591      # Decrement the reference count, and delete the handle if it's done.
592
593      $ss_handle->[SH_REFCOUNT]--;
594
595      if (ASSERT_DATA) {
596        _trap "<dt> refcount went below zero"
597          if $ss_handle->[SH_REFCOUNT] < 0;
598      }
599
600      unless ($ss_handle->[SH_REFCOUNT]) {
601        delete $kr_ses_to_handle{$sid}->{$fd};
602        $self->_data_ses_refcount_dec($sid);
603        delete $kr_ses_to_handle{$sid}
604          unless keys %{$kr_ses_to_handle{$sid}};
605      }
606    }
607    elsif (TRACE_FILES) {
608      _warn(
609        "<fh> 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
620sub _data_handle_resume {
621  my ($self, $handle, $mode) = @_;
622
623  my $kr_fileno = $kr_filenos{fileno($handle)};
624  my $kr_fno_rec = $kr_fileno->[$mode];
625
626  if (TRACE_FILES) {
627    _warn(
628      "<fh> resume test: $handle fileno(" . fileno($handle) . ") mode($mode)"
629    );
630  }
631
632  $self->loop_resume_filehandle($handle, $mode);
633  $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
640sub _data_handle_pause {
641  my ($self, $handle, $mode) = @_;
642
643  my $kr_fileno = $kr_filenos{fileno($handle)};
644  my $kr_fno_rec = $kr_fileno->[$mode];
645
646  if (TRACE_FILES) {
647    _warn(
648      "<fh> pause test: $handle fileno(" . fileno($handle) . ") mode($mode)"
649    );
650  }
651
652  $self->loop_pause_filehandle($handle, $mode);
653  $kr_fno_rec->[FMO_ST_ACTUAL] = HS_PAUSED;
654}
655
656### Return the number of active filehandles in the entire system.
657
658sub _data_handle_count {
659  return scalar keys %kr_filenos;
660}
661
662### Return the number of active handles for a single session.
663
664sub _data_handle_count_ses {
665  my ($self, $sid) = @_;
666  return 0 unless exists $kr_ses_to_handle{$sid};
667  return scalar keys %{$kr_ses_to_handle{$sid}};
668}
669
670### Clear all the handles owned by a session.
671
672sub _data_handle_clear_session {
673  my ($self, $sid) = @_;
674
675  return unless exists $kr_ses_to_handle{$sid}; # avoid autoviv
676  foreach (values %{$kr_ses_to_handle{$sid}}) {
677    my $handle = $_->[SH_HANDLE];
678    my $refcount = $_->[SH_MODECOUNT];
679
680    $self->_data_handle_remove($handle, MODE_RD, $sid) if $refcount->[MODE_RD];
681    $self->_data_handle_remove($handle, MODE_WR, $sid) if $refcount->[MODE_WR];
682    $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
689sub _data_handle_fno_refcounts {
690  my ($self, $fd) = @_;
691  return(
692    $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
699sub _data_handle_fno_states {
700  my ($self, $fd) = @_;
701  return(
702    $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
708sub _data_handle_fno_sessions {
709  my ($self, $fd) = @_;
710
711  return(
712    $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
718sub _data_handle_handles {
719  my $self = shift;
720  return %kr_ses_to_handle;
721}
722
7231;
724
725__END__
726
727=head1 NAME
728
729POE::Resource::FileHandles - internal filehandle manager for POE::Kernel
730
731=head1 SYNOPSIS
732
733There is no public API.
734
735=head1 DESCRIPTION
736
737POE::Resource::FileHandles is a mix-in class for POE::Kernel.  It
738provides the low-level features to manage filehandles.  It is used
739internally by POE::Kernel, so it has no public interface.
740
741=head1 SEE ALSO
742
743See L<POE::Kernel/I/O Watchers (Selects)> for the public file watcher
744API.
745
746See L<POE::Kernel/Resources> for public information about POE
747resources.
748
749See L<POE::Resource> for general discussion about resources and the
750classes that manage them.
751
752=head1 BUGS
753
754POE watches I/O based on filehandles rather than file descriptors,
755which means there can be clashes between its API and an underlying
756descriptor-based event loop.  This is usually not a problem, but it
757may require a work-around in certain edge cases.
758
759=head1 AUTHORS & COPYRIGHTS
760
761Please see L<POE> for more information about authors and contributors.
762
763=cut
764
765# rocco // vim: ts=2 sw=2 expandtab
766# TODO - Edit.
767