File Coverage

blib/lib/MooX/POE.pm

Criterion	Covered	Total	%
statement	43	61	70.4
branch	6	8	75.0
condition	1	2	50.0
subroutine	13	22	59.0
pod	0	16	0.0
total	63	109	57.8

package MooX::POE;
our $AUTHORITY = 'cpan:GETTY';
# ABSTRACT: POE::Session combined with Moo (or Moose, if you want)
$MooX::POE::VERSION = '0.001';
use Moo::Role;
use Package::Stash;

use POE qw(
  Session
);

sub BUILD {
  my $self = shift;
  my $ps = Package::Stash->new(ref $self);
  my $session = POE::Session->create(
    inline_states => {
      _start => sub { POE::Kernel->yield('STARTALL', \$_[5] ) },
      map {
        my $func = $_;
        my ( $event ) = $func =~ /^on_(.*)$/;
        $event, sub {
          my ( @args ) = @_[ ARG0..$#_ ];
          $self->$func(@args);
        };
      } grep { /^on_/ } $ps->list_all_symbols('CODE'),
    },
    object_states => [
      $self => {
        STARTALL => 'STARTALL',
        _stop    => 'STOPALL',
        $self->can('CHILD') ? ( _child => 'CHILD' ) : (),
        $self->can('PARENT') ? ( _parent => 'PARENT' ) : (),
        _call_kernel_with_my_session => '_call_kernel_with_my_session',
      },
    ],
    args => [ $self ],
    heap => ( $self->{heap} ||= {} ),
  );
  $self->{session_id} = $session->ID;
}

sub get_session_id {
  my ( $self ) = @_;
  return $self->{session_id};
}

sub yield { my $self = shift; POE::Kernel->post( $self->get_session_id, @_ ) }
sub call { my $self = shift; POE::Kernel->call( $self->get_session_id, @_ ) }

sub _call_kernel_with_my_session {
  my ( $self, $function, @args ) = @_[ OBJECT, ARG0..$#_ ];
  POE::Kernel->$function( @args );
}

sub delay { my $self = shift; $self->call( _call_kernel_with_my_session => 'delay' => @_ ) }
sub alarm { my $self = shift; $self->call( _call_kernel_with_my_session => 'alarm', @_ ) }
sub alarm_add { my $self = shift; $self->call( _call_kernel_with_my_session => 'alarm_add', @_ ) }
sub delay_add { my $self = shift; $self->call( _call_kernel_with_my_session => 'delay_add', @_ ) }
sub alarm_set { my $self = shift; $self->call( _call_kernel_with_my_session => 'alarm_set', @_ ) }
sub alarm_adjust { my $self = shift; $self->call( _call_kernel_with_my_session => 'alarm_adjust', @_ ) }
sub alarm_remove { my $self = shift; $self->call( _call_kernel_with_my_session => 'alarm_remove', @_ ) }
sub alarm_remove_all { my $self = shift; $self->call( _call_kernel_with_my_session => 'alarm_remove_all', @_ ) }
sub delay_set { my $self = shift; $self->call( _call_kernel_with_my_session => 'delay_set', @_ ) }
sub delay_adjust { my $self = shift; $self->call( _call_kernel_with_my_session => 'delay_adjust', @_ ) }

sub STARTALL {
  my ( $self, @params ) = @_;
  $params[4] = pop @params;
  my @isa = @{mro::get_linear_isa(ref $self)};
  for my $caller (@isa) {
    my $can = $caller->can('START');
    $can->( $self, @params ) if $can;
  }
}

sub STOPALL {
  my ( $self, $params ) = @_;
  my @isa = @{mro::get_linear_isa(ref $self)};
  for my $caller (@isa) {
    my $can = $caller->can('STOP');
    $can->( $self, $params ) if $can;
  }
}

1;

__END__