File Coverage

blib/lib/POE/Session/PlainCall.pm

Criterion	Covered	Total	%
statement	129	150	86.0
branch	37	60	61.6
condition	12	19	63.1
subroutine	34	36	94.4
pod	4	4	100.0
total	216	269	80.3

package POE::Session::PlainCall;

use strict;
use warnings;

use Carp;
use POE;
use Scalar::Util qw( blessed );

require Exporter;

our $VERSION = '0.0301';


#######################################
our $POE_HOLDER;
$POE_HOLDER = bless [], 'POE::Session::PlainCall::Holder';

sub poe () { $POE_HOLDER }

#######################################
use base qw( Exporter POE::Session );

our %EXPORT_TAGS = ( 'all' => [ qw( $poe_kernel poe ) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw( $poe_kernel poe );

#######################################
BEGIN {
    *SE_NAMESPACE = \&POE::Session::SE_NAMESPACE;
    *SE_OPTIONS   = \&POE::Session::SE_OPTIONS;
    *SE_STATES    = \&POE::Session::SE_STATES;
    if( POE::Session->can( 'SE_ID' ) ) {
        # POE 1.300 +
        *SE_ID       = \&POE::Session::SE_ID;
        eval '
        *SE_RUNNING  = sub () { POE::Session::SE_ID+1 };
        *SE_MYSTATES = sub () { POE::Session::SE_ID+2 };
        ';
    }
    else {
        # POE 1.299-
        *SE_RUNNING  = sub () { POE::Session::SE_STATES+1 };
        *SE_MYSTATES = sub () { POE::Session::SE_STATES+2 };
    }

    *EN_SIGNAL    = \&POE::Session::EN_SIGNAL;
    *EN_DEFAULT   = \&POE::Session::EN_DEFAULT;

    *OPT_TRACE    = \&POE::Session::OPT_TRACE;
    *OPT_DEBUG    = \&POE::Session::OPT_DEBUG;
    *OPT_DEFAULT  = \&POE::Session::OPT_DEFAULT;
}

############################################################################
sub _loggable
{
    my( $self ) = @_;
    return $self unless $self->[SE_RUNNING];
    $POE::Kernel::poe_kernel->_data_alias_loggable( $_[0] );
}

our %OURS;
sub instantiate
{
    my $self = shift->SUPER::instantiate( @_ );
    if( $self->[SE_RUNNING] or $self->[SE_MYSTATES] ) {
        die "Definition of POE::Session changed!  $self needs to be modified.\n";
    }
    $self->__init;
    return $self;
}

sub __init
{
    my( $self ) = @_;
    $self->[SE_RUNNING] = 0;
    # warn "keys = ", join ', ', keys %OURS;
    $self->[SE_MYSTATES] = {%OURS};
    $self->SUPER::__init if $self->can( 'SUPER::__init' );
}

#######################################
sub create
{
    my( $package, @params ) = @_;

    if (@params & 1) {
        croak "odd number of events/handlers (missing one or the other?)";
    }
    my %args = @params;

    my $obj = delete $args{object};
    unless( $obj ) {
        my $package = delete $args{package};
        if( $package ) {
            my $args = delete $args{ctor_args};
            $args ||= [];
            $obj = $package->new( @$args );
        }
    }

    if( $obj ) {
        my $events = delete $args{events} ||
                     delete $args{states};
        croak "Parameters 'events' or 'states' are required if you supply 'object' or 'package'"
                unless defined $events;
        $args{object_states} ||= [];
        push @{ $args{object_states} }, $obj, $events;
    }

    local %OURS;
    $package->__process_args( \%args );
    # warn "keys = ", join ', ', keys %OURS;

    my $self = $package->SUPER::create( %args );
    $self->[SE_RUNNING] = 1;
    return $self;
}

#######################################
## Find all state names and mark them as ours
sub __process_args
{
    my( $package, $args ) = @_;
    foreach my $f ( qw( package_states object_states ) ) {
        next unless $args->{$f};
        my $L = $args->{$f};
        for(my $off = 1; $off <= $#$L ; $off+=2 ) {
            my $states = $args->{$f}[$off];
            if( 'HASH' eq ref $states ) {
                $package->__process_ours( keys %$states );
            }
            elsif( 'ARRAY' eq ref $states ) {
                $package->__process_ours( @$states );
            }
        }
    }
    return unless $args->{inline_states};
    $package->__process_ours( keys %{ $args->{inline_states} } );
}

#######################################
sub __process_ours
{
    my( $package, @list ) = @_;
    # warn "OURS=", join ', ', @list;
    @OURS{ @list } = (1) x (0+@list);
}

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

    unless( $self->[SE_MYSTATES]{$state} or $self->[SE_MYSTATES]{+EN_DEFAULT} ) {
        if ($self->[SE_OPTIONS]->{+OPT_TRACE}) {
            POE::Kernel::_warn( $self->_loggable,
                                " -> $state (external event)\n"
                          );
        }
        ## Skip out if it's not our state
        return shift->SUPER::_invoke_state( @_ );
    }

    # Most of the following was lifted AS IS from POE::Session::_invoke_state
    # and simply reformated because I'm a tad anal.
    # But then, POE::Session overloading is like that...

    # Trace the state invocation if tracing is enabled.

    if ($self->[SE_OPTIONS]->{+OPT_TRACE}) {
        POE::Kernel::_warn( $self->_loggable,
                            " -> $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->[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->[SE_STATES]->{+EN_DEFAULT}) {
            $! = exists &Errno::ENOSYS ? &Errno::ENOSYS : &Errno::EIO;
            if ($self->[SE_OPTIONS]->{+OPT_DEFAULT} and $state ne EN_SIGNAL) {
                my $loggable_self = $self->_loggable;
                POE::Kernel::_warn(
                  "a '$state' event was sent from $file at $line to $loggable_self ",
                  "but $loggable_self has neither a handler for it ",
                  "nor one for _default\n"
                );
            }
            return undef;
        }

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

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

        # Transmogrify the original state transition into a corresponding
        # _default invocation.  ARG1 is copied from $etc so it can't be
        # altered from a distance.

        $etc   = [ $state, [@$etc] ];
        $state = EN_DEFAULT;
    }

    #####
    ## The following is unique/specific to POE::Session::PlainCall

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

    # Inline states are invoked this way.

    my $handler = $self->[SE_STATES]->{$state};
    if( ref $handler eq 'CODE') {
        local $POE_HOLDER = bless [
              ( undef,                          # object
                $self,                          # session
                $POE::Kernel::poe_kernel,       # kernel
                $self->[SE_NAMESPACE],          # heap
                $state,                         # state
                $source_session,                # sender
                undef,                          # unused #6
                $file,                          # caller file name
                $line,                          # caller file line
                $fromstate,                     # caller state
                undef,                          # method
                $etc                            # args
              ) ], 'POE::Session::PlainCall::Holder';
        return $handler->( @$etc );
    }

    # Package and object states are invoked this way.
    my ($object, $method) = @{$handler};
    local $POE_HOLDER  = bless [
      ( $object,                        # object
        $self,                          # session
        $POE::Kernel::poe_kernel,       # kernel
        $self->[SE_NAMESPACE],          # heap
        $state,                         # state
        $source_session,                # sender
        undef,                          # unused #6
        $file,                          # caller file name
        $line,                          # caller file line
        $fromstate,                     # caller state
        $method,                        # method
        $etc,                           # args
      ) ], 'POE::Session::PlainCall::Holder';

    return $object->$method( @$etc );

}

#######################################
sub _register_state
{
    my( $self, $name, @definition ) = @_;
    if( $self->[SE_MYSTATES]{$name} ) {
        return $self->state( $name, @definition );
    }
    else {
        # states created via POE::Kernel->state
        if( @definition ) {
            if ($self->[SE_OPTIONS]->{+OPT_TRACE}) {
                POE::Kernel::_warn( $self->_loggable, " -> $name is external\n" );
            }
        }
        else {
            # just in case something strange happened
            delete $self->[SE_MYSTATES]{$name};
        }
        $self->SUPER::_register_state( $name, @definition );
    }
}

#######################################
sub state
{
    my( $self, $name, @definition ) = @_;
    if( ! $self->[SE_MYSTATES]{$name} and
            $self->[SE_STATES]{$name} ) {
        croak "You may not redefine an event handler defined by a wheel or other external module.";
    }

    if( @definition ) {
        if ($self->[SE_OPTIONS]->{+OPT_TRACE}) {
            POE::Kernel::_warn( $self->_loggable, " -> $name is ours\n" );
        }
        $self->[SE_MYSTATES]{$name} = 1;
    }
    else {
        delete $self->[SE_MYSTATES]{$name};
    }
    $self->SUPER::_register_state( $name, @definition );
}

############################################################################
package POE::Session::PlainCall::Holder;

use strict;
use warnings;

# use POE::Session;
use Scalar::Util qw( blessed );

sub METHOD  { POE::Session::ARG0 }
sub ETC     { POE::Session::ARG1 }

sub object  { $_[0]->[POE::Session::OBJECT] }
sub package { my $r=$_[0]->[POE::Session::OBJECT]; blessed $r ? ref $r : $r }
sub session { $_[0]->[POE::Session::SESSION] }
sub kernel  { $POE::Kernel::poe_kernel }
sub heap    { $_[0]->[POE::Session::HEAP] }
sub state   { $_[0]->[POE::Session::STATE] }
sub event   { $_[0]->[POE::Session::STATE] }
sub method  { $_[0]->[METHOD] }
sub sender  { $_[0]->[POE::Session::SENDER]->ID }
sub SENDER () { $_[0]->[POE::Session::SENDER] }
sub caller_file  { $_[0]->[POE::Session::CALLER_FILE] }
sub caller_line  { $_[0]->[POE::Session::CALLER_LINE] }
sub caller_state { $_[0]->[POE::Session::CALLER_STATE] }
sub args {
    my $etc = $_[0]->[ETC];
    return wantarray ? @$etc : [ @$etc ]
}


# These would mess up ->caller_file and ->caller_line :-/
# sub post  { shift->[KERNEL]->post( @_ ) }
# sub call  { shift->[KERNEL]->call( @_ ) }
# sub yield  { shift->[KERNEL]->yield( @_ ) }


1;
__END__