File Coverage

blib/lib/POE/Component/Generic/Object.pm

Criterion	Covered	Total	%
statement	4	6	66.6
branch			n/a
condition			n/a
subroutine	2	2	100.0
pod			n/a
total	6	8	75.0

package POE::Component::Generic::Object;
# $Id: Object.pm 762 2011-05-18 19:34:32Z fil $

use strict;

use POE;
use POE::Component::Generic;

use Scalar::Util qw( blessed reftype );
use Carp qw(carp croak);
use vars qw($AUTOLOAD);

use strict;

our $VERSION = '0.1400';

##################################################
# Create the object
# $obj_def was sent from Generic::Child->request
# $session_id and $package_map come from Generic
sub new
{
    my( $package, $obj_def, $session_id, $package_map ) = @_;

    my $self = bless {
            OBJid       => $obj_def->{OBJid},
            session_id  => $session_id,
            package     => $obj_def->{package}
        }, $package;

    $self->__package_map( $package_map, $obj_def->{methods} );

    return $self;
}

##################################################
# $package_map comes from Generic->new
# $methods came from the child
sub __package_map
{
    my( $self, $package_map, $methods ) = @_;

    unless( $package_map ) {
        my $c = $package_map = {};
        foreach my $method ( @$methods ) {
            my( $package, $m ) =
                POE::Component::Generic->__method_map( $method );
            next unless $m;
            $c->{$m} = $self->{package};
        }
    }
    $self->{package_map} = $package_map;
}

##################################################
sub AUTOLOAD
{
    my $self = shift;
    my $method = $AUTOLOAD;
    $method =~ s/.*:://;

    croak "$method not an object method" unless blessed $self;
    unless( $method =~ /[^A-Z]/ ) {
        croak qq( Can't locate object method "$method" via package ")
                .ref( $self ). qq("); #"
    }

    my $hash = shift;
    unless( reftype($hash) eq 'HASH' ) {
        croak "First argument to $method must be a hashref";
    }

    unless( $self->{package_map}{ $method } ) {
        croak qq(Can't locate object method "$method" via package ")
              .ref( $self ). qq("); #"
    }
    $hash->{wantarray} = wantarray() unless (defined($hash->{wantarray}));

    warn "autoload method $method" if ($self->{debug});


    $self->__request( $method, $hash, @_ );
}

##################################################
# Add our arguements to the hash
sub __request
{
    my( $self, $method, $hash ) = @_;

    unless( $self->{package_map}{ $method } or $method eq 'DESTROY' ) {
        croak "Unknown method $method for package $self->{package}";
    }

    $hash->{obj}     = $self->object_id;
    $hash->{package} = $self->{package};

    # use ->call() so that $generic->method() happens in order
    return $poe_kernel->call( $self->session_id => '__request2',
                                @_[1 .. $#_] );
}



############################################################################
# Object methods

sub session_id
{
    shift->{session_id};
}

sub object_id
{
    shift->{OBJid};
}

sub yield
{
    my $self = shift;
    if( 'HASH' eq (reftype( $_[2] )||'') ) { croak "Second argument must be a hashref" }
    return $self->__request( @_ );
}

sub call
{
    my $self = shift;
    if( 'HASH' eq (reftype( $_[2] )||'') ) { croak "Second argument must be a hashref" }
    return $self->__request( @_);
}

sub DESTROY
{
    if (UNIVERSAL::isa($_[0],__PACKAGE__)) {
        $_[0]->__request( 'DESTROY', {} );
    }
}

1;

__END__