File Coverage

blib/lib/Net/IMP/Remote/Client.pm
Criterion Covered Total %
statement 27 67 40.3
branch 0 14 0.0
condition 0 4 0.0
subroutine 9 18 50.0
pod 5 7 71.4
total 41 110 37.2


line stmt bran cond sub pod time code
1 1     1   4 use strict;
  1         1  
  1         28  
2 1     1   4 use warnings;
  1         1  
  1         95  
3              
4             package Net::IMP::Remote::Client;
5 1     1   6 use base 'Net::IMP::Base';
  1         1  
  1         124  
6 1     1   14 use fields qw(id);
  1         2  
  1         11  
7 1     1   50 use Net::IMP;
  1         2  
  1         638  
8 1     1   685 use Net::IMP::Remote::Protocol;
  1         2  
  1         115  
9 1     1   7 use Net::IMP::Debug;
  1         1  
  1         8  
10 1     1   110 use Scalar::Util 'weaken';
  1         2  
  1         37  
11 1     1   4 use Carp;
  1         1  
  1         699  
12              
13             sub new_factory {
14 0     0 1   my ($class,%args) = @_;
15 0           my $self = $class->SUPER::new_factory(%args);
16              
17 0           weaken( my $wself = $self );
18             $self->{factory_args}{conn}->nextop({
19             IMPRPC_EXCEPTION+0 => [ \&exception, $wself ],
20             IMPRPC_RESULT+0 => sub {
21 0     0     my $id = shift;
22 0           my $obj = $wself->{factory_args}{conn}->get_analyzer($id);
23 0 0         $obj->run_callback(\@_) if ref $obj;
24             },
25 0           }, -1 );
26 0           return $self;
27             }
28              
29             sub get_interface {
30 0     0 1   my ($self,@if) = @_;
31 0           my @analyzer_if;
32 0 0         if ( $self->{factory_args}{conn}->rpc(
33             [ IMPRPC_GET_INTERFACE, @if ],
34             {
35             IMPRPC_EXCEPTION+0 => [ \&exception, $self ],
36             IMPRPC_INTERFACE+0 => \@analyzer_if,
37             }
38             )) {
39 0           return @analyzer_if;
40             } else {
41             return
42 0           }
43             }
44              
45             sub set_interface {
46 0     0 1   my ($self,$if) = @_;
47 0           $self->{factory_args}{conn}->rpc([ IMPRPC_SET_INTERFACE,$if ]);
48 0           return $self;
49             }
50              
51             sub new_analyzer {
52 0     0 1   my ($self,%ctx) = @_;
53 0           my $obj = $self->SUPER::new_analyzer(%ctx);
54 0           my $conn = $self->{factory_args}{conn};
55 0           my $id = $obj->{id} = $conn->weak_add_analyzer($obj);
56 0           $conn->rpc([ IMPRPC_NEW_ANALYZER,$id,\%ctx ]);
57 0           return $obj;
58             }
59              
60             sub data {
61 0     0 1   my ($self,$dir,$data,$offset,$type) = @_;
62 0   0       $self->{factory_args}{conn}->rpc([ IMPRPC_DATA,
      0        
63             $self->{id} || die("data called on factory not analyzer"),
64             $dir,$offset,$type//IMP_DATA_STREAM,$data ]);
65             }
66              
67             sub close {
68 0     0 0   my ($self,$why) = @_;
69 0           debug("destroy @_");
70 0 0         my $conn = $self->{factory_args}{conn} or return;
71 0 0         if ( my $id = $self->{id} ) {
72 0 0         warn "[$id] $why\n" if $why;
73 0           $conn->del_analyzer($id);
74 0           $conn->rpc([ IMPRPC_DEL_ANALYZER,$id ]);
75             } else {
76 0           $self->{factory_args}{conn}->close($why);
77             }
78 0           1;
79             }
80              
81 0     0     sub DESTROY { goto &close }
82              
83             sub exception {
84 0     0 0   my ($self,$id,$msg) = @_;
85 0 0         if ( $id ) {
86 0 0         if ( my $obj = $self->{factory_args}{conn}->get_analyzer($id) ) {
87 0           $obj->close($msg);
88             } else {
89 0           warn "[$id/unknown] $msg\n"
90             }
91             } else {
92 0           $self->close("global exception: $msg");
93             }
94             }
95              
96              
97              
98             1;
99             __END__