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__ |