File Coverage

blib/lib/POE/Session/Attribute.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

package POE::Session::Attribute ;

use strict ;
use warnings ;

use	POE qw(Session) ;
use	Attribute::Handlers ;
use	Class::ISA ;
use	Carp qw(croak) ;

our $VERSION = '0.80';

my	$states = {} ;

sub	Object : ATTR(CODE) { goto &__mod_attr }
sub	Package : ATTR(CODE) { goto &__mod_attr }
sub	Inline : ATTR(CODE) { goto &__mod_attr }
sub	state : ATTR(CODE) { goto &__mod_attr }

sub	__pkg_states {
    	my	$pkg = $_[-1] ;
	my	$st = $states->{$pkg} ;

	if (!$st) {
	    $st = {} ;
	    for (Class::ISA::super_path($pkg)) {
		if (my $pst = $states->{$_}) {
		    $st = { %$pst } ;
		    last ;
		}
	    }
	    $states->{$pkg} = $st ;
	}
	return $st ;
}

sub	__mod_attr {
	my	($pkg, $sym, $sub, $attr, $data, $phase) = @_ ;
	my	$handler = $sym ? *{$sym}{NAME} : $sub ;
	my	@states ;
	$attr = 'Inline' if $attr eq 'state' ;

	if ($data) {
	    @states = ref($data) eq 'ARRAY' ? (@$data) : ($data) ;
	} else {
	    @states = (*{$sym}{NAME}) or croak 'cannot determine state name' ;
	}

	croak "cannot use unnamed $sub as $attr state"
	    if $attr ne 'Inline' && !$sym ;

	$pkg->__pkg_states->{$_} = [$attr, $handler] for @states ;
}

sub	new { bless {}, shift }

sub	spawn { shift->create(args => [@_]) }

sub	create {
    	my	($class, %opts) = @_ ;
	my	$self ;

	for (my $i = 0;
		$class eq __PACKAGE__ || !$class->isa(__PACKAGE__); $i ++) {
	    my @c = caller($i) or last ;
	    $class = shift @c ;
	}

	croak 'cannot determine caller package' if $class eq __PACKAGE__ ;

	while (my ($state, $ar) = each %{$class->__pkg_states}) {
	    my ($attr, $handler) = @$ar ;

	    if ($attr eq 'Inline') {

		if (!ref($handler)) {
		    $handler = $class->can($handler) or
			croak "$class can't `$handler'"
		}
		($opts{inline_states} ||= {})->{$state} = $handler ;
	    } elsif ($attr eq 'Object') {
		my $t = ($opts{object_states} ||= [
			($self ||= $class->new(@{$opts{args} || []})) => {}
		]) ;
		$t->[1]->{$state} = $handler ;
	    } elsif ($attr eq 'Package') {
		my $t = ($opts{package_states} ||= [$class => {}]) ;
		$t->[1]->{$state} = $handler ;
	    } else {
		die "unknown attribute `$attr' for method $class -> $handler" ;
	    }
	}

	my $sid = POE::Session->create(%opts) ;
	return (wantarray && $self) ? ($sid, $self) : $sid ;
}

1;
__END__