view release on metacpan or  search on metacpan

lib/POE/Kernel.pm  view on Meta::CPAN

  return 0;
}

### Resolve an alias into a session.

sub alias_resolve {
  my ($self, $name) = ($poe_kernel, @_[1..$#_]);

  if (ASSERT_USAGE) {
    _confess "<us> undefined alias in alias_resolve()" unless defined $name;
  };

  return $self->_resolve_session($name);
}

### List the aliases for a given session.

sub alias_list {
  my ($self, $search_session) = ($poe_kernel, @_[1..$#_]);
  my $session =
    $self->_resolve_session($search_session || $kr_active_session);

  unless (defined $session) {
    $self->_explain_resolve_failure($search_session, "nonfatal");
    return;
  }

  # Return whatever can be found.
  my @alias_list = $self->_data_alias_list($session->ID);
  return wantarray() ? @alias_list : $alias_list[0];
}

#==============================================================================
# Kernel and Session IDs
#==============================================================================

# Return the Kernel's "unique" ID.  There's only so much uniqueness
# available; machines on separate private 10/8 networks may have
# identical kernel IDs.  The chances of a collision are vanishingly
# small.

# The Kernel and Session IDs are based on Philip Gwyn's code.  I hope
# he still can recognize it.

sub _recalc_id {
  my $self = shift;

  my $old_id = $self->[KR_ID];

  my $hostname = eval { (uname)[1] };
  $hostname = hostname() unless defined $hostname;

  my $new_id = $self->[KR_ID] = join(
    "-", $hostname,
    map { unpack "H*", $_ }
    map { pack "N", $_ }
    (monotime(), $$, ++$kr_id_seq)
  );

  if (defined $old_id) {
    $self->_data_sig_relocate_kernel_id($old_id, $new_id);
    $self->_data_ses_relocate_kernel_id($old_id, $new_id);
    $self->_data_sid_relocate_kernel_id($old_id, $new_id);
    $self->_data_handle_relocate_kernel_id($old_id, $new_id);
    $self->_data_ev_relocate_kernel_id($old_id, $new_id);
    $self->_data_alias_relocate_kernel_id($old_id, $new_id);
  }
}

sub ID { $poe_kernel->[KR_ID] }

# Resolve an ID to a session reference.  This function is virtually
# moot now that _resolve_session does it too.  This explicit call will
# be faster, though, so it's kept for things that can benefit from it.

sub ID_id_to_session {
  my ($self, $id) = ($poe_kernel, @_[1..$#_]);

  if (ASSERT_USAGE) {
    _confess "<us> undefined ID in ID_id_to_session()" unless defined $id;
  };

  my $session = $self->_data_sid_resolve($id);
  return $session if defined $session;

  $self->_explain_return("ID does not exist");
  $! = ESRCH;
  return;
}

# Resolve a session reference to its corresponding ID.

sub ID_session_to_id {
  my ($self, $session) = ($poe_kernel, @_[1..$#_]);

  if (ASSERT_USAGE) {
    _confess "<us> undefined session in ID_session_to_id()"
      unless defined $session;
  };

  my $id = $self->_data_ses_resolve_to_id($session);
  if (defined $id) {
    $! = 0;
    return $id;
  }

  $self->_explain_return("session ($session) does not exist");
  $! = ESRCH;
  return;
}

#==============================================================================
# Extra reference counts, to keep sessions alive when things occur.
# They take session IDs because they may be called from resources at
# times where the session reference is otherwise unknown.
#==============================================================================

sub refcount_increment {
  my ($self, $session_id, $tag) = ($poe_kernel, @_[1..$#_]);

  if (ASSERT_USAGE) {
    _confess "<us> undefined session ID in refcount_increment()"
      unless defined $session_id;
    _confess "<us> undefined reference count tag in refcount_increment()"
      unless defined $tag;
  };