Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Split out the "resource" functions from POE::Kernel. The major data

structures within POE::Kernel have been broken into subsystems and
moved, along with their accessors, into POE::Resource::*.pm files.
Each handles the lowest-level data management functions for its
resource type.  This is a step towards implementing XS versions of
some of POE's hottest code, which will go a long way towards speeding
things up in the future.
  • Loading branch information...
commit fbf359b1cf77b5a883e7a3c9117eae8dd060b599 1 parent 0d6b296
@rcaputo authored
View
7 MANIFEST
@@ -35,6 +35,13 @@ POE/Pipe/TwoWay.pm
POE/Preprocessor.pm
POE/Queue.pm
POE/Queue/Array.pm
+POE/Resource/Aliases.pm
+POE/Resource/Events.pm
+POE/Resource/Extrefs.pm
+POE/Resource/FileHandles.pm
+POE/Resource/Sessions.pm
+POE/Resource/SIDs.pm
+POE/Resource/Signals.pm
POE/Session.pm
POE/Wheel.pm
POE/Wheel/Curses.pm
View
1,797 lib/POE/Kernel.pm
@@ -287,1787 +287,17 @@ BEGIN {
}
###############################################################################
-# Accessors: Tagged extra reference counts accessors.
+# Include resource modules here. Later, when we have the option of XS
+# versions, we'll adapt this to include them if they're available.
###############################################################################
-{ # This section becomes POE::Resource::Extref
-
-### The count of all extra references used in the system.
-
-my %kr_extra_refs;
-# ( $session =>
-# { $tag => $count,
-# ...,
-# },
-# ...,
-# );
-
-### End-run leak checking.
-
-sub _data_extref_finalize {
- foreach my $session (keys %kr_extra_refs) {
- warn "!!! Leaked extref: $session\n";
- foreach my $tag (keys %{$kr_extra_refs{$session}}) {
- warn "!!!\t`$tag' = $kr_extra_refs{$session}->{$tag}\n";
- }
- }
-}
-
-### Increment a session's tagged reference count. If this is the
-### first time the tag is used in the session, then increment the
-### session's reference count as well. Returns the tag's new
-### reference count.
-
-sub _data_extref_inc {
- my ($self, $session, $tag) = @_;
- my $refcount = ++$kr_extra_refs{$session}->{$tag};
- $self->_data_ses_refcount_inc($session) if $refcount == 1;
-
- if (TRACE_REFCNT) {
- warn( "<rc> incremented extref ``$tag'' (now $refcount) for ",
- $self->_data_alias_loggable($session)
- );
- }
-
- return $refcount;
-}
-
-### Decrement a session's tagged reference count, removing it outright
-### if the count reaches zero. Return the new reference count or
-### undef if the tag doesn't exist.
-
-sub _data_extref_dec {
- my ($self, $session, $tag) = @_;
-
- if (ASSERT_DATA) {
- unless (exists $kr_extra_refs{$session}->{$tag}) {
- confess( "<dt> decrementing extref for nonexistent tag ``$tag'' in ",
- $self->_data_alias_loggable($session)
- );
- }
- }
-
- my $refcount = --$kr_extra_refs{$session}->{$tag};
-
- if (TRACE_REFCNT) {
- warn( "<rc> decremented extref ``$tag'' (now $refcount) for ",
- $self->_data_alias_loggable($session)
- );
- }
-
- $self->_data_extref_remove($session, $tag) unless $refcount;
- return $refcount;
-}
-
-### Remove an extra reference from a session, regardless of its count.
-
-sub _data_extref_remove {
- my ($self, $session, $tag) = @_;
-
- if (ASSERT_DATA) {
- unless (exists $kr_extra_refs{$session}->{$tag}) {
- confess( "<dt> decrementing extref for nonexistent tag ``$tag'' in ",
- $self->_data_alias_loggable($session)
- );
- }
- }
-
- delete $kr_extra_refs{$session}->{$tag};
- $self->_data_ses_refcount_dec($session);
- unless (keys %{$kr_extra_refs{$session}}) {
- delete $kr_extra_refs{$session};
- }
-}
-
-### Clear all the extra references from a session.
-
-sub _data_extref_clear_session {
- my ($self, $session) = @_;
- return unless exists $kr_extra_refs{$session}; # avoid autoviv
- foreach (keys %{$kr_extra_refs{$session}}) {
- $self->_data_extref_remove($session, $_);
- }
-
- if (ASSERT_DATA) {
- if (exists $kr_extra_refs{$session}) {
- confess( "<dt> extref clear did not remove session ",
- $self->_data_alias_loggable($session)
- );
- }
- }
-}
-
-### Fetch the number of extra references held in the entire system.
-
-sub _data_extref_count {
- return scalar keys %kr_extra_refs;
-}
-
-### Fetch the number of extra references held by a session.
-
-sub _data_extref_count_ses {
- my ($self, $session) = @_;
- return exists $kr_extra_refs{$session};
-}
-
-} # Close scope.
-
-###############################################################################
-# Accessors: Session IDs.
-###############################################################################
-
-{ # This section becomes POE::Resource::Sid
-
-### Map session IDs to sessions. Map sessions to session IDs.
-### Maintain a sequence number for determining the next session ID.
-
-my %kr_session_ids;
-# ( $session_id => $session_reference,
-# ...,
-# );
-
-my %kr_session_to_id;
-# ( $session_ref => $session_id,
-# ...,
-# );
-
-my $kr_sid_seq = 1;
-
-### End-run leak checking.
-
-sub _data_sid_finalize {
- # Don't bother if run() was never called.
- return unless $kr_run_warning & KR_RUN_CALLED;
-
- while (my ($sid, $ses) = each(%kr_session_ids)) {
- warn "!!! Leaked session ID: $sid = $ses\n";
- }
- while (my ($ses, $sid) = each(%kr_session_to_id)) {
- warn "!!! Leak sid cross-reference: $ses = $sid\n";
- }
-}
-
-### Allocate a new session ID.
-
-sub _data_sid_allocate {
- my $self = shift;
- 1 while exists $kr_session_ids{++$kr_sid_seq};
- return $kr_sid_seq;
-}
-
-### Set a session ID.
-
-sub _data_sid_set {
- my ($self, $sid, $session) = @_;
- $kr_session_ids{$sid} = $session;
- $kr_session_to_id{$session} = $sid;
-}
-
-### Clear a session ID.
-
-sub _data_sid_clear {
- my ($self, $session) = @_;
- my $sid = delete $kr_session_to_id{$session};
- confess "internal inconsistency" unless defined $sid;
- delete $kr_session_ids{$sid};
-}
-
-### Resolve a session ID into its session.
-
-sub _data_sid_resolve {
- my ($self, $sid) = @_;
- return $kr_session_ids{$sid};
-}
-
-} # Close scope.
-
-###############################################################################
-# Accessors: Signals.
-###############################################################################
-
-{ # This section becomes POE::Resource::Signal
-
-### Map watched signal names to the sessions that are watching them
-### and the events that must be delivered when they occur.
-
-my %kr_signals;
-# ( $signal_name =>
-# { $session_reference => $event_name,
-# ...,
-# },
-# ...,
-# );
-
-my %kr_sessions_to_signals;
-# ( $session =>
-# { $signal_name => $event_name,
-# ...,
-# },
-# ...,
-# );
-
-# Bookkeeping per dispatched signal.
-
-my @kr_signaled_sessions; # The sessions touched by a signal.
-my $kr_signal_total_handled; # How many sessions handled a signal.
-my $kr_signal_handled_implicitly; # Whether it was handled implicitly.
-my $kr_signal_handled_explicitly; # Whether it was handled explicitly.
-my $kr_signal_type; # The type of signal being dispatched.
-
-# A list of special signal types. Signals that aren't listed here are
-# benign (they do not kill sessions at all). "Terminal" signals are
-# the ones that UNIX defaults to killing processes with. Thus STOP is
-# not terminal.
-
-sub SIGTYPE_BENIGN () { 0x00 }
-sub SIGTYPE_TERMINAL () { 0x01 }
-sub SIGTYPE_NONMASKABLE () { 0x02 }
-
-my %_signal_types =
- ( QUIT => SIGTYPE_TERMINAL,
- INT => SIGTYPE_TERMINAL,
- KILL => SIGTYPE_TERMINAL,
- TERM => SIGTYPE_TERMINAL,
- HUP => SIGTYPE_TERMINAL,
- IDLE => SIGTYPE_TERMINAL,
- ZOMBIE => SIGTYPE_NONMASKABLE,
- UIDESTROY => SIGTYPE_NONMASKABLE,
- );
-
-# Build a list of useful, real signals. Nonexistent signals, and ones
-# which are globally unhandled, usually cause segmentation faults if
-# perl was poorly configured. Some signals aren't available in some
-# environments.
-
-my @_safe_signals;
-
-sub _data_sig_initialize {
- my $self = shift;
-
- # In case we're called multiple times.
- unless (@_safe_signals) {
- foreach my $signal (keys %SIG) {
-
- # Nonexistent signals, and ones which are globally unhandled.
- next if ($signal =~ /^( NUM\d+
- |__[A-Z0-9]+__
- |ALL|CATCHALL|DEFER|HOLD|IGNORE|MAX|PAUSE
- |RTMIN|RTMAX|SETS
- |SEGV
- |
- )$/x
- );
-
- # Windows doesn't have a SIGBUS, but the debugger causes SIGBUS
- # to be entered into %SIG. It's fatal to register its handler.
- next if $signal eq 'BUS' and RUNNING_IN_HELL;
-
- # Apache uses SIGCHLD and/or SIGCLD itself, so we can't.
- next if $signal =~ /^CH?LD$/ and exists $INC{'Apache.pm'};
-
- push @_safe_signals, $signal;
- }
- }
-
- # Regsiter handlers for all safe signals.
- foreach (@_safe_signals) {
- $self->loop_watch_signal($_);
- }
-}
-
-### Return signals that are safe to manipulate.
-
-sub _data_sig_get_safe_signals {
- return @_safe_signals;
-}
-
-### End-run leak checking.
-
-sub _data_sig_finalize {
- while (my ($sig, $sig_rec) = each(%kr_signals)) {
- warn "!!! Leaked signal $sig\n";
- while (my ($ses, $event) = each(%{$kr_signals{$sig}})) {
- warn "!!!\t$ses = $event\n";
- }
- }
-
- while (my ($ses, $sig_rec) = each(%kr_sessions_to_signals)) {
- warn "!!! Leaked signal cross-reference: $ses\n";
- while (my ($sig, $event) = each(%{$kr_signals{$ses}})) {
- warn "!!!\t$sig = $event\n";
- }
- }
-}
-
-### Add a signal to a session.
-
-sub _data_sig_add {
- my ($self, $session, $signal, $event) = @_;
- $kr_sessions_to_signals{$session}->{$signal} = $event;
- $kr_signals{$signal}->{$session} = $event;
-}
-
-### Remove a signal from a session.
-
-sub _data_sig_remove {
- my ($self, $session, $signal) = @_;
-
- delete $kr_sessions_to_signals{$session}->{$signal};
- delete $kr_sessions_to_signals{$session}
- unless keys(%{$kr_sessions_to_signals{$session}});
-
- delete $kr_signals{$signal}->{$session};
- delete $kr_signals{$signal} unless keys %{$kr_signals{$signal}};
-}
-
-### Clear all the signals from a session.
-
-sub _data_sig_clear_session {
- my ($self, $session) = @_;
- return unless exists $kr_sessions_to_signals{$session}; # avoid autoviv
- foreach (keys %{$kr_sessions_to_signals{$session}}) {
- $self->_data_sig_remove($session, $_);
- }
-}
-
-### Return a signal's type, or SIGTYPE_BENIGN if it's not special.
-
-sub _data_sig_type {
- my ($self, $signal) = @_;
- return $_signal_types{$signal} || SIGTYPE_BENIGN;
-}
-
-### Flag a signal as being handled by some session.
-
-sub _data_sig_handled {
- my $self = shift;
- $kr_signal_total_handled = 1;
- $kr_signal_handled_explicitly = 1;
-}
-
-### Clear the structures associated with a signal's "handled" status.
-
-sub _data_sig_reset_handled {
- my ($self, $signal) = @_;
- undef $kr_signal_total_handled;
- $kr_signal_type = $self->_data_sig_type($signal);
- undef @kr_signaled_sessions;
-}
-
-### Is the signal explicitly watched?
-
-sub _data_sig_explicitly_watched {
- my ($self, $signal) = @_;
- return exists $kr_signals{$signal};
-}
-
-### Which sessions are watching a signal?
-
-sub _data_sig_watchers {
- my ($self, $signal) = @_;
- return each %{$kr_signals{$signal}};
-}
-
-### Determine if a given session is watching a signal. This uses a
-### two-step exists so that the longer one does not autovivify keys in
-### the shorter one.
-
-sub _data_sig_watched_by_session {
- my ($self, $signal, $session) = @_;
- return( exists($kr_signals{$signal}) &&
- exists($kr_signals{$signal}->{$session})
- )
-}
-
-### Clear the flags that determine if/how a session handled a signal.
-
-sub _data_sig_clear_handled_flags {
- undef $kr_signal_handled_implicitly;
- undef $kr_signal_handled_explicitly;
-}
-
-### Destroy sessions touched by a nonmaskable signal or by an
-### unhandled terminal signal. Check for garbage-collection on
-### sessions which aren't to be terminated.
-
-sub _data_sig_free_terminated_sessions {
- my $self = shift;
-
- if ( ($kr_signal_type & SIGTYPE_NONMASKABLE) or
- ( $kr_signal_type & SIGTYPE_TERMINAL and !$kr_signal_total_handled )
- ) {
- foreach my $dead_session (@kr_signaled_sessions) {
- next unless $self->_data_ses_exists($dead_session);
-
- if (TRACE_SIGNALS) {
- warn( "<sg> stopping signaled session ",
- $self->_data_alias_loggable($dead_session)
- );
- }
-
- $self->_data_ses_stop($dead_session);
- }
- }
- else {
- foreach my $touched_session (@kr_signaled_sessions) {
- next unless $self->_data_ses_exists($touched_session);
- $self->_data_ses_collect_garbage($touched_session);
- }
- }
-
- # Erase @kr_signaled_sessions, or they will leak until the next
- # signal.
- undef @kr_signaled_sessions;
-}
-
-### A signal has touched a session. Record this fact for later
-### destruction tests.
-
-sub _data_sig_touched_session {
- my ($self, $session, $event, $handler_retval, $signal) = @_;
-
- push @kr_signaled_sessions, $session;
- $kr_signal_total_handled += !!$handler_retval;
- $kr_signal_handled_implicitly += !!$handler_retval;
-
- unless ($kr_signal_handled_explicitly) {
- if ($kr_signal_handled_implicitly) {
- warn( ",----- DEPRECATION WARNING -----\n",
- "| Session ", $self->_data_alias_loggable($session), ":\n",
- "| handled SIG$signal by returning a true value.\n",
- "| Please use sig_handled() if this was intentional.\n",
- "| If this warning is generated by an external component,\n",
- "| please upgrade it.\n",
- "`-------------------------------\n",
- );
- }
- }
-}
-
-} # Close scope.
-
-###############################################################################
-# Accessors: Aliases.
-###############################################################################
-
-{ # This section becomes POE::Resource::Alias
-
-### The table of session aliases, and the sessions they refer to.
-
-my %kr_aliases;
-# ( $alias => $session_ref,
-# ...,
-# );
-
-my %kr_ses_to_alias;
-# ( $session_ref =>
-# { $alias => $placeholder_value,
-# ...,
-# },
-# ...,
-# );
-
-### End-run leak checking.
-
-sub _data_alias_finalize {
- while (my ($alias, $ses) = each(%kr_aliases)) {
- warn "!!! Leaked alias: $alias = $ses\n";
- }
- while (my ($ses, $alias_rec) = each(%kr_ses_to_alias)) {
- my @aliases = keys(%$alias_rec);
- warn "!!! Leaked alias cross-reference: $ses (@aliases)\n";
- }
-}
-
-### Add an alias to a session.
-
-sub _data_alias_add {
- my ($self, $session, $alias) = @_;
- $self->_data_ses_refcount_inc($session);
- $kr_aliases{$alias} = $session;
- $kr_ses_to_alias{$session}->{$alias} = 1;
-}
-
-### Remove an alias from a session.
-
-sub _data_alias_remove {
- my ($self, $session, $alias) = @_;
- delete $kr_aliases{$alias};
- delete $kr_ses_to_alias{$session}->{$alias};
- unless (keys %{$kr_ses_to_alias{$session}}) {
- delete $kr_ses_to_alias{$session};
- }
- $self->_data_ses_refcount_dec($session);
-}
-
-### Clear all the aliases from a session.
-
-sub _data_alias_clear_session {
- my ($self, $session) = @_;
- return unless exists $kr_ses_to_alias{$session}; # avoid autoviv
- foreach (keys %{$kr_ses_to_alias{$session}}) {
- $self->_data_alias_remove($session, $_);
- }
-}
-
-### Resolve an alias. Just an alias.
-
-sub _data_alias_resolve {
- my ($self, $alias) = @_;
- return undef unless exists $kr_aliases{$alias};
- return $kr_aliases{$alias};
-}
-
-### Return a list of aliases for a session.
-
-sub _data_alias_list {
- my ($self, $session) = @_;
- return () unless exists $kr_ses_to_alias{$session};
- return sort keys %{$kr_ses_to_alias{$session}};
-}
-
-### Return the number of aliases for a session.
-
-sub _data_alias_count_ses {
- my ($self, $session) = @_;
- return 0 unless exists $kr_ses_to_alias{$session};
- return scalar keys %{$kr_ses_to_alias{$session}};
-}
-
-### Return a session's ID in a form suitable for logging.
-
-sub _data_alias_loggable {
- my ($self, $session) = @_;
- confess "internal inconsistency" unless ref($session);
- "session " . $session->ID . " (" .
- ( (exists $kr_ses_to_alias{$session})
- ? join(", ", keys(%{$kr_ses_to_alias{$session}}))
- : $session
- ) . ")"
-}
-
-} # Close scope.
-
-###############################################################################
-# Accessors: File descriptor tables.
-###############################################################################
-
-{ # This section becomes POE::Resource::Handle
-
-### Fileno structure. This tracks the sessions that are watchin 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;
-
-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_ST_REQUEST () { 2 } # $actual_file_state (see HS_PAUSED)
-sub FMO_EV_COUNT () { 3 } # $number_of_pending_events,
-sub FMO_SESSIONS () { 4 } # { $session_watching_this_handle =>
-# --- BEGIN SUB STRUCT 2 --- #
-sub HSS_HANDLE () { 0 } # [ $blessed_handle,
-sub HSS_SESSION () { 1 } # $blessed_session,
-sub HSS_STATE () { 2 } # $event_name,
- # ],
-# --- 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 and FMO_ST_REQUEST.
-
-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;
-
- # { $file_handle =>
-# --- 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 --- # ],
- # ],
- # ...
- # },
-
-### End-run leak checking.
-
-sub _data_handle_finalize {
- while (my ($fd, $fd_rec) = each(%kr_filenos)) {
- my ($rd, $wr, $ex, $tot) = @$fd_rec;
- warn "!!! Leaked fileno: $fd (total refcnt=$tot)\n";
-
- warn( "!!!\tRead:\n",
- "!!!\t\trefcnt = $rd->[FMO_REFCOUNT]\n",
- "!!!\t\tev cnt = $rd->[FMO_EV_COUNT]\n",
- );
- while (my ($ses, $ses_rec) = each(%{$rd->[FMO_SESSIONS]})) {
- warn( "!!!\t\tsession = $ses\n",
- "!!!\t\t\thandle = $ses_rec->[HSS_HANDLE]\n",
- "!!!\t\t\tsession = $ses_rec->[HSS_SESSION]\n",
- "!!!\t\t\tevent = $ses_rec->[HSS_STATE]\n",
- );
- }
-
- warn( "!!!\tWrite:\n",
- "!!!\t\trefcnt = $wr->[FMO_REFCOUNT]\n",
- "!!!\t\tev cnt = $wr->[FMO_EV_COUNT]\n",
- );
- while (my ($ses, $ses_rec) = each(%{$wr->[FMO_SESSIONS]})) {
- warn( "!!!\t\tsession = $ses\n",
- "!!!\t\t\thandle = $ses_rec->[HSS_HANDLE]\n",
- "!!!\t\t\tsession = $ses_rec->[HSS_SESSION]\n",
- "!!!\t\t\tevent = $ses_rec->[HSS_STATE]\n",
- );
- }
-
- warn( "!!!\tException:\n",
- "!!!\t\trefcnt = $ex->[FMO_REFCOUNT]\n",
- "!!!\t\tev cnt = $ex->[FMO_EV_COUNT]\n",
- );
- while (my ($ses, $ses_rec) = each(%{$ex->[FMO_SESSIONS]})) {
- warn( "!!!\t\tsession = $ses\n",
- "!!!\t\t\thandle = $ses_rec->[HSS_HANDLE]\n",
- "!!!\t\t\tsession = $ses_rec->[HSS_SESSION]\n",
- "!!!\t\t\tevent = $ses_rec->[HSS_STATE]\n",
- );
- }
- }
-
- while (my ($ses, $hnd_rec) = each(%kr_ses_to_handle)) {
- warn "!!! Leaked handle in $ses\n";
- while (my ($hnd, $rc) = each(%$hnd_rec)) {
- warn( "!!!\tHandle: $hnd (tot refcnt=$rc->[SH_REFCOUNT])\n",
- "!!!\t\tRead refcnt: $rc->[SH_MODECOUNT]->[MODE_RD]\n",
- "!!!\t\tWrite refcnt: $rc->[SH_MODECOUNT]->[MODE_WR]\n",
- "!!!\t\tException refcnt: $rc->[SH_MODECOUNT]->[MODE_EX]\n",
- );
- }
- }
-}
-
-### Ensure a handle's actual state matches its requested one. Pause
-### or resume the handle as necessary.
-
-sub _data_handle_resume_requested_state {
- my ($self, $handle, $mode) = @_;
- my $fileno = fileno($handle);
-
- # Skip the rest if we aren't watching the file descriptor. This
- # seems like a kludge: should we even be called if the descriptor
- # isn't watched?
- return unless exists $kr_filenos{$fileno};
-
- my $kr_fno_rec = $kr_filenos{$fileno}->[$mode];
-
- if (TRACE_FILES) {
- warn( "<fh> decrementing event count in mode ($mode) ",
- "for fileno (", $fileno, ") from count (",
- $kr_fno_rec->[FMO_EV_COUNT], ")"
- );
- }
-
- # If all events for the fileno/mode pair have been delivered, then
- # resume the filehandle's watcher. This decrements FMO_EV_COUNT
- # because the event has just been dispatched. This makes sense.
-
- unless (--$kr_fno_rec->[FMO_EV_COUNT]) {
- if ($kr_fno_rec->[FMO_ST_REQUEST] & HS_PAUSED) {
- $self->loop_pause_filehandle($handle, $mode);
- $kr_fno_rec->[FMO_ST_ACTUAL] = HS_PAUSED;
- }
- elsif ($kr_fno_rec->[FMO_ST_REQUEST] & HS_RUNNING) {
- $self->loop_resume_filehandle($handle, $mode);
- $kr_fno_rec->[FMO_ST_ACTUAL] = HS_RUNNING;
- }
- else {
- confess "internal consistency error";
- }
- }
- elsif ($kr_fno_rec->[FMO_EV_COUNT] < 0) {
- confess "handle event count went below zero";
- }
-}
-
-### Enqueue "select" events for a list of file descriptors in a given
-### access mode.
-
-sub _data_handle_enqueue_ready {
- my ($self, $mode, @filenos) = @_;
-
- foreach my $fileno (@filenos) {
- confess "internal inconsistency: undefined fileno" unless defined $fileno;
- my $kr_fno_rec = $kr_filenos{$fileno}->[$mode];
-
- # Gather all the events to emit for this fileno/mode pair.
-
- my @selects = map { values %$_ } values %{ $kr_fno_rec->[FMO_SESSIONS] };
-
- # Emit them.
-
- foreach my $select (@selects) {
- $self->_data_ev_enqueue
- ( $select->[HSS_SESSION], $select->[HSS_SESSION],
- $select->[HSS_STATE], ET_SELECT,
- [ $select->[HSS_HANDLE], # EA_SEL_HANDLE
- $mode, # EA_SEL_MODE
- ],
- __FILE__, __LINE__, time(),
- );
-
- # Count the enqueued event. This increments FMO_EV_COUNT
- # because an event has just been enqueued. This makes sense.
-
- unless ($kr_fno_rec->[FMO_EV_COUNT]++) {
- my $handle = $select->[HSS_HANDLE];
- $self->loop_pause_filehandle($handle, $mode);
- $kr_fno_rec->[FMO_ST_ACTUAL] = HS_PAUSED;
- }
-
- if (TRACE_FILES) {
- warn( "<fh> incremented event count in mode ($mode) ",
- "for fileno ($fileno) to count ($kr_fno_rec->[FMO_EV_COUNT])"
- );
- }
- }
- }
-}
-
-### Test whether POE is tracking a file handle.
-
-sub _data_handle_is_good {
- my ($self, $handle, $mode) = @_;
-
- # Don't bother if the kernel isn't tracking the file.
- return 0 unless exists $kr_filenos{fileno $handle};
-
- # Don't bother if the kernel isn't tracking the file mode.
- return 0 unless $kr_filenos{fileno $handle}->[$mode]->[FMO_REFCOUNT];
-
- return 1;
-}
-
-### Add a select to the session, and possibly begin a watcher.
-
-sub _data_handle_add {
- my ($self, $handle, $mode, $session, $event) = @_;
- my $fd = fileno($handle);
-
- unless (exists $kr_filenos{$fd}) {
-
- $kr_filenos{$fd} =
- [ [ 0, # FMO_REFCOUNT MODE_RD
- HS_PAUSED, # FMO_ST_ACTUAL
- HS_PAUSED, # FMO_ST_REQUEST
- 0, # FMO_EV_COUNT
- { }, # FMO_SESSIONS
- ],
- [ 0, # FMO_REFCOUNT MODE_WR
- HS_PAUSED, # FMO_ST_ACTUAL
- HS_PAUSED, # FMO_ST_REQUEST
- 0, # FMO_EV_COUNT
- { }, # FMO_SESSIONS
- ],
- [ 0, # FMO_REFCOUNT MODE_EX
- HS_PAUSED, # FMO_ST_ACTUAL
- HS_PAUSED, # FMO_ST_REQUEST
- 0, # FMO_EV_COUNT
- { }, # FMO_SESSIONS
- ],
- 0, # FNO_TOT_REFCOUNT
- ];
-
- if (TRACE_FILES) {
- warn "<fh> adding fd (", $fd, ")";
- }
-
- # For DOSISH systems like OS/2. Wrapped in eval{} in case it's a
- # tied handle that doesn't support binmode.
- eval { binmode *$handle };
-
- # Turn off blocking unless it's tied or a plain file.
- unless (tied *$handle or -f $handle) {
-
- # RCC 2002-12-19: ActiveState Perl 5.8.0 disliked the Win32 code
- # to make a socket non-blocking, so we're trying IO::Handle's
- # blocking(0) method. Bonus: It does "the right thing" just
- # about everywhere, so I don't need to add checks for AS Perl
- # 5.8.0, AS Perl 5.6.1, and Everybody else.
-
- # RCC 2003-01-20: Perl 5.005_03 doesn't like blocking(), so
- # we'll only call it in Perl 5.8.0 and beyond.
-
- if ($] >= 5.008) {
- $handle->blocking(0);
- }
- else {
- # Make the handle stop blocking, the POSIX way.
- unless (RUNNING_IN_HELL) {
- my $flags = fcntl($handle, F_GETFL, 0)
- or confess "fcntl($handle, F_GETFL, etc.) fails: $!\n";
- until (fcntl($handle, F_SETFL, $flags | O_NONBLOCK)) {
- confess "fcntl($handle, FSETFL, etc) fails: $!"
- unless $! == EAGAIN or $! == EWOULDBLOCK;
- }
- }
- else {
- # Do it the Win32 way.
- my $set_it = "1";
-
- # 126 is FIONBIO (some docs say 0x7F << 16)
- ioctl( $handle,
- 0x80000000 | (4 << 16) | (ord('f') << 8) | 126,
- $set_it
- )
- or confess "ioctl($handle, FIONBIO, $set_it) fails: $!\n";
- }
- }
- }
-
- # Turn off buffering.
- select((select($handle), $| = 1)[0]);
- }
-
- # Cache some high-level lookups.
- my $kr_fileno = $kr_filenos{$fd};
- my $kr_fno_rec = $kr_fileno->[$mode];
-
- # The session is already watching this fileno in this mode.
-
- if ($kr_fno_rec->[FMO_SESSIONS]->{$session}) {
-
- # The session is also watching it by the same handle. Treat this
- # as a "resume" in this mode.
-
- if (exists $kr_fno_rec->[FMO_SESSIONS]->{$session}->{$handle}) {
- if (TRACE_FILES) {
- warn( "<fh> running fileno(" . $fd . ") mode($mode) " .
- "count($kr_fno_rec->[FMO_EV_COUNT])"
- );
- }
- unless ($kr_fno_rec->[FMO_EV_COUNT]) {
- $self->loop_resume_filehandle($handle, $mode);
- $kr_fno_rec->[FMO_ST_ACTUAL] = HS_RUNNING;
- }
- $kr_fno_rec->[FMO_ST_REQUEST] = HS_RUNNING;
- }
-
- # The session is watching it by a different handle. It can't be
- # done yet, but maybe later when drivers are added to the mix.
-
- else {
- confess "can't watch the same handle in the same mode 2+ times yet";
- }
- }
-
- # The session is not watching this fileno in this mode. Record
- # the session/handle pair.
-
- else {
- $kr_fno_rec->[FMO_SESSIONS]->{$session}->{$handle} =
- [ $handle, # HSS_HANDLE
- $session, # HSS_SESSION
- $event, # HSS_STATE
- ];
-
- # Fix reference counts.
- $kr_fileno->[FNO_TOT_REFCOUNT]++;
- $kr_fno_rec->[FMO_REFCOUNT]++;
-
- # If this is the first time a file is watched in this mode, then
- # have the event loop bridge watch it.
-
- if ($kr_fno_rec->[FMO_REFCOUNT] == 1) {
- $self->loop_watch_filehandle($handle, $mode);
- $kr_fno_rec->[FMO_ST_ACTUAL] = HS_RUNNING;
- $kr_fno_rec->[FMO_ST_REQUEST] = HS_RUNNING;
- }
- }
-
- # If the session hasn't already been watching the filehandle, then
- # register the filehandle in the session's structure.
-
- unless (exists $kr_ses_to_handle{$session}->{$handle}) {
- $kr_ses_to_handle{$session}->{$handle} =
- [ $handle, # SH_HANDLE
- 0, # SH_REFCOUNT
- [ 0, # SH_MODECOUNT / MODE_RD
- 0, # SH_MODECOUNT / MODE_WR
- 0 # SH_MODECOUNT / MODE_EX
- ]
- ];
- $self->_data_ses_refcount_inc($session);
- }
-
- # Modify the session's handle structure's reference counts, so the
- # session knows it has a reason to live.
-
- my $ss_handle = $kr_ses_to_handle{$session}->{$handle};
- unless ($ss_handle->[SH_MODECOUNT]->[$mode]) {
- $ss_handle->[SH_MODECOUNT]->[$mode]++;
- $ss_handle->[SH_REFCOUNT]++;
- }
-}
-
-### Remove a select from the kernel, and possibly trigger the
-### session's destruction.
-
-sub _data_handle_remove {
- my ($self, $handle, $mode, $session) = @_;
- my $fd = fileno($handle);
-
- # Make sure the handle is deregistered with the kernel.
-
- if (exists $kr_filenos{$fd}) {
- my $kr_fileno = $kr_filenos{$fd};
- my $kr_fno_rec = $kr_fileno->[$mode];
-
- # Make sure the handle was registered to the requested session.
-
- if ( exists($kr_fno_rec->[FMO_SESSIONS]->{$session}) and
- exists($kr_fno_rec->[FMO_SESSIONS]->{$session}->{$handle})
- ) {
-
- # Remove the handle from the kernel's session record.
-
- my $handle_rec =
- delete $kr_fno_rec->[FMO_SESSIONS]->{$session}->{$handle};
-
- my $kill_session = $handle_rec->[HSS_SESSION];
- my $kill_event = $handle_rec->[HSS_STATE];
-
- # Remove any events destined for that handle. Decrement
- # FMO_EV_COUNT for each, because we've removed them. This makes
- # sense.
- my $my_select = sub {
- return 0 unless $_[0]->[EV_TYPE] & ET_SELECT;
- return 0 unless $_[0]->[EV_SESSION] == $kill_session;
- return 0 unless $_[0]->[EV_NAME] eq $kill_event;
- return 0 unless $_[0]->[EV_ARGS]->[EA_SEL_HANDLE] == $handle;
- return 0 unless $_[0]->[EV_ARGS]->[EA_SEL_MODE] == $mode;
- return 1;
- };
-
- foreach ($kr_queue->remove_items($my_select)) {
- my ($time, $id, $event) = @$_;
- $self->_data_ev_refcount_dec( @$event[EV_SESSION, EV_SOURCE] );
-
- TRACE_EVENTS and
- warn "<ev> removing select event $id ``$event->[EV_NAME]''";
-
- $kr_fno_rec->[FMO_EV_COUNT]--;
-
- if (TRACE_FILES) {
- warn( "<fh> fileno $fd mode $mode event count went to ",
- $kr_fno_rec->[FMO_EV_COUNT]
- );
- }
-
- if (ASSERT_DATA) {
- confess "<dt> fileno $fd mode $mode event count went below zero"
- if $kr_fno_rec->[FMO_EV_COUNT] < 0;
- }
- }
-
- # Decrement the handle's reference count.
-
- $kr_fno_rec->[FMO_REFCOUNT]--;
-
- if (ASSERT_DATA) {
- confess "<dt> fileno mode refcount went below zero"
- if $kr_fno_rec->[FMO_REFCOUNT] < 0;
- }
-
- # If the "mode" count drops to zero, then stop selecting the
- # handle.
-
- unless ($kr_fno_rec->[FMO_REFCOUNT]) {
- $self->loop_ignore_filehandle($handle, $mode);
- $kr_fno_rec->[FMO_ST_ACTUAL] = HS_STOPPED;
- $kr_fno_rec->[FMO_ST_REQUEST] = HS_STOPPED;
-
- # The session is not watching handles anymore. Remove the
- # session entirely the fileno structure.
- delete $kr_fno_rec->[FMO_SESSIONS]->{$session}
- unless keys %{$kr_fno_rec->[FMO_SESSIONS]->{$session}};
- }
-
- # Decrement the kernel record's handle reference count. If the
- # handle is done being used, then delete it from the kernel's
- # record structure. This initiates Perl's garbage collection on
- # it, as soon as whatever else in "user space" frees it.
-
- $kr_fileno->[FNO_TOT_REFCOUNT]--;
-
- if (ASSERT_DATA) {
- confess "<dt> fileno refcount went below zero"
- if $kr_fileno->[FNO_TOT_REFCOUNT] < 0;
- }
-
- unless ($kr_fileno->[FNO_TOT_REFCOUNT]) {
- if (TRACE_FILES) {
- warn "<fh> deleting fileno (", $fd, ")";
- }
- delete $kr_filenos{$fd};
- }
- }
- }
-
- # SS_HANDLES - Remove the select from the session, assuming there is
- # a session to remove it from. -><- Key it on fileno?
-
- if ( exists($kr_ses_to_handle{$session}) and
- exists($kr_ses_to_handle{$session}->{$handle})
- ) {
-
- # Remove it from the session's read, write or expedite mode.
-
- my $ss_handle = $kr_ses_to_handle{$session}->{$handle};
- if ($ss_handle->[SH_MODECOUNT]->[$mode]) {
-
- # Hmm... what is this? Was POE going to support multiple selects?
-
- $ss_handle->[SH_MODECOUNT]->[$mode] = 0;
-
- # Decrement the reference count, and delete the handle if it's done.
-
- $ss_handle->[SH_REFCOUNT]--;
-
- if (ASSERT_DATA) {
- confess "<dt> refcount went below zero"
- if $ss_handle->[SH_REFCOUNT] < 0;
- }
-
- unless ($ss_handle->[SH_REFCOUNT]) {
- delete $kr_ses_to_handle{$session}->{$handle};
- $self->_data_ses_refcount_dec($session);
- delete $kr_ses_to_handle{$session}
- unless keys %{$kr_ses_to_handle{$session}};
- }
- }
- }
-}
-
-### Resume a filehandle. If there are no events in the queue for this
-### handle/mode pair, then we go ahead and set the actual state now.
-### Otherwise it must wait until the queue empties.
-
-sub _data_handle_resume {
- my ($self, $handle, $mode) = @_;
-
- my $kr_fileno = $kr_filenos{fileno($handle)};
- my $kr_fno_rec = $kr_fileno->[$mode];
-
- if (TRACE_FILES) {
- warn( "<fh> resume test: fileno(" . fileno($handle) . ") mode($mode) " .
- "count($kr_fno_rec->[FMO_EV_COUNT])"
- );
- }
-
- # Resume the handle if there are no events for it.
- unless ($kr_fno_rec->[FMO_EV_COUNT]) {
- $self->loop_resume_filehandle($handle, $mode);
- $kr_fno_rec->[FMO_ST_ACTUAL] = HS_RUNNING;
- }
-
- # Either way we set the handle's requested state to "running".
- $kr_fno_rec->[FMO_ST_REQUEST] = HS_RUNNING;
-}
-
-### Pause a filehandle. If there are no events in the queue for this
-### handle/mode pair, then we go ahead and set the actual state now.
-### Otherwise it must wait until the queue empties.
-
-sub _data_handle_pause {
- my ($self, $handle, $mode) = @_;
-
- my $kr_fileno = $kr_filenos{fileno($handle)};
- my $kr_fno_rec = $kr_fileno->[$mode];
-
- if (TRACE_FILES) {
- warn( "<fh> pause test: fileno(" . fileno($handle) . ") mode($mode) " .
- "count($kr_fno_rec->[FMO_EV_COUNT])"
- );
- }
-
- unless ($kr_fno_rec->[FMO_EV_COUNT]) {
- $self->loop_pause_filehandle($handle, $mode);
- $kr_fno_rec->[FMO_ST_ACTUAL] = HS_PAUSED;
- }
-
- # Correct the requested state so it matches the actual one.
-
- $kr_fno_rec->[FMO_ST_REQUEST] = HS_PAUSED;
-}
-
-### Return the number of active filehandles in the entire system.
-
-sub _data_handle_count {
- return scalar keys %kr_filenos;
-}
-
-### Return the number of active handles for a single session.
-
-sub _data_handle_count_ses {
- my ($self, $session) = @_;
- return 0 unless exists $kr_ses_to_handle{$session};
- return scalar keys %{$kr_ses_to_handle{$session}};
-}
-
-### Clear all the handles owned by a session.
-
-sub _data_handle_clear_session {
- my ($self, $session) = @_;
- return unless exists $kr_ses_to_handle{$session}; # avoid autoviv
- my @handles = values %{$kr_ses_to_handle{$session}};
- foreach (@handles) {
- my $handle = $_->[SH_HANDLE];
- my $refcount = $_->[SH_MODECOUNT];
-
- $self->_data_handle_remove($handle, MODE_RD, $session)
- if $refcount->[MODE_RD];
- $self->_data_handle_remove($handle, MODE_WR, $session)
- if $refcount->[MODE_WR];
- $self->_data_handle_remove($handle, MODE_EX, $session)
- if $refcount->[MODE_EX];
- }
-}
-
-} # Close scope.
-
-###############################################################################
-# Accessors: Events.
-###############################################################################
-
-{ # This section becomes POE::Resource::Event
-
-my %event_count;
-# ( $session => $count,
-# ...,
-# );
-
-my %post_count;
-# ( $session => $count,
-# ...,
-# );
-
-### End-run leak checking.
-
-sub _data_ev_finalize {
- # Don't bother if run() was never called.
- return unless $kr_run_warning & KR_RUN_CALLED;
-
- while (my ($ses, $cnt) = each(%event_count)) {
- warn "!!! Leaked event-to count: $ses = $cnt\n";
- }
-
- while (my ($ses, $cnt) = each(%post_count)) {
- warn "!!! Leaked event-from count: $ses = $cnt\n";
- }
-}
-
-### Enqueue an event.
-
-sub _data_ev_enqueue {
- my ( $self,
- $session, $source_session, $event, $type, $etc, $file, $line,
- $time
- ) = @_;
-
- unless ($self->_data_ses_exists($session)) {
- confess
- "<ev> can't enqueue event ``$event'' for nonexistent session $session\n";
- }
-
- # This is awkward, but faster than using the fields individually.
- my $event_to_enqueue = [ @_[1..7] ];
-
- my $old_head_priority = $kr_queue->get_next_priority();
- my $new_id = $kr_queue->enqueue($time, $event_to_enqueue);
-
- if (TRACE_EVENTS) {
- warn( "<ev> enqueued event $new_id ``$event'' from ",
- $self->_data_alias_loggable($source_session), " to ",
- $self->_data_alias_loggable($session),
- " at $time"
- );
- }
-
- if ($kr_queue->get_item_count() == 1) {
- $self->loop_resume_time_watcher($time);
- }
- elsif ($time < $old_head_priority) {
- $self->loop_reset_time_watcher($time);
- }
-
- $self->_data_ses_refcount_inc($session);
- $event_count{$session}++;
-
- $self->_data_ses_refcount_inc($source_session);
- $post_count{$source_session}++;
-
- return $new_id;
-}
-
-### Remove events sent to or from a specific session.
-
-sub _data_ev_clear_session {
- my ($self, $session) = @_;
-
- my $my_event = sub {
- ($_[0]->[EV_SESSION] == $session) || ($_[0]->[EV_SOURCE] == $session)
- };
-
- my $total_event_count =
- ( ( $event_count{$session} || 0) +
- ($post_count{$session} || 0)
- );
-
- foreach ($kr_queue->remove_items($my_event, $total_event_count)) {
- $self->_data_ev_refcount_dec(@{$_->[ITEM_PAYLOAD]}[EV_SOURCE, EV_SESSION]);
- }
-}
-
-### Remove a specific alarm by its name. This is in the events
-### section because alarms are currently implemented as events with
-### future due times.
-
-sub _data_ev_clear_alarm_by_name {
- my ($self, $session, $alarm_name) = @_;
-
- my $my_alarm = sub {
- return 0 unless $_[0]->[EV_TYPE] & ET_ALARM;
- return 0 unless $_[0]->[EV_SESSION] == $session;
- return 0 unless $_[0]->[EV_NAME] eq $alarm_name;
- return 1;
- };
-
- foreach ($kr_queue->remove_items($my_alarm)) {
- $self->_data_ev_refcount_dec(@{$_->[ITEM_PAYLOAD]}[EV_SOURCE, EV_SESSION]);
- }
-}
-
-### Remove a specific alarm by its ID. This is in the events section
-### because alarms are currently implemented as events with future due
-### times.
-
-sub _data_ev_clear_alarm_by_id {
- my ($self, $session, $alarm_id) = @_;
-
- my $my_alarm = sub {
- $_[0]->[EV_SESSION] == $session;
- };
-
- my ($time, $id, $event) = $kr_queue->remove_item($alarm_id, $my_alarm);
- return unless defined $time;
-
- $self->_data_ev_refcount_dec( @$event[EV_SOURCE, EV_SESSION] );
- return ($time, $event);
-}
-
-### Remove all the alarms for a session. Whoot!
-
-sub _data_ev_clear_alarm_by_session {
- my ($self, $session) = @_;
-
- my $my_alarm = sub {
- return 0 unless $_[0]->[EV_TYPE] & ET_ALARM;
- return 0 unless $_[0]->[EV_SESSION] == $session;
- return 1;
- };
-
- my @removed;
- foreach ($kr_queue->remove_items($my_alarm)) {
- my ($time, $event) = @$_[ITEM_PRIORITY, ITEM_PAYLOAD];
- $self->_data_ev_refcount_dec( @$event[EV_SOURCE, EV_SESSION] );
- push @removed, [ $event->[EV_NAME], $time, @{$event->[EV_ARGS]} ];
- }
-
- return @removed;
-}
-
-### Decrement a post refcount
-
-sub _data_ev_refcount_dec {
- my ($self, $source_session, $dest_session) = @_;
-
- confess $dest_session unless exists $event_count{$dest_session};
- confess $source_session unless exists $post_count{$source_session};
-
- $self->_data_ses_refcount_dec($dest_session);
- unless (--$event_count{$dest_session}) {
- delete $event_count{$dest_session};
- }
-
- $self->_data_ses_refcount_dec($source_session);
- unless (--$post_count{$source_session}) {
- delete $post_count{$source_session};
- }
-}
-
-### Fetch the number of pending events sent to a session.
-
-sub _data_ev_get_count_to {
- my ($self, $session) = @_;
- return $event_count{$session} || 0;
-}
-
-### Fetch the number of pending events sent from a session.
-
-sub _data_ev_get_count_from {
- my ($self, $session) = @_;
- return $post_count{$session} || 0;
-}
-
-### Dispatch events that are due for "now" or earlier.
-
-sub _data_ev_dispatch_due {
- my $self = shift;
-
- if (TRACE_EVENTS) {
- foreach ($kr_queue->peek_items(sub { 1 })) {
- warn( "<ev> time($_->[ITEM_PRIORITY]) id($_->[ITEM_ID]) ",
- "event(@{$_->[ITEM_PAYLOAD]})\n"
- );
- }
- }
-
- my $now = time();
- while (defined(my $next_time = $kr_queue->get_next_priority())) {
- last if $next_time > $now;
- my ($time, $id, $event) = $kr_queue->dequeue_next();
-
- if (TRACE_EVENTS) {
- warn "<ev> dispatching event $id ($event->[EV_NAME])";
- }
-
- $self->_data_ev_refcount_dec($event->[EV_SOURCE], $event->[EV_SESSION]);
- $self->_dispatch_event(@$event, $time, $id);
- }
-}
-
-} # Close scope.
-
-###############################################################################
-# Accessors: Sessions.
-###############################################################################
-
-{ # This section becomes POE::Resource::Session
-
-### Session structure.
-
-my %kr_sessions;
-# { $session =>
-# [ $blessed_session, SS_SESSION
-# $total_reference_count, SS_REFCOUNT
-# $parent_session, SS_PARENT
-# { $child_session => $blessed_ref, SS_CHILDREN
-# ...,
-# },
-# { $process_id => $placeholder_value, SS_PROCESSES
-# ...,
-# },
-# $unique_session_id, SS_ID
-# ],
-# ...,
-# };
-
-sub SS_SESSION () { 0 }
-sub SS_REFCOUNT () { 1 }
-sub SS_PARENT () { 2 }
-sub SS_CHILDREN () { 3 }
-sub SS_PROCESSES () { 4 }
-sub SS_ID () { 5 }
-
-### End-run leak checking.
-
-sub _data_ses_finalize {
- # Don't bother if run() was never called.
- return unless $kr_run_warning & KR_RUN_CALLED;
-
- while (my ($ses, $ses_rec) = each(%kr_sessions)) {
- warn( "!!! Leaked session: $ses\n",
- "!!!\trefcnt = $ses_rec->[SS_REFCOUNT]\n",
- "!!!\tparent = $ses_rec->[SS_PARENT]\n",
- "!!!\tchilds = ", join("; ", keys(%{$ses_rec->[SS_CHILDREN]})), "\n",
- "!!!\tprocs = ", join("; ", keys(%{$ses_rec->[SS_PROCESSES]})),"\n",
- );
- }
-}
-
-### Enter a new session into the back-end stuff.
-
-sub _data_ses_allocate {
- my ($self, $session, $sid, $parent) = @_;
-
- $kr_sessions{$session} =
- [ $session, # SS_SESSION
- 0, # SS_REFCOUNT
- $parent, # SS_PARENT
- { }, # SS_CHILDREN
- { }, # SS_PROCESSES
- $sid, # SS_ID
- ];
-
- # For the ID to session reference lookup.
- $self->_data_sid_set($sid, $session);
-
- # Manage parent/child relationship.
- if (defined $parent) {
- confess "parent $parent does not exist"
- unless exists $kr_sessions{$parent};
-
- if (TRACE_SESSIONS) {
- warn( "<ss> ",
- $self->_data_alias_loggable($session), " has parent ",
- $self->_data_alias_loggable($parent)
- );
- }
-
- $kr_sessions{$parent}->[SS_CHILDREN]->{$session} = $session;
- $self->_data_ses_refcount_inc($parent);
- }
-}
-
-### Release a session's resources, and remove it. This doesn't do
-### garbage collection for the session itself because that should
-### already have happened.
-
-sub _data_ses_free {
- my ($self, $session) = @_;
-
- if (TRACE_SESSIONS) {
- warn( "<ss> freeing ",
- $self->_data_alias_loggable($session)
- );
- }
-
- # Manage parent/child relationships.
-
- my $parent = $kr_sessions{$session}->[SS_PARENT];
- my @children = $self->_data_ses_get_children($session);
- if (defined $parent) {
- confess "session is its own parent" if $parent == $session;
- confess
- ( $self->_data_alias_loggable($session), " isn't a child of ",
- $self->_data_alias_loggable($parent), " (it's a child of ",
- $self->_data_alias_loggable($self->_data_ses_get_parent($session)),
- ")"
- ) unless $self->_data_ses_is_child($parent, $session);
-
- # Remove the departing session from its parent.
-
- confess "internal inconsistency ($parent)"
- unless exists $kr_sessions{$parent};
- confess "internal inconsistency ($parent/$session)"
- unless delete $kr_sessions{$parent}->[SS_CHILDREN]->{$session};
- undef $kr_sessions{$session}->[SS_PARENT];
-
- if (TRACE_SESSIONS) {
- cluck( "<ss> removed ",
- $self->_data_alias_loggable($session), " from ",
- $self->_data_alias_loggable($parent)
- );
- }
-
- $self->_data_ses_refcount_dec($parent);
-
- # Move the departing session's children to its parent.
-
- foreach (@children) {
- $self->_data_ses_move_child($_, $parent)
- }
- }
- else {
- confess "no parent to give children to" if @children;
- }
-
- # Things which do not hold reference counts.
-
- $self->_data_sid_clear($session); # Remove from SID tables.
- $self->_data_sig_clear_session($session); # Remove all leftover signals.
-
- # Things which dohold reference counts.
-
- $self->_data_alias_clear_session($session); # Remove all leftover aliases.
- $self->_data_extref_clear_session($session); # Remove all leftover extrefs.
- $self->_data_handle_clear_session($session); # Remove all leftover handles.
- $self->_data_ev_clear_session($session); # Remove all leftover events.
-
- # Remove the session itself.
-
- delete $kr_sessions{$session};
-
- # GC the parent, if there is one.
- if (defined $parent) {
- $self->_data_ses_collect_garbage($parent);
- }
-
- # Stop the main loop if everything is gone.
- unless (keys %kr_sessions) {
- $self->loop_halt();
- }
-}
-
-### Move a session to a new parent.
-
-sub _data_ses_move_child {
- my ($self, $session, $new_parent) = @_;
-
- if (TRACE_SESSIONS) {
- warn( "<ss> moving ",
- $self->_data_alias_loggable($session), " to ",
- $self->_data_alias_loggable($new_parent)
- );
- }
-
- confess "internal inconsistency" unless exists $kr_sessions{$session};
- confess "internal inconsistency" unless exists $kr_sessions{$new_parent};
-
- my $old_parent = $self->_data_ses_get_parent($session);
-
- confess "internal inconsistency" unless exists $kr_sessions{$old_parent};
-
- # Remove the session from its old parent.
- delete $kr_sessions{$old_parent}->[SS_CHILDREN]->{$session};
-
- if (TRACE_SESSIONS) {
- warn( "<ss> removed ",
- $self->_data_alias_loggable($session), " from ",
- $self->_data_alias_loggable($old_parent)
- );
- }
-
- $self->_data_ses_refcount_dec($old_parent);
-
- # Change the session's parent.
- $kr_sessions{$session}->[SS_PARENT] = $new_parent;
-
- if (TRACE_SESSIONS) {
- warn( "<ss> changed parent of ",
- $self->_data_alias_loggable($session), " to ",
- $self->_data_alias_loggable($new_parent)
- );
- }
-
- # Add the current session to the new parent's children.
- $kr_sessions{$new_parent}->[SS_CHILDREN]->{$session} = $session;
-
- if (TRACE_SESSIONS) {
- warn( "<ss> added ",
- $self->_data_alias_loggable($session), " as child of ",
- $self->_data_alias_loggable($new_parent)
- );
- }
-
- $self->_data_ses_refcount_inc($new_parent);
-}
-
-### Get a session's parent.
-
-sub _data_ses_get_parent {
- my ($self, $session) = @_;
- confess "internal inconsistency" unless exists $kr_sessions{$session};
- return $kr_sessions{$session}->[SS_PARENT];
-}
-
-### Get a session's children.
-
-sub _data_ses_get_children {
- my ($self, $session) = @_;
- confess "internal inconsistency" unless exists $kr_sessions{$session};
- return values %{$kr_sessions{$session}->[SS_CHILDREN]};
-}
-
-### Is a session a child of another?
-
-sub _data_ses_is_child {
- my ($self, $parent, $child) = @_;
- confess "internal inconsistency" unless exists $kr_sessions{$parent};
- return exists $kr_sessions{$parent}->[SS_CHILDREN]->{$child};
-}
-
-### Determine whether a session exists. We should only need to verify
-### this for sessions provided by the outside. Internally, our code
-### should be so clean it's not necessary.
-
-sub _data_ses_exists {
- my ($self, $session) = @_;
- return exists $kr_sessions{$session};
-}
-
-### Resolve a session into its reference.
-
-sub _data_ses_resolve {
- my ($self, $session) = @_;
- return undef unless exists $kr_sessions{$session}; # Prevents autoviv.
- return $kr_sessions{$session}->[SS_SESSION];
-}
-
-### Resolve a session ID into its reference.
-
-sub _data_ses_resolve_to_id {
- my ($self, $session) = @_;
- return undef unless exists $kr_sessions{$session}; # Prevents autoviv.
- return $kr_sessions{$session}->[SS_ID];
-}
-
-### Decrement a session's main reference count. This is called by
-### each watcher when the last thing it watches for the session goes
-### away. In other words, a session's reference count should only
-### enumerate the different types of things being watched; not the
-### number of each.
-
-sub _data_ses_refcount_dec {
- my ($self, $session) = @_;
-
- if (TRACE_REFCNT) {
- warn( "<rc> decrementing refcount for ",
- $self->_data_alias_loggable($session)
- );
- }
-
- return unless exists $kr_sessions{$session};
- confess "internal inconsistency" unless exists $kr_sessions{$session};
-
- if (--$kr_sessions{$session}->[SS_REFCOUNT] < 0) {
- confess( $self->_data_alias_loggable($session),
- " reference count went below zero"
- );
- }
-}
-
-### Increment a session's main reference count.
-
-sub _data_ses_refcount_inc {
- my ($self, $session) = @_;
-
- if (TRACE_REFCNT) {
- warn( "<rc> incrementing refcount for ",
- $self->_data_alias_loggable($session)
- );
- }
-
- confess "incrementing refcount for nonexistent session"
- unless exists $kr_sessions{$session};
- $kr_sessions{$session}->[SS_REFCOUNT]++;
-}
-
-### Determine whether a session is ready to be garbage collected.
-### Free the session if it is.
-
-sub _data_ses_collect_garbage {
- my ($self, $session) = @_;
-
- if (TRACE_REFCNT) {
- warn( "<rc> testing for idle ",
- $self->_data_alias_loggable($session)
- );
- }
-
- # The next line is necessary for some strange reason. This feels
- # like a kludge, but I'm currently not smart enough to figure out
- # what it's working around.
-
- confess "internal inconsistency" unless exists $kr_sessions{$session};
-
- if (TRACE_REFCNT) {
- my $ss = $kr_sessions{$session};
- warn( "<rc> +----- GC test for ", $self->_data_alias_loggable($session),
- " ($session) -----\n",
- "<rc> | total refcnt : $ss->[SS_REFCOUNT]\n",
- "<rc> | event count : ",
- $self->_data_ev_get_count_to($session), "\n",
- "<rc> | post count : ",
- $self->_data_ev_get_count_from($session), "\n",
- "<rc> | child sessions: ",
- scalar(keys(%{$ss->[SS_CHILDREN]})), "\n",
- "<rc> | handles in use: ",
- $self->_data_handle_count_ses($session), "\n",
- "<rc> | aliases in use: ",
- $self->_data_alias_count_ses($session), "\n",
- "<rc> | extra refs : ",
- $self->_data_extref_count_ses($session), "\n",
- "<rc> +---------------------------------------------------\n",
- );
- unless ($ss->[SS_REFCOUNT]) {
- warn( "<rc> | ", $self->_data_alias_loggable($session),
- " is garbage; stopping it...\n",
- "<rc> +---------------------------------------------------\n",
- );
- }
- }
-
- if (ASSERT_DATA) {
- my $ss = $kr_sessions{$session};
- my $calc_ref =
- ( $self->_data_ev_get_count_to($session) +
- $self->_data_ev_get_count_from($session) +
- scalar(keys(%{$ss->[SS_CHILDREN]})) +
- $self->_data_handle_count_ses($session) +
- $self->_data_extref_count_ses($session) +
- $self->_data_alias_count_ses($session)
- );
-
- # The calculated reference count really ought to match the one
- # POE's been keeping track of all along.
-
- confess( "<dt> ", $self->_data_alias_loggable($session),
- " has a reference count inconsistency",
- " (calc=$calc_ref; actual=$ss->[SS_REFCOUNT])\n"
- ) if $calc_ref != $ss->[SS_REFCOUNT];
- }
-
- return if $kr_sessions{$session}->[SS_REFCOUNT];
-
- $self->_data_ses_stop($session);
-}
-
-### Return the number of sessions we know about.
-
-sub _data_ses_count {
- return scalar keys %kr_sessions;
-}
-
-### Close down a session by force.
-
-# Dispatch _stop to a session, removing it from the kernel's data
-# structures as a side effect.
-
-sub _data_ses_stop {
- my ($self, $session) = @_;
-
- if (TRACE_SESSIONS) {
- warn "<ss> stopping ", $self->_data_alias_loggable($session);
- }
-
- confess unless exists $kr_sessions{$session};
-
- $self->_dispatch_event
- ( $session, $kr_active_session,
- EN_STOP, ET_STOP, [],
- __FILE__, __LINE__, time(), -__LINE__
- );
-}
-
-} # Close scope.
+use POE::Resource::Extrefs; # Extra reference counts.
+use POE::Resource::SIDs; # Session IDs.
+use POE::Resource::Signals; # Signals.
+use POE::Resource::Aliases; # Aliases.
+use POE::Resource::FileHandles; # File handles.
+use POE::Resource::Events; # Events.
+use POE::Resource::Sessions; # Sessions.
###############################################################################
# Helpers.
@@ -2283,9 +513,16 @@ sub new {
$self->[KR_ID] = $hostname . '-' . unpack('H*', pack('N*', time, $$));
$self->_data_sid_set($self->[KR_ID], $self);
- # Start the Kernel's session.
+ # Initialize subsystems. At least three subsystems need to be
+ # started in a specific order. We need events before we can start
+ # sessions. We need the kernel's session before we can initialize
+ # signals because signals use polling events.
+ $self->_data_ev_initialize($kr_queue);
$self->_initialize_kernel_session();
$self->_data_sig_initialize();
+
+ # These other subsystems don't have strange interactions.
+ $self->_data_handle_initialize($kr_queue);
}
# Return the global instance.
View
140 lib/POE/Resource/Aliases.pm
@@ -0,0 +1,140 @@
+# $Id$
+
+# Manage the POE::Kernel data structures necessary to keep track of
+# session aliases.
+
+package POE::Resources::Aliases;
+
+use vars qw($VERSION);
+$VERSION = (qw($Revision$))[1];
+
+# These methods are folded into POE::Kernel;
+package POE::Kernel;
+
+use strict;
+
+### The table of session aliases, and the sessions they refer to.
+
+my %kr_aliases;
+# ( $alias => $session_ref,
+# ...,
+# );
+
+my %kr_ses_to_alias;
+# ( $session_ref =>
+# { $alias => $placeholder_value,
+# ...,
+# },
+# ...,
+# );
+
+### End-run leak checking.
+
+sub _data_alias_finalize {
+ while (my ($alias, $ses) = each(%kr_aliases)) {
+ warn "!!! Leaked alias: $alias = $ses\n";
+ }
+ while (my ($ses, $alias_rec) = each(%kr_ses_to_alias)) {
+ my @aliases = keys(%$alias_rec);
+ warn "!!! Leaked alias cross-reference: $ses (@aliases)\n";
+ }
+}
+
+### Add an alias to a session.
+
+sub _data_alias_add {
+ my ($self, $session, $alias) = @_;
+ $self->_data_ses_refcount_inc($session);
+ $kr_aliases{$alias} = $session;
+ $kr_ses_to_alias{$session}->{$alias} = 1;
+}
+
+### Remove an alias from a session.
+
+sub _data_alias_remove {
+ my ($self, $session, $alias) = @_;
+ delete $kr_aliases{$alias};
+ delete $kr_ses_to_alias{$session}->{$alias};
+ unless (keys %{$kr_ses_to_alias{$session}}) {
+ delete $kr_ses_to_alias{$session};
+ }
+ $self->_data_ses_refcount_dec($session);
+}
+
+### Clear all the aliases from a session.
+
+sub _data_alias_clear_session {
+ my ($self, $session) = @_;
+ return unless exists $kr_ses_to_alias{$session}; # avoid autoviv
+ foreach (keys %{$kr_ses_to_alias{$session}}) {
+ $self->_data_alias_remove($session, $_);
+ }
+}
+
+### Resolve an alias. Just an alias.
+
+sub _data_alias_resolve {
+ my ($self, $alias) = @_;
+ return undef unless exists $kr_aliases{$alias};
+ return $kr_aliases{$alias};
+}
+
+### Return a list of aliases for a session.
+
+sub _data_alias_list {
+ my ($self, $session) = @_;
+ return () unless exists $kr_ses_to_alias{$session};
+ return sort keys %{$kr_ses_to_alias{$session}};
+}
+
+### Return the number of aliases for a session.
+
+sub _data_alias_count_ses {
+ my ($self, $session) = @_;
+ return 0 unless exists $kr_ses_to_alias{$session};
+ return scalar keys %{$kr_ses_to_alias{$session}};
+}
+
+### Return a session's ID in a form suitable for logging.
+
+sub _data_alias_loggable {
+ my ($self, $session) = @_;
+ confess "internal inconsistency" unless ref($session);
+ "session " . $session->ID . " (" .
+ ( (exists $kr_ses_to_alias{$session})
+ ? join(", ", keys(%{$kr_ses_to_alias{$session}}))
+ : $session
+ ) . ")"
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+POE::Resources::Aliases - manage session aliases for POE::Kernel
+
+=head1 SYNOPSIS
+
+Used internally by POE::Kernel. Better documentation will be
+forthcoming.
+
+=head1 DESCRIPTION
+
+This module manages session aliases for POE::Kernel. It is used
+internally by POE::Kernel and has no public interface.
+
+=head1 SEE ALSO
+
+See L<POE::Kernel> for documentation on session aliases.
+
+=head1 BUGS
+
+Probably.
+
+=head1 AUTHORS & COPYRIGHTS
+
+Please see L<POE> for more information about authors and contributors.
+
+=cut
View
261 lib/POE/Resource/Events.pm
@@ -0,0 +1,261 @@
+# $Id$
+
+# Data and accessors to manage POE's events.
+
+package POE::Resources::Events;
+
+use vars qw($VERSION);
+$VERSION = (qw($Revision$))[1];
+
+# 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 => $count,
+# ...,
+# );
+
+my %post_count;
+# ( $session => $count,
+# ...,
+# );
+
+### Begin-run initialization.
+
+sub _data_ev_initialize {
+ my ($self, $queue) = @_;
+ $kr_queue = $queue;
+}
+
+### End-run leak checking.
+
+sub _data_ev_finalize {
+ # Don't bother if run() was never called. -><- Is this needed?
+ # return unless $kr_run_warning & KR_RUN_CALLED;
+
+ while (my ($ses, $cnt) = each(%event_count)) {
+ warn "!!! Leaked event-to count: $ses = $cnt\n";
+ }
+
+ while (my ($ses, $cnt) = each(%post_count)) {
+ warn "!!! Leaked event-from count: $ses = $cnt\n";
+ }
+}
+
+### Enqueue an event.
+
+sub _data_ev_enqueue {
+ my ( $self,
+ $session, $source_session, $event, $type, $etc, $file, $line,
+ $time
+ ) = @_;
+
+ unless ($self->_data_ses_exists($session)) {
+ confess
+ "<ev> can't enqueue event ``$event'' for nonexistent session $session\n";
+ }
+
+ # This is awkward, but faster than using the fields individually.
+ my $event_to_enqueue = [ @_[1..7] ];
+
+ my $old_head_priority = $kr_queue->get_next_priority();
+ my $new_id = $kr_queue->enqueue($time, $event_to_enqueue);
+
+ if (TRACE_EVENTS) {
+ warn( "<ev> enqueued event $new_id ``$event'' from ",
+ $self->_data_alias_loggable($source_session), " to ",
+ $self->_data_alias_loggable($session),
+ " at $time"
+ );
+ }
+
+ if ($kr_queue->get_item_count() == 1) {
+ $self->loop_resume_time_watcher($time);
+ }
+ elsif ($time < $old_head_priority) {
+ $self->loop_reset_time_watcher($time);
+ }
+
+ $self->_data_ses_refcount_inc($session);
+ $event_count{$session}++;
+
+ $self->_data_ses_refcount_inc($source_session);
+ $post_count{$source_session}++;
+
+ return $new_id;
+}
+
+### Remove events sent to or from a specific session.
+
+sub _data_ev_clear_session {
+ my ($self, $session) = @_;
+
+ my $my_event = sub {
+ ($_[0]->[EV_SESSION] == $session) || ($_[0]->[EV_SOURCE] == $session)
+ };
+
+ my $total_event_count =
+ ( ( $event_count{$session} || 0) +
+ ($post_count{$session} || 0)
+ );
+
+ foreach ($kr_queue->remove_items($my_event, $total_event_count)) {
+ $self->_data_ev_refcount_dec(@{$_->[ITEM_PAYLOAD]}[EV_SOURCE, EV_SESSION]);
+ }
+}
+
+### Remove a specific alarm by its name. This is in the events
+### section because alarms are currently implemented as events with
+### future due times.
+
+sub _data_ev_clear_alarm_by_name {
+ my ($self, $session, $alarm_name) = @_;
+
+ my $my_alarm = sub {
+ return 0 unless $_[0]->[EV_TYPE] & ET_ALARM;
+ return 0 unless $_[0]->[EV_SESSION] == $session;
+ return 0 unless $_[0]->[EV_NAME] eq $alarm_name;
+ return 1;
+ };
+
+ foreach ($kr_queue->remove_items($my_alarm)) {
+ $self->_data_ev_refcount_dec(@{$_->[ITEM_PAYLOAD]}[EV_SOURCE, EV_SESSION]);
+ }
+}
+
+### Remove a specific alarm by its ID. This is in the events section
+### because alarms are currently implemented as events with future due
+### times.
+
+sub _data_ev_clear_alarm_by_id {
+ my ($self, $session, $alarm_id) = @_;
+
+ my $my_alarm = sub {
+ $_[0]->[EV_SESSION] == $session;
+ };
+
+ my ($time, $id, $event) = $kr_queue->remove_item($alarm_id, $my_alarm);
+ return unless defined $time;
+
+ $self->_data_ev_refcount_dec( @$event[EV_SOURCE, EV_SESSION] );
+ return ($time, $event);
+}
+
+### Remove all the alarms for a session. Whoot!
+
+sub _data_ev_clear_alarm_by_session {
+ my ($self, $session) = @_;
+
+ my $my_alarm = sub {
+ return 0 unless $_[0]->[EV_TYPE] & ET_ALARM;
+ return 0 unless $_[0]->[EV_SESSION] == $session;
+ return 1;
+ };
+
+ my @removed;
+ foreach ($kr_queue->remove_items($my_alarm)) {
+ my ($time, $event) = @$_[ITEM_PRIORITY, ITEM_PAYLOAD];
+ $self->_data_ev_refcount_dec( @$event[EV_SOURCE, EV_SESSION] );
+ push @removed, [ $event->[EV_NAME], $time, @{$event->[EV_ARGS]} ];
+ }
+
+ return @removed;
+}
+
+### Decrement a post refcount
+
+sub _data_ev_refcount_dec {
+ my ($self, $source_session, $dest_session) = @_;
+
+ confess $dest_session unless exists $event_count{$dest_session};
+ confess $source_session unless exists $post_count{$source_session};
+
+ $self->_data_ses_refcount_dec($dest_session);
+ unless (--$event_count{$dest_session}) {
+ delete $event_count{$dest_session};
+ }
+
+ $self->_data_ses_refcount_dec($source_session);
+ unless (--$post_count{$source_session}) {
+ delete $post_count{$source_session};
+ }
+}
+
+### Fetch the number of pending events sent to a session.
+
+sub _data_ev_get_count_to {
+ my ($self, $session) = @_;
+ return $event_count{$session} || 0;
+}
+
+### Fetch the number of pending events sent from a session.
+
+sub _data_ev_get_count_from {
+ my ($self, $session) = @_;
+ return $post_count{$session} || 0;
+}
+
+### Dispatch events that are due for "now" or earlier.
+
+sub _data_ev_dispatch_due {
+ my $self = shift;
+
+ if (TRACE_EVENTS) {
+ foreach ($kr_queue->peek_items(sub { 1 })) {
+ warn( "<ev> time($_->[ITEM_PRIORITY]) id($_->[ITEM_ID]) ",
+ "event(@{$_->[ITEM_PAYLOAD]})\n"
+ );
+ }
+ }
+
+ my $now = time();
+ while (defined(my $next_time = $kr_queue->get_next_priority())) {
+ last if $next_time > $now;
+ my ($time, $id, $event) = $kr_queue->dequeue_next();
+
+ if (TRACE_EVENTS) {
+ warn "<ev> dispatching event $id ($event->[EV_NAME])";
+ }
+
+ $self->_data_ev_refcount_dec($event->[EV_SOURCE], $event->[EV_SESSION]);
+ $self->_dispatch_event(@$event, $time, $id);
+ }
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+POE::Resources::Events - manage events for POE::Kernel
+
+=head1 SYNOPSIS
+
+Used internally by POE::Kernel. Better documentation will be
+forthcoming.
+
+=head1 DESCRIPTION
+
+This module hides the complexity of managing POE's events from even
+POE itself. It is used internally by POE::Kernel and has no public
+interface.
+
+=head1 SEE ALSO
+
+See L<POE::Kernel> for documentation on events.
+
+=head1 BUGS
+
+Probably.
+
+=head1 AUTHORS & COPYRIGHTS
+
+Please see L<POE> for more information about authors and contributors.
+
+=cut
View
169 lib/POE/Resource/Extrefs.pm
@@ -0,0 +1,169 @@
+# $Id$
+
+# The data necessary to manage tagged extra/external reference counts
+# on sessions, and the accessors to get at them sanely from other
+# files.
+
+package POE::Resources::Extrefs;
+
+use vars qw($VERSION);
+$VERSION = (qw($Revision$))[1];
+
+# These methods are folded into POE::Kernel;
+package POE::Kernel;
+
+use strict;
+
+### The count of all extra references used in the system.
+
+my %kr_extra_refs;
+# ( $session =>
+# { $tag => $count,
+# ...,
+# },
+# ...,
+# );
+
+### End-run leak checking.
+
+sub _data_extref_finalize {
+ foreach my $session (keys %kr_extra_refs) {
+ warn "!!! Leaked extref: $session\n";
+ foreach my $tag (keys %{$kr_extra_refs{$session}}) {
+ warn "!!!\t`$tag' = $kr_extra_refs{$session}->{$tag}\n";
+ }
+ }
+}
+
+### Increment a session's tagged reference count. If this is the
+### first time the tag is used in the session, then increment the
+### session's reference count as well. Returns the tag's new
+### reference count.
+
+sub _data_extref_inc {
+ my ($self, $session, $tag) = @_;
+ my $refcount = ++$kr_extra_refs{$session}->{$tag};
+ $self->_data_ses_refcount_inc($session) if $refcount == 1;
+
+ if (TRACE_REFCNT) {
+ warn( "<rc> incremented extref ``$tag'' (now $refcount) for ",
+ $self->_data_alias_loggable($session)
+ );
+ }
+
+ return $refcount;
+}
+
+### Decrement a session's tagged reference count, removing it outright
+### if the count reaches zero. Return the new reference count or
+### undef if the tag doesn't exist.
+
+sub _data_extref_dec {
+ my ($self, $session, $tag) = @_;
+
+ if (ASSERT_DATA) {
+ unless (exists $kr_extra_refs{$session}->{$tag}) {
+ confess( "<dt> decrementing extref for nonexistent tag ``$tag'' in ",
+ $self->_data_alias_loggable($session)
+ );
+ }
+ }
+
+ my $refcount = --$kr_extra_refs{$session}->{$tag};
+
+ if (TRACE_REFCNT) {
+ warn( "<rc> decremented extref ``$tag'' (now $refcount) for ",
+ $self->_data_alias_loggable($session)
+ );
+ }
+
+ $self->_data_extref_remove($session, $tag) unless $refcount;
+ return $refcount;
+}
+
+### Remove an extra reference from a session, regardless of its count.
+
+sub _data_extref_remove {
+ my ($self, $session, $tag) = @_;
+
+ if (ASSERT_DATA) {
+ unless (exists $kr_extra_refs{$session}->{$tag}) {
+ confess( "<dt> decrementing extref for nonexistent tag ``$tag'' in ",
+ $self->_data_alias_loggable($session)
+ );
+ }
+ }
+
+ delete $kr_extra_refs{$session}->{$tag};
+ $self->_data_ses_refcount_dec($session);
+ unless (keys %{$kr_extra_refs{$session}}) {
+ delete $kr_extra_refs{$session};
+ }
+}
+
+### Clear all the extra references from a session.
+
+sub _data_extref_clear_session {
+ my ($self, $session) = @_;
+ return unless exists $kr_extra_refs{$session}; # avoid autoviv
+ foreach (keys %{$kr_extra_refs{$session}}) {
+ $self->_data_extref_remove($session, $_);
+ }
+
+ if (ASSERT_DATA) {
+ if (exists $kr_extra_refs{$session}) {
+ confess( "<dt> extref clear did not remove session ",
+ $self->_data_alias_loggable($session)
+ );
+ }
+ }
+}
+
+### Fetch the number of extra references held in the entire system.
+
+sub _data_extref_count {
+ return scalar keys %kr_extra_refs;
+}
+
+### Fetch the number of extra references held by a session.
+
+sub _data_extref_count_ses {
+ my ($self, $session) = @_;
+ return exists $kr_extra_refs{$session};
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+POE::Resources::Extrefs - tagged "extra" ref. count management for POE::Kernel
+
+=head1 SYNOPSIS
+
+Used internally by POE::Kernel. Better documentation will be
+forthcoming.
+
+=head1 DESCRIPTION
+
+This module encapsulates and provides accessors for POE::Kernel's data
+structures that manage tagged reference counts. It is used internally
+by POE::Kernel and has no public interface.
+
+=head1 SEE ALSO
+
+See L<POE::Kernel> for documentation on tagged reference counts.
+
+=head1 BUGS
+
+There is no mechanism in place to prevent extra reference count names
+from clashing.
+
+Probably others.
+
+=head1 AUTHORS & COPYRIGHTS
+
+Please see L<POE> for more information about authors and contributors.
+
+=cut
View
655 lib/POE/Resource/FileHandles.pm
@@ -0,0 +1,655 @@
+# $Id$
+
+# Manage file handles, associated descriptors, and read/write modes
+# thereon.
+
+package POE::Resources::FileHandles;
+
+use vars qw($VERSION);
+$VERSION = (qw($Revision$))[1];
+
+# These methods are folded into POE::Kernel;
+package POE::Kernel;
+
+use strict;
+
+### A local reference to POE::Kernel's queue.
+
+my $kr_queue;
+
+### Fileno structure. This tracks the sessions that are watchin 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;
+
+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_ST_REQUEST () { 2 } # $actual_file_state (see HS_PAUSED)
+sub FMO_EV_COUNT () { 3 } # $number_of_pending_events,
+sub FMO_SESSIONS () { 4 } # { $session_watching_this_handle =>
+# --- BEGIN SUB STRUCT 2 --- #
+sub HSS_HANDLE () { 0 } # [ $blessed_handle,
+sub HSS_SESSION () { 1 } # $blessed_session,
+sub HSS_STATE () { 2 } # $event_name,
+ # ],
+# --- 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 and FMO_ST_REQUEST.
+
+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;
+
+ # { $file_handle =>
+# --- 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 --- # ],
+ # ],
+ # ...
+ # },
+
+### Begin-run initialization.
+
+sub _data_handle_initialize {
+ my ($self, $queue) = @_;
+ $kr_queue = $queue;
+}
+
+### End-run leak checking.
+
+sub _data_handle_finalize {
+ while (my ($fd, $fd_rec) = each(%kr_filenos)) {
+ my ($rd, $wr, $ex, $tot) = @$fd_rec;
+ warn "!!! Leaked fileno: $fd (total refcnt=$tot)\n";
+
+ warn( "!!!\tRead:\n",
+ "!!!\t\trefcnt = $rd->[FMO_REFCOUNT]\n",
+ "!!!\t\tev cnt = $rd->[FMO_EV_COUNT]\n",
+ );
+ while (my ($ses, $ses_rec) = each(%{$rd->[FMO_SESSIONS]})) {
+ warn( "!!!\t\tsession = $ses\n",
+ "!!!\t\t\thandle = $ses_rec->[HSS_HANDLE]\n",
+ "!!!\t\t\tsession = $ses_rec->[HSS_SESSION]\n",
+ "!!!\t\t\tevent = $ses_rec->[HSS_STATE]\n",
+ );
+ }
+
+ warn( "!!!\tWrite:\n",
+ "!!!\t\trefcnt = $wr->[FMO_REFCOUNT]\n",
+ "!!!\t\tev cnt = $wr->[FMO_EV_COUNT]