view release on metacpan or  search on metacpan

lib/POE/Resource/FileHandles.pm  view on Meta::CPAN

### A local reference to POE::Kernel's queue.

my $kr_queue;

### Fileno structure.  This tracks the sessions that are watching a
### file, by its file number.  It used to track by file handle, but
### several handles can point to the same underlying fileno.  This is
### more unique.

my %kr_filenos;
BEGIN { $poe_kernel->[KR_FILENOS] = \%kr_filenos; }

sub FNO_MODE_RD      () { MODE_RD } # [ [ (fileno read mode structure)
# --- BEGIN SUB STRUCT 1 ---        #
sub FMO_REFCOUNT     () { 0      }  #     $fileno_total_use_count,
sub FMO_ST_ACTUAL    () { 1      }  #     $requested_file_state (see HS_PAUSED)
sub FMO_SESSIONS     () { 2      }  #     { $session_id =>
                                    #       { $file_descriptor =>
# --- BEGIN SUB STRUCT 2 ---        #
sub HSS_HANDLE       () { 0      }  #         [ $blessed_handle,
sub HSS_SESSION      () { 1      }  #           $blessed_session,
sub HSS_STATE        () { 2      }  #           $event_name,
sub HSS_ARGS         () { 3      }  #           \@callback_arguments
                                    #         ],
                                    #       },
# --- CEASE SUB STRUCT 2 ---        #     },
# --- CEASE SUB STRUCT 1 ---        #   ],
                                    #
sub FNO_MODE_WR      () { MODE_WR } #   [ (write mode structure is the same)
                                    #   ],
                                    #
sub FNO_MODE_EX      () { MODE_EX } #   [ (expedite mode struct is the same)
                                    #   ],
                                    #
sub FNO_TOT_REFCOUNT () { 3      }  #   $total_number_of_file_watchers,
                                    # ]

### These are the values for FMO_ST_ACTUAL.

sub HS_STOPPED   () { 0x00 }   # The file has stopped generating events.
sub HS_PAUSED    () { 0x01 }   # The file temporarily stopped making events.
sub HS_RUNNING   () { 0x02 }   # The file is running and can generate events.

### Handle to session.

my %kr_ses_to_handle;
                            #    { $session_id =>
                            #      $fileno =>
# --- BEGIN SUB STRUCT ---  #        [
sub SH_HANDLE     () {  0 } #          $blessed_file_handle,
sub SH_REFCOUNT   () {  1 } #          $total_reference_count,
sub SH_MODECOUNT  () {  2 } #          [ $read_reference_count,     (MODE_RD)
                            #            $write_reference_count,    (MODE_WR)
                            #            $expedite_reference_count, (MODE_EX)
# --- CEASE SUB STRUCT ---  #          ],
                            #        ],
                            #        ...
                            #      },
                            #    },

sub _data_handle_relocate_kernel_id {
  my ($self, $old_id, $new_id) = @_;

  foreach my $fd_rec (values %kr_filenos) {
    my $rd_rec = $fd_rec->[FNO_MODE_RD][FMO_SESSIONS];
    $rd_rec->{$new_id} = delete $rd_rec->{$old_id} if exists $rd_rec->{$old_id};

    my $wr_rec = $fd_rec->[FNO_MODE_WR][FMO_SESSIONS];
    $wr_rec->{$new_id} = delete $wr_rec->{$old_id} if exists $wr_rec->{$old_id};

    my $ex_rec = $fd_rec->[FNO_MODE_EX][FMO_SESSIONS];
    $ex_rec->{$new_id} = delete $ex_rec->{$old_id} if exists $ex_rec->{$old_id};
  }

  $kr_ses_to_handle{$new_id} = delete $kr_ses_to_handle{$old_id}
    if exists $kr_ses_to_handle{$old_id};
}

### Begin-run initialization.

sub _data_handle_initialize {
  my ($self, $queue) = @_;
  $kr_queue = $queue;
}

### End-run leak checking.

sub _data_handle_finalize {
  my $finalized_ok = 1;

  while (my ($fd, $fd_rec) = each(%kr_filenos)) {
    my ($rd, $wr, $ex, $tot) = @$fd_rec;
    $finalized_ok = 0;

    _warn "!!! Leaked fileno: $fd (total refcnt=$tot)\n";

    _warn(
      "!!!\tRead:\n",
      "!!!\t\trefcnt  = $rd->[FMO_REFCOUNT]\n",
    );
    while (my ($sid, $ses_rec) = each(%{$rd->[FMO_SESSIONS]})) {
      _warn "!!!\t\tsession $sid\n";
      while (my ($fd, $hnd_rec) = each(%{$ses_rec})) {
        _warn(
          "!!!\t\t\thandle  = $hnd_rec->[HSS_HANDLE]\n",
          "!!!\t\t\tsession = $hnd_rec->[HSS_SESSION]\n",
          "!!!\t\t\tevent   = $hnd_rec->[HSS_STATE]\n",
          "!!!\t\t\targs    = (@{$hnd_rec->[HSS_ARGS]})\n",
        );
      }
    }

    _warn(
      "!!!\tWrite:\n",
      "!!!\t\trefcnt  = $wr->[FMO_REFCOUNT]\n",
    );
    while (my ($sid, $ses_rec) = each(%{$wr->[FMO_SESSIONS]})) {
      _warn "!!!\t\tsession = $sid\n";
      while (my ($fd, $hnd_rec) = each(%{$ses_rec})) {
        _warn(
          "!!!\t\t\thandle  = $hnd_rec->[HSS_HANDLE]\n",