File Coverage

blib/lib/Patro/N5.pm
Criterion Covered Total %
statement 42 59 71.1
branch 8 20 40.0
condition n/a
subroutine 21 24 87.5
pod n/a
total 71 103 68.9


line stmt bran cond sub pod time code
1             package Patro::N5;
2 4     4   34 use strict;
  4         15  
  4         192  
3 4     4   25 use warnings;
  4         8  
  4         197  
4              
5             # Patro::N5. Proxy class for GLOB type references.
6              
7             # we must keep this namespace very clean <--- is this true for GLOB?
8 4     4   22 use Carp ();
  4         9  
  4         383  
9              
10             use overload
11 54     54   20702 '*{}' => sub { ${$_[0]}->{handle} },
  54         295  
12 4         119 '-X' => \&Patro::N5x::dash_X,
13             'nomethod' => \&Patro::LeumJelly::overload_handler,
14 4     4   60 ;
  4         7  
15              
16 6     6   7 sub _tied { return tied(*{${$_[0]}->{handle}}) }
  6         8  
  6         27  
17 3     3   1123 sub Patro::N5x::dash_X { return $_[0]->_tied->__('-X',1,$_[1]); }
18              
19              
20              
21             sub AUTOLOAD {
22 0     0   0 my $method = $Patro::N5::AUTOLOAD;
23 0         0 $method =~ s/.*:://;
24              
25             # is this useful with GLOB type?
26            
27 0         0 my $self = shift;
28 0         0 my $has_args = @_ > 0;
29 0         0 my $args = [ @_ ];
30              
31 0 0       0 my $context = defined(wantarray) ? 1 + wantarray : 0;
32              
33             return Patro::LeumJelly::proxy_request( $$self,
34             { id => $$self->{id},
35 0         0 topic => 'METHOD',
36             command => $method,
37             has_args => $has_args,
38             args => $args,
39             context => $context,
40             _autoload => 1 }, @_ );
41             }
42              
43             sub DESTROY {
44 0     0   0 my $self = shift;
45 0 0       0 if ($$self->{_DESTROY}++) {
46 0         0 return;
47             }
48 0         0 my $socket = $$self->{socket};
49 0 0       0 if ($socket) {
50              
51             # XXX - shouldn't disconnect on every object destruction,
52             # only when all of the wrapped objects associated with a
53             # client have been destroyed, or during global
54             # destruction
55              
56             my $response = Patro::LeumJelly::proxy_request(
57             $$self,
58             { id => $$self->{id},
59 0         0 topic => 'META',
60             #command => 'disconnect' } );
61             command => 'destroy' } );
62 0 0       0 if ($response->{disconnect_ok}) {
63 0         0 close $socket;
64 0         0 delete $$self->{socket};
65             }
66             }
67             }
68              
69             ############################################################
70              
71             sub Patro::Tie::HANDLE::TIEHANDLE {
72 6     6   26 my ($pkg,$proxy) = @_;
73 6         31 return bless { obj => $proxy, id => $proxy->{id} }, $pkg;
74             }
75              
76             sub Patro::Tie::HANDLE::__ {
77 60     60   98 my $tied = shift;
78 60         82 my $name = shift;
79 60         87 my $context = shift;
80 60 100       143 if (!defined($context)) {
81 13 50       32 $context = defined(wantarray) ? 1 + wantarray : 0;
82             }
83             return Patro::LeumJelly::proxy_request(
84             $tied->{obj},
85             { topic => 'HANDLE',
86             command => $name,
87             context => $context,
88             has_args => @_ > 0,
89             args => [ @_ ],
90 60         546 id => $tied->{id} }, @_ );
91             }
92              
93 6 50   6   27 sub Patro::Tie::HANDLE::PRINT { return shift->__('PRINT',1,@_?@_:$_) }
94 1 50   1   7 sub Patro::Tie::HANDLE::PRINTF { return shift->__('PRINTF',1,@_?@_:$_) }
95 0     0   0 sub Patro::Tie::HANDLE::WRITE { return shift->__('WRITE',1,@_) }
96 13     13   43 sub Patro::Tie::HANDLE::READLINE { return shift->__('READLINE',undef,@_) }
97 5     5   16 sub Patro::Tie::HANDLE::GETC { return shift->__('GETC',1,@_) }
98             sub Patro::Tie::HANDLE::READ {
99 3     3   6 my $command = 'READ?';
100 3 100       11 if ($Patro::read_sysread_flag eq 'read') {
    50          
101 2         2 $command = 'READ';
102             } elsif ($Patro::read_sysread_flag eq 'sysread') {
103 1         3 $command = 'SYSREAD';
104             }
105 3         9 return shift->__($command,1,@_)
106             }
107 5     5   18 sub Patro::Tie::HANDLE::CLOSE { return shift->__('CLOSE',1,@_) }
108 3     3   10 sub Patro::Tie::HANDLE::BINMODE { return shift->__('BINMODE',1,@_) }
109 5     5   19 sub Patro::Tie::HANDLE::OPEN { return shift->__('OPEN',1,@_) }
110 2     2   6 sub Patro::Tie::HANDLE::EOF { return shift->__('EOF',1,@_) }
111 1     1   4 sub Patro::Tie::HANDLE::FILENO { return shift->__('FILENO',1,@_) }
112 2     2   9 sub Patro::Tie::HANDLE::SEEK { return shift->__('SEEK',1,@_) }
113 8     8   22 sub Patro::Tie::HANDLE::TELL { return shift->__('TELL',1,@_) }
114              
115             ############################################################
116              
117             1;