line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package DBGp::Client::AsyncConnection; |
2
|
|
|
|
|
|
|
|
3
|
2
|
|
|
2
|
|
65037
|
use strict; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
46
|
|
4
|
2
|
|
|
2
|
|
7
|
use warnings; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
37
|
|
5
|
|
|
|
|
|
|
|
6
|
2
|
|
|
2
|
|
299
|
use DBGp::Client::AsyncStream; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
40
|
|
7
|
2
|
|
|
2
|
|
333
|
use DBGp::Client::Parser; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
use Scalar::Util; |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
sub new { |
11
|
|
|
|
|
|
|
my ($class, %args) = @_; |
12
|
|
|
|
|
|
|
my $stream = DBGp::Client::AsyncStream->new(socket => $args{socket}); |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
my $self = my $weak_self = bless { |
15
|
|
|
|
|
|
|
stream => $stream, |
16
|
|
|
|
|
|
|
sequence => 0, |
17
|
|
|
|
|
|
|
init => undef, |
18
|
|
|
|
|
|
|
commands => {}, |
19
|
|
|
|
|
|
|
on_stream => undef, |
20
|
|
|
|
|
|
|
on_notification => undef, |
21
|
|
|
|
|
|
|
}, $class; |
22
|
|
|
|
|
|
|
Scalar::Util::weaken($weak_self); |
23
|
|
|
|
|
|
|
$stream->on_line(sub { $weak_self->_receive_line(@_) }); |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
return $self; |
26
|
|
|
|
|
|
|
} |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
sub init { $_[0]->{init} } |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
sub send_command { |
31
|
|
|
|
|
|
|
my ($self, $callback, $command, @args) = @_; |
32
|
|
|
|
|
|
|
my $seq_id = ++$self->{sequence}; |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
$self->{commands}{$seq_id} = $callback; |
35
|
|
|
|
|
|
|
$self->{stream}->put_line($command, '-i', $seq_id, @args); |
36
|
|
|
|
|
|
|
} |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
sub add_data { $_[0]->{stream}->add_data($_[1]) } |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
sub closed { |
41
|
|
|
|
|
|
|
my ($self) = @_; |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
for my $transaction_id (keys %{$self->{commands}}) { |
44
|
|
|
|
|
|
|
my $error = bless { |
45
|
|
|
|
|
|
|
transaction_id => $transaction_id, |
46
|
|
|
|
|
|
|
code => 999, |
47
|
|
|
|
|
|
|
apperr => 1, |
48
|
|
|
|
|
|
|
message => "Broken connection", |
49
|
|
|
|
|
|
|
}, 'DBGp::Client::Response::InternalError'; |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
eval { |
52
|
|
|
|
|
|
|
delete($self->{commands}{$transaction_id})->($error); |
53
|
|
|
|
|
|
|
}; |
54
|
|
|
|
|
|
|
} |
55
|
|
|
|
|
|
|
} |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
sub _receive_line { |
58
|
|
|
|
|
|
|
my ($self, $line) = @_; |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
if (!$self->{init}) { |
61
|
|
|
|
|
|
|
$self->{init} = DBGp::Client::Parser::parse($line); |
62
|
|
|
|
|
|
|
} else { |
63
|
|
|
|
|
|
|
my $res = DBGp::Client::Parser::parse($line); |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
if ($res->is_oob) { |
66
|
|
|
|
|
|
|
if ($res->is_stream && $self->{on_stream}) { |
67
|
|
|
|
|
|
|
$self->{on_stream}->($res); |
68
|
|
|
|
|
|
|
} elsif ($res->is_notification && $self->{on_notification}) { |
69
|
|
|
|
|
|
|
$self->{on_notification}->($res); |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
} else { |
72
|
|
|
|
|
|
|
my $callback = delete $self->{commands}{$res->transaction_id}; |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
die 'Mismatched transaction IDs: ', $res->transaction_id |
75
|
|
|
|
|
|
|
unless $callback; |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
$callback->($res); |
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
} |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
sub on_stream { $_[0]->{on_stream} = $_[1] } |
83
|
|
|
|
|
|
|
sub on_notification { $_[0]->{on_notification} = $_[1] } |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
1; |