line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Protocol::HTTP2::Client; |
2
|
6
|
|
|
6
|
|
65319
|
use strict; |
|
6
|
|
|
|
|
13
|
|
|
6
|
|
|
|
|
161
|
|
3
|
6
|
|
|
6
|
|
29
|
use warnings; |
|
6
|
|
|
|
|
12
|
|
|
6
|
|
|
|
|
174
|
|
4
|
6
|
|
|
6
|
|
2952
|
use Protocol::HTTP2::Connection; |
|
6
|
|
|
|
|
22
|
|
|
6
|
|
|
|
|
268
|
|
5
|
6
|
|
|
|
|
2222
|
use Protocol::HTTP2::Constants qw(:frame_types :flags :states :endpoints |
6
|
6
|
|
|
6
|
|
37
|
:errors); |
|
6
|
|
|
|
|
10
|
|
7
|
6
|
|
|
6
|
|
34
|
use Protocol::HTTP2::Trace qw(tracer); |
|
6
|
|
|
|
|
11
|
|
|
6
|
|
|
|
|
246
|
|
8
|
6
|
|
|
6
|
|
31
|
use Carp; |
|
6
|
|
|
|
|
14
|
|
|
6
|
|
|
|
|
347
|
|
9
|
6
|
|
|
6
|
|
32
|
use Scalar::Util (); |
|
6
|
|
|
|
|
7
|
|
|
6
|
|
|
|
|
7593
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
=encoding utf-8 |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
=head1 NAME |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
Protocol::HTTP2::Client - HTTP/2 client |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
=head1 SYNOPSIS |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
use Protocol::HTTP2::Client; |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
# Create client object |
22
|
|
|
|
|
|
|
my $client = Protocol::HTTP2::Client->new; |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
# Prepare first request |
25
|
|
|
|
|
|
|
$client->request( |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
# HTTP/2 headers |
28
|
|
|
|
|
|
|
':scheme' => 'http', |
29
|
|
|
|
|
|
|
':authority' => 'localhost:8000', |
30
|
|
|
|
|
|
|
':path' => '/', |
31
|
|
|
|
|
|
|
':method' => 'GET', |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
# HTTP/1.1 headers |
34
|
|
|
|
|
|
|
headers => [ |
35
|
|
|
|
|
|
|
'accept' => '*/*', |
36
|
|
|
|
|
|
|
'user-agent' => 'perl-Protocol-HTTP2/0.13', |
37
|
|
|
|
|
|
|
], |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
# Callback when receive server's response |
40
|
|
|
|
|
|
|
on_done => sub { |
41
|
|
|
|
|
|
|
my ( $headers, $data ) = @_; |
42
|
|
|
|
|
|
|
... |
43
|
|
|
|
|
|
|
}, |
44
|
|
|
|
|
|
|
); |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
# Protocol::HTTP2 is just HTTP/2 protocol decoder/encoder |
47
|
|
|
|
|
|
|
# so you must create connection yourself |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
use AnyEvent; |
50
|
|
|
|
|
|
|
use AnyEvent::Socket; |
51
|
|
|
|
|
|
|
use AnyEvent::Handle; |
52
|
|
|
|
|
|
|
my $w = AnyEvent->condvar; |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
# Plain-text HTTP/2 connection |
55
|
|
|
|
|
|
|
tcp_connect 'localhost', 8000, sub { |
56
|
|
|
|
|
|
|
my ($fh) = @_ or die "connection failed: $!\n"; |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
my $handle; |
59
|
|
|
|
|
|
|
$handle = AnyEvent::Handle->new( |
60
|
|
|
|
|
|
|
fh => $fh, |
61
|
|
|
|
|
|
|
autocork => 1, |
62
|
|
|
|
|
|
|
on_error => sub { |
63
|
|
|
|
|
|
|
$_[0]->destroy; |
64
|
|
|
|
|
|
|
print "connection error\n"; |
65
|
|
|
|
|
|
|
$w->send; |
66
|
|
|
|
|
|
|
}, |
67
|
|
|
|
|
|
|
on_eof => sub { |
68
|
|
|
|
|
|
|
$handle->destroy; |
69
|
|
|
|
|
|
|
$w->send; |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
); |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
# First write preface to peer |
74
|
|
|
|
|
|
|
while ( my $frame = $client->next_frame ) { |
75
|
|
|
|
|
|
|
$handle->push_write($frame); |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
# Receive servers frames |
79
|
|
|
|
|
|
|
# Reply to server |
80
|
|
|
|
|
|
|
$handle->on_read( |
81
|
|
|
|
|
|
|
sub { |
82
|
|
|
|
|
|
|
my $handle = shift; |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
$client->feed( $handle->{rbuf} ); |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
$handle->{rbuf} = undef; |
87
|
|
|
|
|
|
|
while ( my $frame = $client->next_frame ) { |
88
|
|
|
|
|
|
|
$handle->push_write($frame); |
89
|
|
|
|
|
|
|
} |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
# Terminate connection if all done |
92
|
|
|
|
|
|
|
$handle->push_shutdown if $client->shutdown; |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
); |
95
|
|
|
|
|
|
|
}; |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
$w->recv; |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
=head1 DESCRIPTION |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
Protocol::HTTP2::Client is HTTP/2 client library. It's intended to make |
102
|
|
|
|
|
|
|
http2-client implementations on top of your favorite event-loop. |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
=head2 METHODS |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
=head3 new |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
Initialize new client object |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
my $client = Procotol::HTTP2::Client->new( %options ); |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
Availiable options: |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
=over |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
=item on_push => sub {...} |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
If server send push promise this callback will be invoked |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
on_push => sub { |
121
|
|
|
|
|
|
|
# received PUSH PROMISE headers |
122
|
|
|
|
|
|
|
my $pp_header = shift; |
123
|
|
|
|
|
|
|
... |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
# if we want reject this push |
126
|
|
|
|
|
|
|
# return undef |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
# if we want to accept pushed resource |
129
|
|
|
|
|
|
|
# return callback to receive data |
130
|
|
|
|
|
|
|
return sub { |
131
|
|
|
|
|
|
|
my ( $headers, $data ) = @_; |
132
|
|
|
|
|
|
|
... |
133
|
|
|
|
|
|
|
} |
134
|
|
|
|
|
|
|
}, |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
=item upgrade => 0|1 |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
Use HTTP/1.1 Upgrade to upgrade protocol from HTTP/1.1 to HTTP/2. Upgrade |
139
|
|
|
|
|
|
|
possible only on plain (non-tls) connection. |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
See |
142
|
|
|
|
|
|
|
L |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
=item on_error => sub {...} |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
Callback invoked on protocol errors |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
on_error => sub { |
149
|
|
|
|
|
|
|
my $error = shift; |
150
|
|
|
|
|
|
|
... |
151
|
|
|
|
|
|
|
}, |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
=item on_change_state => sub {...} |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
Callback invoked every time when http/2 streams change their state. |
156
|
|
|
|
|
|
|
See |
157
|
|
|
|
|
|
|
L |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
on_change_state => sub { |
160
|
|
|
|
|
|
|
my ( $stream_id, $previous_state, $current_state ) = @_; |
161
|
|
|
|
|
|
|
... |
162
|
|
|
|
|
|
|
}, |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
=back |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
=cut |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
sub new { |
169
|
16
|
|
|
16
|
1
|
44539
|
my ( $class, %opts ) = @_; |
170
|
|
|
|
|
|
|
my $self = { |
171
|
|
|
|
|
|
|
con => undef, |
172
|
|
|
|
|
|
|
input => '', |
173
|
|
|
|
|
|
|
active_streams => 0, |
174
|
|
|
|
|
|
|
settings => exists $opts{settings} ? $opts{settings} : {}, |
175
|
16
|
100
|
|
|
|
2855
|
}; |
176
|
|
|
|
|
|
|
|
177
|
16
|
50
|
|
|
|
2746
|
if ( exists $opts{on_push} ) { |
178
|
0
|
|
|
|
|
0
|
Scalar::Util::weaken( my $self = $self ); |
179
|
|
|
|
|
|
|
|
180
|
0
|
|
|
|
|
0
|
my $cb = delete $opts{on_push}; |
181
|
|
|
|
|
|
|
$opts{on_new_peer_stream} = sub { |
182
|
0
|
|
|
0
|
|
0
|
my $stream_id = shift; |
183
|
0
|
|
|
|
|
0
|
my $pp_headers; |
184
|
0
|
|
|
|
|
0
|
$self->active_streams(+1); |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
$self->{con}->stream_cb( |
187
|
|
|
|
|
|
|
$stream_id, |
188
|
|
|
|
|
|
|
RESERVED, |
189
|
|
|
|
|
|
|
sub { |
190
|
|
|
|
|
|
|
my $res = |
191
|
0
|
|
|
|
|
0
|
$cb->( $self->{con}->stream_pp_headers($stream_id) ); |
192
|
0
|
0
|
0
|
|
|
0
|
if ( $res && ref $cb eq 'CODE' ) { |
193
|
|
|
|
|
|
|
$self->{con}->stream_cb( |
194
|
|
|
|
|
|
|
$stream_id, |
195
|
|
|
|
|
|
|
CLOSED, |
196
|
|
|
|
|
|
|
sub { |
197
|
|
|
|
|
|
|
$res->( |
198
|
|
|
|
|
|
|
$self->{con}->stream_headers($stream_id), |
199
|
0
|
|
|
|
|
0
|
$self->{con}->stream_data($stream_id), |
200
|
|
|
|
|
|
|
); |
201
|
0
|
|
|
|
|
0
|
$self->active_streams(-1); |
202
|
|
|
|
|
|
|
} |
203
|
0
|
|
|
|
|
0
|
); |
204
|
|
|
|
|
|
|
} |
205
|
|
|
|
|
|
|
else { |
206
|
|
|
|
|
|
|
$self->{con} |
207
|
0
|
|
|
|
|
0
|
->stream_error( $stream_id, REFUSED_STREAM ); |
208
|
0
|
|
|
|
|
0
|
$self->active_streams(-1); |
209
|
|
|
|
|
|
|
} |
210
|
|
|
|
|
|
|
} |
211
|
0
|
|
|
|
|
0
|
); |
212
|
0
|
|
|
|
|
0
|
}; |
213
|
|
|
|
|
|
|
} |
214
|
|
|
|
|
|
|
|
215
|
16
|
|
|
|
|
2854
|
$self->{con} = Protocol::HTTP2::Connection->new( CLIENT, %opts ); |
216
|
16
|
|
|
|
|
5363
|
bless $self, $class; |
217
|
|
|
|
|
|
|
} |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
sub active_streams { |
220
|
28
|
|
|
28
|
0
|
4111
|
my $self = shift; |
221
|
28
|
|
50
|
|
|
4082
|
my $add = shift || 0; |
222
|
28
|
|
|
|
|
4128
|
$self->{active_streams} += $add; |
223
|
28
|
100
|
|
|
|
6814
|
$self->{con}->finish unless $self->{active_streams} > 0; |
224
|
|
|
|
|
|
|
} |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
=head3 request |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
Prepare HTTP/2 request. |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
$client->request( |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
# HTTP/2 headers |
233
|
|
|
|
|
|
|
':scheme' => 'http', |
234
|
|
|
|
|
|
|
':authority' => 'localhost:8000', |
235
|
|
|
|
|
|
|
':path' => '/items', |
236
|
|
|
|
|
|
|
':method' => 'POST', |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
# HTTP/1.1 headers |
239
|
|
|
|
|
|
|
headers => [ |
240
|
|
|
|
|
|
|
'content-type => 'application/x-www-form-urlencoded', |
241
|
|
|
|
|
|
|
'user-agent' => 'perl-Protocol-HTTP2/0.06', |
242
|
|
|
|
|
|
|
], |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
# Callback when receive server's response |
245
|
|
|
|
|
|
|
on_done => sub { |
246
|
|
|
|
|
|
|
my ( $headers, $data ) = @_; |
247
|
|
|
|
|
|
|
... |
248
|
|
|
|
|
|
|
}, |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
# Body of POST request |
251
|
|
|
|
|
|
|
data => "hello=world&test=done", |
252
|
|
|
|
|
|
|
); |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
You can chaining request one by one: |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
$client->request( 1-st request )->request( 2-nd request ); |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
Available callbacks: |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
=over |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
=item on_done => sub {...} |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
Invoked when full servers response is available |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
on_done => sub { |
267
|
|
|
|
|
|
|
my ( $headers, $data ) = @_; |
268
|
|
|
|
|
|
|
... |
269
|
|
|
|
|
|
|
}, |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
=item on_headers => sub {...} |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
Invoked as soon as headers have been successfully received from the server |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
on_headers => sub { |
276
|
|
|
|
|
|
|
my $headers = shift; |
277
|
|
|
|
|
|
|
... |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
# if we want reject any data |
280
|
|
|
|
|
|
|
# return undef |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
# continue |
283
|
|
|
|
|
|
|
return 1 |
284
|
|
|
|
|
|
|
} |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
=item on_data => sub {...} |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
If specified all data will be passed to this callback instead if on_done. |
289
|
|
|
|
|
|
|
on_done will receive empty string. |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
on_data => sub { |
292
|
|
|
|
|
|
|
my ( $partial_data, $headers ) = @_; |
293
|
|
|
|
|
|
|
... |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
# if we want cancel download |
296
|
|
|
|
|
|
|
# return undef |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
# continue downloading |
299
|
|
|
|
|
|
|
return 1 |
300
|
|
|
|
|
|
|
} |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
=back |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
=cut |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
my @must = (qw(:authority :method :path :scheme)); |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
sub request { |
309
|
18
|
|
|
18
|
1
|
6033
|
my ( $self, %h ) = @_; |
310
|
18
|
|
|
|
|
2710
|
my @miss = grep { !exists $h{$_} } @must; |
|
72
|
|
|
|
|
21560
|
|
311
|
18
|
50
|
|
|
|
2699
|
croak "Missing fields in request: @miss" if @miss; |
312
|
|
|
|
|
|
|
|
313
|
18
|
|
|
|
|
2766
|
$self->active_streams(+1); |
314
|
|
|
|
|
|
|
|
315
|
18
|
|
|
|
|
2708
|
my $con = $self->{con}; |
316
|
|
|
|
|
|
|
|
317
|
18
|
|
|
|
|
2945
|
my $stream_id = $con->new_stream; |
318
|
|
|
|
|
|
|
|
319
|
18
|
100
|
66
|
|
|
2771
|
if ( $con->upgrade && !exists $self->{sent_upgrade} ) { |
320
|
|
|
|
|
|
|
$con->enqueue_raw( |
321
|
|
|
|
|
|
|
$con->upgrade_request( |
322
|
4
|
|
|
|
|
204
|
( map { $_ => $h{$_} } @must ), |
323
|
1
|
50
|
|
|
|
15
|
headers => exists $h{headers} ? $h{headers} : [] |
324
|
|
|
|
|
|
|
) |
325
|
|
|
|
|
|
|
); |
326
|
1
|
|
|
|
|
30
|
$self->{sent_upgrade} = 1; |
327
|
1
|
|
|
|
|
53
|
$con->stream_state( $stream_id, HALF_CLOSED ); |
328
|
|
|
|
|
|
|
} |
329
|
|
|
|
|
|
|
else { |
330
|
17
|
100
|
|
|
|
2755
|
if ( !$con->preface ) { |
331
|
|
|
|
|
|
|
$con->enqueue_raw( $con->preface_encode ), |
332
|
15
|
|
|
|
|
2740
|
$con->enqueue( SETTINGS, 0, 0, $self->{settings} ); |
333
|
15
|
|
|
|
|
2715
|
$con->preface(1); |
334
|
|
|
|
|
|
|
} |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
$con->send_headers( |
337
|
|
|
|
|
|
|
$stream_id, |
338
|
|
|
|
|
|
|
[ |
339
|
68
|
|
|
|
|
21716
|
( map { $_ => $h{$_} } @must ), |
340
|
15
|
|
|
|
|
5505
|
exists $h{headers} ? @{ $h{headers} } : () |
341
|
|
|
|
|
|
|
], |
342
|
17
|
100
|
|
|
|
2725
|
exists $h{data} ? 0 : 1 |
|
|
100
|
|
|
|
|
|
343
|
|
|
|
|
|
|
); |
344
|
17
|
100
|
|
|
|
5469
|
$con->send_data( $stream_id, $h{data}, 1 ) if exists $h{data}; |
345
|
|
|
|
|
|
|
} |
346
|
|
|
|
|
|
|
|
347
|
18
|
|
|
|
|
2754
|
Scalar::Util::weaken $self; |
348
|
18
|
|
|
|
|
2778
|
Scalar::Util::weaken $con; |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
$con->stream_cb( |
351
|
|
|
|
|
|
|
$stream_id, |
352
|
|
|
|
|
|
|
CLOSED, |
353
|
|
|
|
|
|
|
sub { |
354
|
10
|
|
|
10
|
|
1407
|
$h{on_done}->( |
355
|
|
|
|
|
|
|
$con->stream_headers($stream_id), |
356
|
|
|
|
|
|
|
$con->stream_data($stream_id), |
357
|
|
|
|
|
|
|
); |
358
|
10
|
|
|
|
|
10659
|
$self->active_streams(-1); |
359
|
|
|
|
|
|
|
} |
360
|
18
|
100
|
|
|
|
2882
|
) if exists $h{on_done}; |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
$con->stream_frame_cb( |
363
|
|
|
|
|
|
|
$stream_id, |
364
|
|
|
|
|
|
|
HEADERS, |
365
|
|
|
|
|
|
|
sub { |
366
|
5
|
|
|
5
|
|
1454
|
my $res = $h{on_headers}->( $_[0] ); |
367
|
5
|
50
|
|
|
|
8900
|
return if $res; |
368
|
0
|
|
|
|
|
0
|
$con->stream_error( $stream_id, REFUSED_STREAM ); |
369
|
|
|
|
|
|
|
} |
370
|
18
|
100
|
|
|
|
2762
|
) if exists $h{on_headers}; |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
$con->stream_frame_cb( |
373
|
|
|
|
|
|
|
$stream_id, |
374
|
|
|
|
|
|
|
DATA, |
375
|
|
|
|
|
|
|
sub { |
376
|
5
|
|
|
5
|
|
1424
|
my $res = $h{on_data}->( $_[0], $con->stream_headers($stream_id), ); |
377
|
5
|
50
|
|
|
|
6050
|
return if $res; |
378
|
5
|
|
|
|
|
1412
|
$con->stream_error( $stream_id, REFUSED_STREAM ); |
379
|
|
|
|
|
|
|
} |
380
|
18
|
100
|
|
|
|
2904
|
) if exists $h{on_data}; |
381
|
|
|
|
|
|
|
|
382
|
18
|
|
|
|
|
5393
|
return $self; |
383
|
|
|
|
|
|
|
} |
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
=head3 shutdown |
386
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
Get connection status: |
388
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
=over |
390
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
=item 0 - active |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
=item 1 - closed (you can terminate connection) |
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
=back |
396
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
=cut |
398
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
sub shutdown { |
400
|
7
|
|
|
7
|
1
|
70
|
shift->{con}->shutdown; |
401
|
|
|
|
|
|
|
} |
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
=head3 next_frame |
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
get next frame to send over connection to server. |
406
|
|
|
|
|
|
|
Returns: |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
=over |
409
|
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
=item undef - on error |
411
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
=item 0 - nothing to send |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
=item binary string - encoded frame |
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
=back |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
# Example |
419
|
|
|
|
|
|
|
while ( my $frame = $client->next_frame ) { |
420
|
|
|
|
|
|
|
syswrite $fh, $frame; |
421
|
|
|
|
|
|
|
} |
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
=cut |
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
sub next_frame { |
426
|
125
|
|
|
125
|
1
|
78997
|
my $self = shift; |
427
|
125
|
|
|
|
|
22100
|
my $frame = $self->{con}->dequeue; |
428
|
125
|
100
|
|
|
|
22186
|
tracer->debug("send one frame to wire\n") if $frame; |
429
|
125
|
|
|
|
|
43464
|
return $frame; |
430
|
|
|
|
|
|
|
} |
431
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
=head3 feed |
433
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
Feed decoder with chunks of server's response |
435
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
sysread $fh, $binary_data, 4096; |
437
|
|
|
|
|
|
|
$client->feed($binary_data); |
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
=cut |
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
sub feed { |
442
|
69
|
|
|
69
|
1
|
93778
|
my ( $self, $chunk ) = @_; |
443
|
69
|
|
|
|
|
13695
|
$self->{input} .= $chunk; |
444
|
69
|
|
|
|
|
13587
|
my $offset = 0; |
445
|
69
|
|
|
|
|
13595
|
my $len; |
446
|
69
|
|
|
|
|
13692
|
my $con = $self->{con}; |
447
|
69
|
|
|
|
|
13651
|
tracer->debug( "got " . length($chunk) . " bytes on a wire\n" ); |
448
|
69
|
100
|
|
|
|
13756
|
if ( $con->upgrade ) { |
449
|
1
|
|
|
|
|
46
|
$len = $con->decode_upgrade_response( \$self->{input}, $offset ); |
450
|
1
|
50
|
|
|
|
19
|
$con->shutdown(1) unless defined $len; |
451
|
1
|
50
|
|
|
|
8
|
return unless $len; |
452
|
0
|
|
|
|
|
0
|
$offset += $len; |
453
|
0
|
|
|
|
|
0
|
$con->upgrade(0); |
454
|
0
|
|
|
|
|
0
|
$con->enqueue_raw( $con->preface_encode ); |
455
|
0
|
|
|
|
|
0
|
$con->preface(1); |
456
|
|
|
|
|
|
|
} |
457
|
68
|
|
|
|
|
13884
|
while ( $len = $con->frame_decode( \$self->{input}, $offset ) ) { |
458
|
70
|
|
|
|
|
13868
|
tracer->debug("decoded frame at $offset, length $len\n"); |
459
|
70
|
|
|
|
|
13785
|
$offset += $len; |
460
|
|
|
|
|
|
|
} |
461
|
68
|
50
|
|
|
|
40930
|
substr( $self->{input}, 0, $offset ) = '' if $offset; |
462
|
|
|
|
|
|
|
} |
463
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
1; |