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