view release on metacpan or  search on metacpan

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

# Data and accessors to manage POE's events.

package POE::Resource::Events;

use vars qw($VERSION);
$VERSION = '1.370'; # NOTE - Should be #.### (three decimal places)

# These methods are folded into POE::Kernel;
package POE::Kernel;

use strict;

# A local copy of the queue so we can manipulate it directly.
my $kr_queue;

my %event_count;
#  ( $session_id => $count,
#    ...,
#  );

my %post_count;
#  ( $session_id => $count,
#    ...,
#  );

### Begin-run initialization.

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

### End-run leak checking.

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

  $event_count{$new_id} = delete $event_count{$old_id}
    if exists $event_count{$old_id};
  $post_count{$new_id} = delete $post_count{$old_id}
    if exists $post_count{$old_id};
}

sub _data_ev_finalize {
  my $finalized_ok = 1;
  while (my ($ses_id, $cnt) = each(%event_count)) {
    $finalized_ok = 0;
    _warn("!!! Leaked event-to count: $ses_id = $cnt\n");
  }

  while (my ($ses_id, $cnt) = each(%post_count)) {
    $finalized_ok = 0;
    _warn("!!! Leaked event-from count: $ses_id = $cnt\n");
  }
  return $finalized_ok;
}

### Enqueue an event.

sub FIFO_TIME_EPSILON () { 0.000001 }
my $last_fifo_time = monotime();

sub _data_ev_enqueue {
  my (
    $self,
    $session, $source_session, $event, $type, $etc,
    $file, $line, $fromstate, $time, $delta, $priority
  ) = @_;

  my $sid = $session->ID;

  if (ASSERT_DATA) {
    unless ($self->_data_ses_exists($sid)) {
      _trap(
        "<ev> can't enqueue event ``$event'' for nonexistent",
        $self->_data_alias_loggable($sid)
      );
    }
  }

  # This is awkward, but faster than using the fields individually.
  my $event_to_enqueue = [ @_[(1+EV_SESSION) .. (1+EV_FROMSTATE)] ];
  if( defined $time ) {
    $event_to_enqueue->[EV_WALLTIME] = $time;
    $event_to_enqueue->[EV_DELTA]    = $delta;
    $priority ||= wall2mono( $time + ($delta||0) );
  }
  else {
    $priority ||= monotime();
  }

  my $new_id;
  my $old_head_priority = $kr_queue->get_next_priority();

  unless ($type & ET_MASK_DELAYED) {