File Coverage

blib/lib/RPC/Object.pm

Criterion	Covered	Total	%
statement	18	46	39.1
branch	0	10	0.0
condition			n/a
subroutine	6	9	66.6
pod	0	1	0.0
total	24	66	36.3

package RPC::Object;
use strict;
use warnings;
use Carp;
use IO::Socket::INET;
use Storable qw(thaw nfreeze);
use RPC::Object::Common;

our $VERSION = '0.00_01';
$VERSION = eval $VERSION;

sub new {
    my $class = shift;
    my $url = shift;
    my ($host, $port) = $url =~ m{([^:]+):(\d+)};
    my $obj = _invoke($host, $port, @_);
    my $self = {
                host => $host,
                port => $port,
                object => $obj,
               };
    return bless $self, $class;
}

sub AUTOLOAD {
    my $self = shift;
    my $name = (split '::', our $AUTOLOAD)[-1];
    return if $name eq 'DESTROY';
    return _invoke($self->{host}, $self->{port}, $name, $self->{object}, @_);
}

sub _invoke {
    my $host = shift;
    my $port = shift;
    my $sock = IO::Socket::INET->new(PeerAddr => $host,
                                     PeerPort => $port,
                                     Proto => 'tcp',
                                     Type => SOCK_STREAM,
                                    );
    binmode $sock;
    print {$sock} nfreeze([wantarray ? WANT_LIST : WANT_SCALAR, @_]);
    $sock->shutdown(1);
    my $res = do { local $/; <$sock> };
    $sock->close();
    my ($stat, @ret) = @{thaw($res)};
    if ($stat eq RESPONSE_ERROR) {
        croak @ret;
    }
    elsif ($stat eq RESPONSE_NORMAL) {
        return wantarray ? @ret : $ret[0];
    }
    else {
        croak "Unknown response";
    }
    return;
}

1;
__END__