ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/AnyEvent/lib/AnyEvent/Handle.pm
(Generate patch)

Comparing AnyEvent/lib/AnyEvent/Handle.pm (file contents):
Revision 1.101 by root, Thu Oct 23 19:03:30 2008 UTC vs.
Revision 1.115 by root, Tue Feb 10 13:58:49 2009 UTC

14 14
15AnyEvent::Handle - non-blocking I/O on file handles via AnyEvent 15AnyEvent::Handle - non-blocking I/O on file handles via AnyEvent
16 16
17=cut 17=cut
18 18
19our $VERSION = 4.3; 19our $VERSION = 4.331;
20 20
21=head1 SYNOPSIS 21=head1 SYNOPSIS
22 22
23 use AnyEvent; 23 use AnyEvent;
24 use AnyEvent::Handle; 24 use AnyEvent::Handle;
27 27
28 my $handle = 28 my $handle =
29 AnyEvent::Handle->new ( 29 AnyEvent::Handle->new (
30 fh => \*STDIN, 30 fh => \*STDIN,
31 on_eof => sub { 31 on_eof => sub {
32 $cv->broadcast; 32 $cv->send;
33 }, 33 },
34 ); 34 );
35 35
36 # send some request line 36 # send some request line
37 $handle->push_write ("getinfo\015\012"); 37 $handle->push_write ("getinfo\015\012");
255You can also provide your own TLS connection object, but you have 255You can also provide your own TLS connection object, but you have
256to make sure that you call either C<Net::SSLeay::set_connect_state> 256to make sure that you call either C<Net::SSLeay::set_connect_state>
257or C<Net::SSLeay::set_accept_state> on it before you pass it to 257or C<Net::SSLeay::set_accept_state> on it before you pass it to
258AnyEvent::Handle. 258AnyEvent::Handle.
259 259
260B<IMPORTANT:> since Net::SSLeay "objects" are really only integers,
261passing in the wrong integer will lead to certain crash. This most often
262happens when one uses a stylish C<< tls => 1 >> and is surprised about the
263segmentation fault.
264
260See the C<< ->starttls >> method for when need to start TLS negotiation later. 265See the C<< ->starttls >> method for when need to start TLS negotiation later.
261 266
262=item tls_ctx => $ssl_ctx 267=item tls_ctx => $ssl_ctx
263 268
264Use the given C<Net::SSLeay::CTX> object to create the new TLS connection 269Use the given C<Net::SSLeay::CTX> object to create the new TLS connection
374} 379}
375 380
376=item $handle->autocork ($boolean) 381=item $handle->autocork ($boolean)
377 382
378Enables or disables the current autocork behaviour (see C<autocork> 383Enables or disables the current autocork behaviour (see C<autocork>
379constructor argument). 384constructor argument). Changes will only take effect on the next write.
380 385
381=cut 386=cut
387
388sub autocork {
389 $_[0]{autocork} = $_[1];
390}
382 391
383=item $handle->no_delay ($boolean) 392=item $handle->no_delay ($boolean)
384 393
385Enables or disables the C<no_delay> setting (see constructor argument of 394Enables or disables the C<no_delay> setting (see constructor argument of
386the same name for details). 395the same name for details).
758 ) { 767 ) {
759 $self->_error (&Errno::ENOSPC, 1), return; 768 $self->_error (&Errno::ENOSPC, 1), return;
760 } 769 }
761 770
762 while () { 771 while () {
772 $self->{rbuf} .= delete $self->{tls_rbuf} if exists $self->{tls_rbuf};#d#
773
763 my $len = length $self->{rbuf}; 774 my $len = length $self->{rbuf};
764 775
765 if (my $cb = shift @{ $self->{_queue} }) { 776 if (my $cb = shift @{ $self->{_queue} }) {
766 unless ($cb->($self)) { 777 unless ($cb->($self)) {
767 if ($self->{_eof}) { 778 if ($self->{_eof}) {
1135 } 1146 }
1136}; 1147};
1137 1148
1138=item json => $cb->($handle, $hash_or_arrayref) 1149=item json => $cb->($handle, $hash_or_arrayref)
1139 1150
1140Reads a JSON object or array, decodes it and passes it to the callback. 1151Reads a JSON object or array, decodes it and passes it to the
1152callback. When a parse error occurs, an C<EBADMSG> error will be raised.
1141 1153
1142If a C<json> object was passed to the constructor, then that will be used 1154If a C<json> object was passed to the constructor, then that will be used
1143for the final decode, otherwise it will create a JSON coder expecting UTF-8. 1155for the final decode, otherwise it will create a JSON coder expecting UTF-8.
1144 1156
1145This read type uses the incremental parser available with JSON version 1157This read type uses the incremental parser available with JSON version
1162 my $rbuf = \$self->{rbuf}; 1174 my $rbuf = \$self->{rbuf};
1163 1175
1164 my $json = $self->{json} ||= JSON->new->utf8; 1176 my $json = $self->{json} ||= JSON->new->utf8;
1165 1177
1166 sub { 1178 sub {
1167 my $ref = $json->incr_parse ($self->{rbuf}); 1179 my $ref = eval { $json->incr_parse ($self->{rbuf}) };
1168 1180
1169 if ($ref) { 1181 if ($ref) {
1170 $self->{rbuf} = $json->incr_text; 1182 $self->{rbuf} = $json->incr_text;
1171 $json->incr_text = ""; 1183 $json->incr_text = "";
1172 $cb->($self, $ref); 1184 $cb->($self, $ref);
1173 1185
1174 1 1186 1
1187 } elsif ($@) {
1188 # error case
1189 $json->incr_skip;
1190
1191 $self->{rbuf} = $json->incr_text;
1192 $json->incr_text = "";
1193
1194 $self->_error (&Errno::EBADMSG);
1195
1196 ()
1175 } else { 1197 } else {
1176 $self->{rbuf} = ""; 1198 $self->{rbuf} = "";
1199
1177 () 1200 ()
1178 } 1201 }
1179 } 1202 }
1180}; 1203};
1181 1204
1322 delete $self->{_rw}; 1345 delete $self->{_rw};
1323 $self->{_eof} = 1; 1346 $self->{_eof} = 1;
1324 &_freetls; 1347 &_freetls;
1325 } 1348 }
1326 1349
1327 $self->{rbuf} .= $tmp; 1350 $self->{tls_rbuf} .= $tmp;#d#
1328 $self->_drain_rbuf unless $self->{_in_drain}; 1351 $self->_drain_rbuf unless $self->{_in_drain};
1329 $self->{tls} or return; # tls session might have gone away in callback 1352 $self->{tls} or return; # tls session might have gone away in callback
1330 } 1353 }
1331 1354
1332 $tmp = Net::SSLeay::get_error ($self->{tls}, -1); 1355 $tmp = Net::SSLeay::get_error ($self->{tls}, -1);
1371sub starttls { 1394sub starttls {
1372 my ($self, $ssl, $ctx) = @_; 1395 my ($self, $ssl, $ctx) = @_;
1373 1396
1374 require Net::SSLeay; 1397 require Net::SSLeay;
1375 1398
1376 Carp::croak "it is an error to call starttls more than once on an Anyevent::Handle object" 1399 Carp::croak "it is an error to call starttls more than once on an AnyEvent::Handle object"
1377 if $self->{tls}; 1400 if $self->{tls};
1378 1401
1379 if ($ssl eq "accept") { 1402 if ($ssl eq "accept") {
1380 $ssl = Net::SSLeay::new ($ctx || TLS_CTX ()); 1403 $ssl = Net::SSLeay::new ($ctx || TLS_CTX ());
1381 Net::SSLeay::set_accept_state ($ssl); 1404 Net::SSLeay::set_accept_state ($ssl);

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines