File Coverage

blib/lib/Patro/N5.pm

Criterion	Covered	Total	%
statement	42	59	71.1
branch	8	20	40.0
condition	0	3	0.0
subroutine	21	24	87.5
pod			n/a
total	71	106	66.9

package Patro::N5;
use strict;
use warnings;

# Patro::N5. Proxy class for GLOB type references.

# we must keep this namespace very clean   <--- is this true for GLOB?
use Carp ();

use overload
    '*{}' => sub { ${$_[0]}->{handle} },
    '-X' => \&Patro::N5x::dash_X,
    'nomethod' => \&Patro::LeumJelly::overload_handler,
    ;

sub _tied { return tied(*{${$_[0]}->{handle}}) }
sub Patro::N5x::dash_X { return $_[0]->_tied->__('-X',1,$_[1]); }



sub AUTOLOAD {
    my $method = $Patro::N5::AUTOLOAD;
    $method =~ s/.*:://;

    # is this useful with GLOB type?

    my $self = shift;
    my $has_args = @_ > 0;
    my $args = [ @_ ];

    my $context = defined(wantarray) ? 1 + wantarray : 0;

    return Patro::LeumJelly::proxy_request( $$self,
	{ id => $$self->{id},
	  topic => 'METHOD',
	  command => $method,
	  has_args => $has_args,
	  args => $args,
	  context => $context,
	  _autoload => 1 }, @_ );
}

sub DESTROY {
    my $self = shift;
    if ($$self->{_DESTROY}++) {
	return;
    }
    my $socket = $$self->{socket};
    if ($socket) {

	# XXX - shouldn't disconnect on every object destruction,
	# only when all of the wrapped objects associated with a
	# client have been destroyed, or during global
	# destruction

	my $response = Patro::LeumJelly::proxy_request(
	    $$self,
	    { id => $$self->{id},
	      topic => 'META',
	      #command => 'disconnect' } );
	      command => 'destroy' } );
	if (!CORE::ref($response) || $response->{disconnect_ok}) {
	    close $socket;
	    delete $$self->{socket};
	}
    }
}

############################################################

sub Patro::Tie::HANDLE::TIEHANDLE {
    my ($pkg,$proxy) = @_;
    return bless { obj => $proxy, id => $proxy->{id} }, $pkg;
}

sub Patro::Tie::HANDLE::__ {
    my $tied = shift;
    my $name = shift;
    my $context = shift;
    if (!defined($context)) {
	$context = defined(wantarray) ? 1 + wantarray : 0;
    }
    return Patro::LeumJelly::proxy_request(
	$tied->{obj},
	{ topic => 'HANDLE',
	  command => $name,
	  context => $context,
	  has_args => @_ > 0,
	  args => [ @_ ],
	  id => $tied->{id} }, @_ );
}

sub Patro::Tie::HANDLE::PRINT { return shift->__('PRINT',1,@_?@_:$_) }
sub Patro::Tie::HANDLE::PRINTF { return shift->__('PRINTF',1,@_?@_:$_) }
sub Patro::Tie::HANDLE::WRITE { return shift->__('WRITE',1,@_) }
sub Patro::Tie::HANDLE::READLINE { return shift->__('READLINE',undef,@_) }
sub Patro::Tie::HANDLE::GETC { return shift->__('GETC',1,@_) }
sub Patro::Tie::HANDLE::READ {
    my $command = 'READ?';
    if ($Patro::read_sysread_flag eq 'read') {
	$command = 'READ';
    } elsif ($Patro::read_sysread_flag eq 'sysread') {
	$command = 'SYSREAD';
    }
    return shift->__($command,1,@_)
}
sub Patro::Tie::HANDLE::CLOSE { return shift->__('CLOSE',1,@_) }
sub Patro::Tie::HANDLE::BINMODE { return shift->__('BINMODE',1,@_) }
sub Patro::Tie::HANDLE::OPEN { return shift->__('OPEN',1,@_) }
sub Patro::Tie::HANDLE::EOF { return shift->__('EOF',1,@_) }
sub Patro::Tie::HANDLE::FILENO { return shift->__('FILENO',1,@_) }
sub Patro::Tie::HANDLE::SEEK { return shift->__('SEEK',1,@_) }
sub Patro::Tie::HANDLE::TELL { return shift->__('TELL',1,@_) }

############################################################

1;