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;