File Coverage

blib/lib/POE/Session/MessageBased.pm

Criterion	Covered	Total	%
statement	36	54	66.6
branch	4	12	33.3
condition			n/a
subroutine	11	18	61.1
pod			n/a
total	51	84	60.7

# License and documentation are after __END__.

# This is prototype code.  It rummages around in its base class'
# namespace for constants, among other unsavory things.

# Artur Bergman suggests keeping a static Message object in the
# Session itself, and reusing that instead of building and destroying
# messages each time.  That could be a little faster.

package POE::Session::MessageBased;

use warnings;
use strict;

use vars qw($VERSION);
$VERSION = '0.111';

use POE;
use base qw(POE::Session);
use POSIX qw(ENOSYS);

sub _invoke_state {
	my ($self, $source_session, $state, $etc, $file, $line) = @_;

	# Trace the state invocation if tracing is enabled.

	if ($self->[POE::Session::SE_OPTIONS]->{+POE::Session::OPT_TRACE}) {
		warn(
			$POE::Kernel::poe_kernel->ID_session_to_id($self),
			" -> $state (from $file at $line)\n"
		);
	}

	# The desired destination state doesn't exist in this session.
	# Attempt to redirect the state transition to _default.

	unless (exists $self->[POE::Session::SE_STATES]->{$state}) {

		# There's no _default either; redirection's not happening today.
		# Drop the state transition event on the floor, and optionally
		# make some noise about it.

		unless (
			exists
			$self->[POE::Session::SE_STATES]->{+POE::Session::EN_DEFAULT}
		) {
			$! = ENOSYS;
			if ($self->[POE::Session::SE_OPTIONS]->{+POE::Session::OPT_DEFAULT}) {
				warn(
					"a '$state' state was sent from $file at $line to session ",
					$POE::Kernel::poe_kernel->ID_session_to_id($self),
					", but session ",
					$POE::Kernel::poe_kernel->ID_session_to_id($self),
					" has neither that state nor a _default state to handle it\n"
				);
			}
			return undef;
		}

		# If we get this far, then there's a _default state to redirect
		# the transition to.  Trace the redirection.

		if ($self->[POE::Session::SE_OPTIONS]->{+POE::Session::OPT_TRACE}) {
			warn(
				$POE::Kernel::poe_kernel->ID_session_to_id($self),
				" -> $state redirected to _default\n"
			);
		}

		# Transmogrify the original state transition into a corresponding
		# _default invocation.

		$etc   = [ $state, $etc ];
		$state = POE::Session::EN_DEFAULT;
	}

	# If we get this far, then the state can be invoked.  So invoke it
	# already!

	# Inline states are invoked this way.

	if (ref($self->[POE::Session::SE_STATES]->{$state}) eq 'CODE') {
		my $message = POE::Session::Message->new(
			undef,                          # object
			$self,                          # session
			$POE::Kernel::poe_kernel,       # kernel
			$self->[POE::Session::SE_NAMESPACE], # heap
			$state,                         # state
			$source_session,                # sender
			undef,                          # unused #6
			$file,                          # caller file name
			$line,                          # caller file line
			$etc                            # args
		);

		return $self->[POE::Session::SE_STATES]->{$state}->($message, @$etc);
	}

	# Package and object states are invoked this way.

	my ($object, $method) = @{$self->[POE::Session::SE_STATES]->{$state}};
	my $message = POE::Session::Message->new(
		$object,                        # object
		$self,                          # session
		$POE::Kernel::poe_kernel,       # kernel
		$self->[POE::Session::SE_NAMESPACE], # heap
		$state,                         # state
		$source_session,                # sender
		undef,                          # unused #6
		$file,                          # caller file name
		$line,                          # caller file line
		$etc                            # args
	);

	# Package/object are implied.
	return $object->$method($message, @$etc);
}

package POE::Session::Message;

use POE::Session;

sub new {
	my $class = shift;
	my $self = bless [ @_ ], $class;
	return $self;
}

sub object      { $_[0]->[OBJECT]      }
sub session     { $_[0]->[SESSION]     }
sub kernel      { $_[0]->[KERNEL]      }
sub heap        { $_[0]->[HEAP]        }
sub state       { $_[0]->[STATE]       }
sub sender      { $_[0]->[SENDER]      }
sub caller_file { $_[0]->[CALLER_FILE] }
sub caller_line { $_[0]->[CALLER_LINE] }
sub args        { @{$_[0]->[ARG0]}     }

1;

__END__