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.38 by root, Mon May 26 21:28:33 2008 UTC vs.
Revision 1.52 by root, Mon Jun 2 09:10:38 2008 UTC

2 2
3no warnings; 3no warnings;
4use strict; 4use strict;
5 5
6use AnyEvent (); 6use AnyEvent ();
7use AnyEvent::Util qw(WSAWOULDBLOCK); 7use AnyEvent::Util qw(WSAEWOULDBLOCK);
8use Scalar::Util (); 8use Scalar::Util ();
9use Carp (); 9use Carp ();
10use Fcntl (); 10use Fcntl ();
11use Errno qw/EAGAIN EINTR/; 11use Errno qw(EAGAIN EINTR);
12 12
13=head1 NAME 13=head1 NAME
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 = '0.04'; 19our $VERSION = 4.1;
20 20
21=head1 SYNOPSIS 21=head1 SYNOPSIS
22 22
23 use AnyEvent; 23 use AnyEvent;
24 use AnyEvent::Handle; 24 use AnyEvent::Handle;
73The filehandle this L<AnyEvent::Handle> object will operate on. 73The filehandle this L<AnyEvent::Handle> object will operate on.
74 74
75NOTE: The filehandle will be set to non-blocking (using 75NOTE: The filehandle will be set to non-blocking (using
76AnyEvent::Util::fh_nonblocking). 76AnyEvent::Util::fh_nonblocking).
77 77
78=item on_eof => $cb->($self) 78=item on_eof => $cb->($handle)
79 79
80Set the callback to be called on EOF. 80Set the callback to be called when an end-of-file condition is detcted,
81i.e. in the case of a socket, when the other side has closed the
82connection cleanly.
81 83
82While not mandatory, it is highly recommended to set an eof callback, 84While not mandatory, it is highly recommended to set an eof callback,
83otherwise you might end up with a closed socket while you are still 85otherwise you might end up with a closed socket while you are still
84waiting for data. 86waiting for data.
85 87
86=item on_error => $cb->($self) 88=item on_error => $cb->($handle, $fatal)
87 89
88This is the fatal error callback, that is called when, well, a fatal error 90This is the error callback, which is called when, well, some error
89occurs, such as not being able to resolve the hostname, failure to connect 91occured, such as not being able to resolve the hostname, failure to
90or a read error. 92connect or a read error.
91 93
92The object will not be in a usable state when this callback has been 94Some errors are fatal (which is indicated by C<$fatal> being true). On
93called. 95fatal errors the handle object will be shut down and will not be
96usable. Non-fatal errors can be retried by simply returning, but it is
97recommended to simply ignore this parameter and instead abondon the handle
98object when this callback is invoked.
94 99
95On callback entrance, the value of C<$!> contains the operating system 100On callback entrance, the value of C<$!> contains the operating system
96error (or C<ENOSPC>, C<EPIPE> or C<EBADMSG>). 101error (or C<ENOSPC>, C<EPIPE>, C<ETIMEDOUT> or C<EBADMSG>).
97
98The callback should throw an exception. If it returns, then
99AnyEvent::Handle will C<croak> for you.
100 102
101While not mandatory, it is I<highly> recommended to set this callback, as 103While not mandatory, it is I<highly> recommended to set this callback, as
102you will not be notified of errors otherwise. The default simply calls 104you will not be notified of errors otherwise. The default simply calls
103die. 105C<croak>.
104 106
105=item on_read => $cb->($self) 107=item on_read => $cb->($handle)
106 108
107This sets the default read callback, which is called when data arrives 109This sets the default read callback, which is called when data arrives
108and no read request is in the queue. 110and no read request is in the queue.
109 111
110To access (and remove data from) the read buffer, use the C<< ->rbuf >> 112To access (and remove data from) the read buffer, use the C<< ->rbuf >>
111method or access the C<$self->{rbuf}> member directly. 113method or access the C<$handle->{rbuf}> member directly.
112 114
113When an EOF condition is detected then AnyEvent::Handle will first try to 115When an EOF condition is detected then AnyEvent::Handle will first try to
114feed all the remaining data to the queued callbacks and C<on_read> before 116feed all the remaining data to the queued callbacks and C<on_read> before
115calling the C<on_eof> callback. If no progress can be made, then a fatal 117calling the C<on_eof> callback. If no progress can be made, then a fatal
116error will be raised (with C<$!> set to C<EPIPE>). 118error will be raised (with C<$!> set to C<EPIPE>).
117 119
118=item on_drain => $cb->() 120=item on_drain => $cb->($handle)
119 121
120This sets the callback that is called when the write buffer becomes empty 122This sets the callback that is called when the write buffer becomes empty
121(or when the callback is set and the buffer is empty already). 123(or when the callback is set and the buffer is empty already).
122 124
123To append to the write buffer, use the C<< ->push_write >> method. 125To append to the write buffer, use the C<< ->push_write >> method.
126
127=item timeout => $fractional_seconds
128
129If non-zero, then this enables an "inactivity" timeout: whenever this many
130seconds pass without a successful read or write on the underlying file
131handle, the C<on_timeout> callback will be invoked (and if that one is
132missing, an C<ETIMEDOUT> error will be raised).
133
134Note that timeout processing is also active when you currently do not have
135any outstanding read or write requests: If you plan to keep the connection
136idle then you should disable the timout temporarily or ignore the timeout
137in the C<on_timeout> callback.
138
139Zero (the default) disables this timeout.
140
141=item on_timeout => $cb->($handle)
142
143Called whenever the inactivity timeout passes. If you return from this
144callback, then the timeout will be reset as if some activity had happened,
145so this condition is not fatal in any way.
124 146
125=item rbuf_max => <bytes> 147=item rbuf_max => <bytes>
126 148
127If defined, then a fatal error will be raised (with C<$!> set to C<ENOSPC>) 149If defined, then a fatal error will be raised (with C<$!> set to C<ENOSPC>)
128when the read buffer ever (strictly) exceeds this size. This is useful to 150when the read buffer ever (strictly) exceeds this size. This is useful to
135isn't finished). 157isn't finished).
136 158
137=item read_size => <bytes> 159=item read_size => <bytes>
138 160
139The default read block size (the amount of bytes this module will try to read 161The default read block size (the amount of bytes this module will try to read
140on each [loop iteration). Default: C<4096>. 162during each (loop iteration). Default: C<8192>.
141 163
142=item low_water_mark => <bytes> 164=item low_water_mark => <bytes>
143 165
144Sets the amount of bytes (default: C<0>) that make up an "empty" write 166Sets the amount of bytes (default: C<0>) that make up an "empty" write
145buffer: If the write reaches this size or gets even samller it is 167buffer: If the write reaches this size or gets even samller it is
168 190
169Use the given Net::SSLeay::CTX object to create the new TLS connection 191Use the given Net::SSLeay::CTX object to create the new TLS connection
170(unless a connection object was specified directly). If this parameter is 192(unless a connection object was specified directly). If this parameter is
171missing, then AnyEvent::Handle will use C<AnyEvent::Handle::TLS_CTX>. 193missing, then AnyEvent::Handle will use C<AnyEvent::Handle::TLS_CTX>.
172 194
195=item json => JSON or JSON::XS object
196
197This is the json coder object used by the C<json> read and write types.
198
199If you don't supply it, then AnyEvent::Handle will create and use a
200suitable one, which will write and expect UTF-8 encoded JSON texts.
201
202Note that you are responsible to depend on the JSON module if you want to
203use this functionality, as AnyEvent does not have a dependency itself.
204
173=item filter_r => $cb 205=item filter_r => $cb
174 206
175=item filter_w => $cb 207=item filter_w => $cb
176 208
177These exist, but are undocumented at this time. 209These exist, but are undocumented at this time.
192 if ($self->{tls}) { 224 if ($self->{tls}) {
193 require Net::SSLeay; 225 require Net::SSLeay;
194 $self->starttls (delete $self->{tls}, delete $self->{tls_ctx}); 226 $self->starttls (delete $self->{tls}, delete $self->{tls_ctx});
195 } 227 }
196 228
197 $self->on_eof (delete $self->{on_eof} ) if $self->{on_eof}; 229# $self->on_eof (delete $self->{on_eof} ) if $self->{on_eof}; # nop
198 $self->on_error (delete $self->{on_error}) if $self->{on_error}; 230# $self->on_error (delete $self->{on_error}) if $self->{on_error}; # nop
231# $self->on_read (delete $self->{on_read} ) if $self->{on_read}; # nop
199 $self->on_drain (delete $self->{on_drain}) if $self->{on_drain}; 232 $self->on_drain (delete $self->{on_drain}) if $self->{on_drain};
200 $self->on_read (delete $self->{on_read} ) if $self->{on_read}; 233
234 $self->{_activity} = AnyEvent->now;
235 $self->_timeout;
201 236
202 $self->start_read; 237 $self->start_read;
203 238
204 $self 239 $self
205} 240}
206 241
207sub _shutdown { 242sub _shutdown {
208 my ($self) = @_; 243 my ($self) = @_;
209 244
245 delete $self->{_tw};
210 delete $self->{_rw}; 246 delete $self->{_rw};
211 delete $self->{_ww}; 247 delete $self->{_ww};
212 delete $self->{fh}; 248 delete $self->{fh};
213}
214 249
250 $self->stoptls;
251}
252
215sub error { 253sub _error {
216 my ($self) = @_; 254 my ($self, $errno, $fatal) = @_;
217 255
218 {
219 local $!;
220 $self->_shutdown; 256 $self->_shutdown
221 } 257 if $fatal;
222 258
223 $self->{on_error}($self) 259 $! = $errno;
260
224 if $self->{on_error}; 261 if ($self->{on_error}) {
225 262 $self->{on_error}($self, $fatal);
263 } else {
226 Carp::croak "AnyEvent::Handle uncaught fatal error: $!"; 264 Carp::croak "AnyEvent::Handle uncaught error: $!";
265 }
227} 266}
228 267
229=item $fh = $handle->fh 268=item $fh = $handle->fh
230 269
231This method returns the file handle of the L<AnyEvent::Handle> object. 270This method returns the file handle of the L<AnyEvent::Handle> object.
250 289
251=cut 290=cut
252 291
253sub on_eof { 292sub on_eof {
254 $_[0]{on_eof} = $_[1]; 293 $_[0]{on_eof} = $_[1];
294}
295
296=item $handle->on_timeout ($cb)
297
298Replace the current C<on_timeout> callback, or disables the callback
299(but not the timeout) if C<$cb> = C<undef>. See C<timeout> constructor
300argument.
301
302=cut
303
304sub on_timeout {
305 $_[0]{on_timeout} = $_[1];
306}
307
308#############################################################################
309
310=item $handle->timeout ($seconds)
311
312Configures (or disables) the inactivity timeout.
313
314=cut
315
316sub timeout {
317 my ($self, $timeout) = @_;
318
319 $self->{timeout} = $timeout;
320 $self->_timeout;
321}
322
323# reset the timeout watcher, as neccessary
324# also check for time-outs
325sub _timeout {
326 my ($self) = @_;
327
328 if ($self->{timeout}) {
329 my $NOW = AnyEvent->now;
330
331 # when would the timeout trigger?
332 my $after = $self->{_activity} + $self->{timeout} - $NOW;
333
334 # now or in the past already?
335 if ($after <= 0) {
336 $self->{_activity} = $NOW;
337
338 if ($self->{on_timeout}) {
339 $self->{on_timeout}($self);
340 } else {
341 $self->_error (&Errno::ETIMEDOUT);
342 }
343
344 # callbakx could have changed timeout value, optimise
345 return unless $self->{timeout};
346
347 # calculate new after
348 $after = $self->{timeout};
349 }
350
351 Scalar::Util::weaken $self;
352
353 $self->{_tw} ||= AnyEvent->timer (after => $after, cb => sub {
354 delete $self->{_tw};
355 $self->_timeout;
356 });
357 } else {
358 delete $self->{_tw};
359 }
255} 360}
256 361
257############################################################################# 362#############################################################################
258 363
259=back 364=back
306 my $len = syswrite $self->{fh}, $self->{wbuf}; 411 my $len = syswrite $self->{fh}, $self->{wbuf};
307 412
308 if ($len >= 0) { 413 if ($len >= 0) {
309 substr $self->{wbuf}, 0, $len, ""; 414 substr $self->{wbuf}, 0, $len, "";
310 415
416 $self->{_activity} = AnyEvent->now;
417
311 $self->{on_drain}($self) 418 $self->{on_drain}($self)
312 if $self->{low_water_mark} >= length $self->{wbuf} 419 if $self->{low_water_mark} >= length $self->{wbuf}
313 && $self->{on_drain}; 420 && $self->{on_drain};
314 421
315 delete $self->{_ww} unless length $self->{wbuf}; 422 delete $self->{_ww} unless length $self->{wbuf};
316 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAWOULDBLOCK) { 423 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) {
317 $self->error; 424 $self->_error ($!, 1);
318 } 425 }
319 }; 426 };
320 427
321 # try to write data immediately 428 # try to write data immediately
322 $cb->(); 429 $cb->();
342 @_ = ($WH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::push_write") 449 @_ = ($WH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::push_write")
343 ->($self, @_); 450 ->($self, @_);
344 } 451 }
345 452
346 if ($self->{filter_w}) { 453 if ($self->{filter_w}) {
347 $self->{filter_w}->($self, \$_[0]); 454 $self->{filter_w}($self, \$_[0]);
348 } else { 455 } else {
349 $self->{wbuf} .= $_[0]; 456 $self->{wbuf} .= $_[0];
350 $self->_drain_wbuf; 457 $self->_drain_wbuf;
351 } 458 }
352} 459}
353 460
354=item $handle->push_write (type => @args) 461=item $handle->push_write (type => @args)
355 462
356=item $handle->unshift_write (type => @args)
357
358Instead of formatting your data yourself, you can also let this module do 463Instead of formatting your data yourself, you can also let this module do
359the job by specifying a type and type-specific arguments. 464the job by specifying a type and type-specific arguments.
360 465
361Predefined types are (if you have ideas for additional types, feel free to 466Predefined types are (if you have ideas for additional types, feel free to
362drop by and tell us): 467drop by and tell us):
366=item netstring => $string 471=item netstring => $string
367 472
368Formats the given value as netstring 473Formats the given value as netstring
369(http://cr.yp.to/proto/netstrings.txt, this is not a recommendation to use them). 474(http://cr.yp.to/proto/netstrings.txt, this is not a recommendation to use them).
370 475
371=back
372
373=cut 476=cut
374 477
375register_write_type netstring => sub { 478register_write_type netstring => sub {
376 my ($self, $string) = @_; 479 my ($self, $string) = @_;
377 480
378 sprintf "%d:%s,", (length $string), $string 481 sprintf "%d:%s,", (length $string), $string
379}; 482};
380 483
484=item json => $array_or_hashref
485
486Encodes the given hash or array reference into a JSON object. Unless you
487provide your own JSON object, this means it will be encoded to JSON text
488in UTF-8.
489
490JSON objects (and arrays) are self-delimiting, so you can write JSON at
491one end of a handle and read them at the other end without using any
492additional framing.
493
494The generated JSON text is guaranteed not to contain any newlines: While
495this module doesn't need delimiters after or between JSON texts to be
496able to read them, many other languages depend on that.
497
498A simple RPC protocol that interoperates easily with others is to send
499JSON arrays (or objects, although arrays are usually the better choice as
500they mimic how function argument passing works) and a newline after each
501JSON text:
502
503 $handle->push_write (json => ["method", "arg1", "arg2"]); # whatever
504 $handle->push_write ("\012");
505
506An AnyEvent::Handle receiver would simply use the C<json> read type and
507rely on the fact that the newline will be skipped as leading whitespace:
508
509 $handle->push_read (json => sub { my $array = $_[1]; ... });
510
511Other languages could read single lines terminated by a newline and pass
512this line into their JSON decoder of choice.
513
514=cut
515
516register_write_type json => sub {
517 my ($self, $ref) = @_;
518
519 require JSON;
520
521 $self->{json} ? $self->{json}->encode ($ref)
522 : JSON::encode_json ($ref)
523};
524
381=item AnyEvent::Handle::register_write_type type => $coderef->($self, @args) 525=item AnyEvent::Handle::register_write_type type => $coderef->($handle, @args)
382 526
383This function (not method) lets you add your own types to C<push_write>. 527This function (not method) lets you add your own types to C<push_write>.
384Whenever the given C<type> is used, C<push_write> will invoke the code 528Whenever the given C<type> is used, C<push_write> will invoke the code
385reference with the handle object and the remaining arguments. 529reference with the handle object and the remaining arguments.
386 530
387The code reference is supposed to return a single octet string that will 531The code reference is supposed to return a single octet string that will
388be appended to the write buffer. 532be appended to the write buffer.
389 533
390Note that this is a function, and all types registered this way will be 534Note that this is a function, and all types registered this way will be
391global, so try to use unique names. 535global, so try to use unique names.
536
537=back
392 538
393=cut 539=cut
394 540
395############################################################################# 541#############################################################################
396 542
422the specified number of bytes which give an XML datagram. 568the specified number of bytes which give an XML datagram.
423 569
424 # in the default state, expect some header bytes 570 # in the default state, expect some header bytes
425 $handle->on_read (sub { 571 $handle->on_read (sub {
426 # some data is here, now queue the length-header-read (4 octets) 572 # some data is here, now queue the length-header-read (4 octets)
427 shift->unshift_read_chunk (4, sub { 573 shift->unshift_read (chunk => 4, sub {
428 # header arrived, decode 574 # header arrived, decode
429 my $len = unpack "N", $_[1]; 575 my $len = unpack "N", $_[1];
430 576
431 # now read the payload 577 # now read the payload
432 shift->unshift_read_chunk ($len, sub { 578 shift->unshift_read (chunk => $len, sub {
433 my $xml = $_[1]; 579 my $xml = $_[1];
434 # handle xml 580 # handle xml
435 }); 581 });
436 }); 582 });
437 }); 583 });
444 590
445 # request one 591 # request one
446 $handle->push_write ("request 1\015\012"); 592 $handle->push_write ("request 1\015\012");
447 593
448 # we expect "ERROR" or "OK" as response, so push a line read 594 # we expect "ERROR" or "OK" as response, so push a line read
449 $handle->push_read_line (sub { 595 $handle->push_read (line => sub {
450 # if we got an "OK", we have to _prepend_ another line, 596 # if we got an "OK", we have to _prepend_ another line,
451 # so it will be read before the second request reads its 64 bytes 597 # so it will be read before the second request reads its 64 bytes
452 # which are already in the queue when this callback is called 598 # which are already in the queue when this callback is called
453 # we don't do this in case we got an error 599 # we don't do this in case we got an error
454 if ($_[1] eq "OK") { 600 if ($_[1] eq "OK") {
455 $_[0]->unshift_read_line (sub { 601 $_[0]->unshift_read (line => sub {
456 my $response = $_[1]; 602 my $response = $_[1];
457 ... 603 ...
458 }); 604 });
459 } 605 }
460 }); 606 });
461 607
462 # request two 608 # request two
463 $handle->push_write ("request 2\015\012"); 609 $handle->push_write ("request 2\015\012");
464 610
465 # simply read 64 bytes, always 611 # simply read 64 bytes, always
466 $handle->push_read_chunk (64, sub { 612 $handle->push_read (chunk => 64, sub {
467 my $response = $_[1]; 613 my $response = $_[1];
468 ... 614 ...
469 }); 615 });
470 616
471=over 4 617=over 4
477 623
478 if ( 624 if (
479 defined $self->{rbuf_max} 625 defined $self->{rbuf_max}
480 && $self->{rbuf_max} < length $self->{rbuf} 626 && $self->{rbuf_max} < length $self->{rbuf}
481 ) { 627 ) {
482 $! = &Errno::ENOSPC; 628 return $self->_error (&Errno::ENOSPC, 1);
483 $self->error;
484 } 629 }
485 630
486 return if $self->{in_drain}; 631 return if $self->{in_drain};
487 local $self->{in_drain} = 1; 632 local $self->{in_drain} = 1;
488 633
490 no strict 'refs'; 635 no strict 'refs';
491 if (my $cb = shift @{ $self->{_queue} }) { 636 if (my $cb = shift @{ $self->{_queue} }) {
492 unless ($cb->($self)) { 637 unless ($cb->($self)) {
493 if ($self->{_eof}) { 638 if ($self->{_eof}) {
494 # no progress can be made (not enough data and no data forthcoming) 639 # no progress can be made (not enough data and no data forthcoming)
495 $! = &Errno::EPIPE; 640 return $self->_error (&Errno::EPIPE, 1);
496 $self->error;
497 } 641 }
498 642
499 unshift @{ $self->{_queue} }, $cb; 643 unshift @{ $self->{_queue} }, $cb;
500 return; 644 return;
501 } 645 }
507 && $len == length $self->{rbuf} # and no data has been consumed 651 && $len == length $self->{rbuf} # and no data has been consumed
508 && !@{ $self->{_queue} } # and the queue is still empty 652 && !@{ $self->{_queue} } # and the queue is still empty
509 && $self->{on_read} # and we still want to read data 653 && $self->{on_read} # and we still want to read data
510 ) { 654 ) {
511 # then no progress can be made 655 # then no progress can be made
512 $! = &Errno::EPIPE; 656 return $self->_error (&Errno::EPIPE, 1);
513 $self->error;
514 } 657 }
515 } else { 658 } else {
516 # read side becomes idle 659 # read side becomes idle
517 delete $self->{_rw}; 660 delete $self->{_rw};
518 return; 661 return;
519 } 662 }
520 } 663 }
521 664
522 if ($self->{_eof}) {
523 $self->_shutdown;
524 $self->{on_eof}($self) 665 $self->{on_eof}($self)
525 if $self->{on_eof}; 666 if $self->{_eof} && $self->{on_eof};
526 }
527} 667}
528 668
529=item $handle->on_read ($cb) 669=item $handle->on_read ($cb)
530 670
531This replaces the currently set C<on_read> callback, or clears it (when 671This replaces the currently set C<on_read> callback, or clears it (when
626Predefined types are (if you have ideas for additional types, feel free to 766Predefined types are (if you have ideas for additional types, feel free to
627drop by and tell us): 767drop by and tell us):
628 768
629=over 4 769=over 4
630 770
631=item chunk => $octets, $cb->($self, $data) 771=item chunk => $octets, $cb->($handle, $data)
632 772
633Invoke the callback only once C<$octets> bytes have been read. Pass the 773Invoke the callback only once C<$octets> bytes have been read. Pass the
634data read to the callback. The callback will never be called with less 774data read to the callback. The callback will never be called with less
635data. 775data.
636 776
659 799
660sub unshift_read_chunk { 800sub unshift_read_chunk {
661 $_[0]->unshift_read (chunk => $_[1], $_[2]); 801 $_[0]->unshift_read (chunk => $_[1], $_[2]);
662} 802}
663 803
664=item line => [$eol, ]$cb->($self, $line, $eol) 804=item line => [$eol, ]$cb->($handle, $line, $eol)
665 805
666The callback will be called only once a full line (including the end of 806The callback will be called only once a full line (including the end of
667line marker, C<$eol>) has been read. This line (excluding the end of line 807line marker, C<$eol>) has been read. This line (excluding the end of line
668marker) will be passed to the callback as second argument (C<$line>), and 808marker) will be passed to the callback as second argument (C<$line>), and
669the end of line marker as the third argument (C<$eol>). 809the end of line marker as the third argument (C<$eol>).
706sub unshift_read_line { 846sub unshift_read_line {
707 my $self = shift; 847 my $self = shift;
708 $self->unshift_read (line => @_); 848 $self->unshift_read (line => @_);
709} 849}
710 850
711=item netstring => $cb->($string) 851=item netstring => $cb->($handle, $string)
712 852
713A netstring (http://cr.yp.to/proto/netstrings.txt, this is not an endorsement). 853A netstring (http://cr.yp.to/proto/netstrings.txt, this is not an endorsement).
714 854
715Throws an error with C<$!> set to EBADMSG on format violations. 855Throws an error with C<$!> set to EBADMSG on format violations.
716 856
720 my ($self, $cb) = @_; 860 my ($self, $cb) = @_;
721 861
722 sub { 862 sub {
723 unless ($_[0]{rbuf} =~ s/^(0|[1-9][0-9]*)://) { 863 unless ($_[0]{rbuf} =~ s/^(0|[1-9][0-9]*)://) {
724 if ($_[0]{rbuf} =~ /[^0-9]/) { 864 if ($_[0]{rbuf} =~ /[^0-9]/) {
725 $! = &Errno::EBADMSG; 865 $self->_error (&Errno::EBADMSG);
726 $self->error;
727 } 866 }
728 return; 867 return;
729 } 868 }
730 869
731 my $len = $1; 870 my $len = $1;
734 my $string = $_[1]; 873 my $string = $_[1];
735 $_[0]->unshift_read (chunk => 1, sub { 874 $_[0]->unshift_read (chunk => 1, sub {
736 if ($_[1] eq ",") { 875 if ($_[1] eq ",") {
737 $cb->($_[0], $string); 876 $cb->($_[0], $string);
738 } else { 877 } else {
739 $! = &Errno::EBADMSG; 878 $self->_error (&Errno::EBADMSG);
740 $self->error;
741 } 879 }
742 }); 880 });
743 }); 881 });
744 882
745 1 883 1
746 } 884 }
747}; 885};
748 886
749=item regex => $accept[, $reject[, $skip], $cb->($data) 887=item regex => $accept[, $reject[, $skip], $cb->($handle, $data)
750 888
751Makes a regex match against the regex object C<$accept> and returns 889Makes a regex match against the regex object C<$accept> and returns
752everything up to and including the match. 890everything up to and including the match.
753 891
754Example: read a single line terminated by '\n'. 892Example: read a single line terminated by '\n'.
802 return 1; 940 return 1;
803 } 941 }
804 942
805 # reject 943 # reject
806 if ($reject && $$rbuf =~ $reject) { 944 if ($reject && $$rbuf =~ $reject) {
807 $! = &Errno::EBADMSG; 945 $self->_error (&Errno::EBADMSG);
808 $self->error;
809 } 946 }
810 947
811 # skip 948 # skip
812 if ($skip && $$rbuf =~ $skip) { 949 if ($skip && $$rbuf =~ $skip) {
813 $data .= substr $$rbuf, 0, $+[0], ""; 950 $data .= substr $$rbuf, 0, $+[0], "";
815 952
816 () 953 ()
817 } 954 }
818}; 955};
819 956
957=item json => $cb->($handle, $hash_or_arrayref)
958
959Reads a JSON object or array, decodes it and passes it to the callback.
960
961If a C<json> object was passed to the constructor, then that will be used
962for the final decode, otherwise it will create a JSON coder expecting UTF-8.
963
964This read type uses the incremental parser available with JSON version
9652.09 (and JSON::XS version 2.2) and above. You have to provide a
966dependency on your own: this module will load the JSON module, but
967AnyEvent does not depend on it itself.
968
969Since JSON texts are fully self-delimiting, the C<json> read and write
970types are an ideal simple RPC protocol: just exchange JSON datagrams. See
971the C<json> write type description, above, for an actual example.
972
973=cut
974
975register_read_type json => sub {
976 my ($self, $cb, $accept, $reject, $skip) = @_;
977
978 require JSON;
979
980 my $data;
981 my $rbuf = \$self->{rbuf};
982
983 my $json = $self->{json} ||= JSON->new->utf8;
984
985 sub {
986 my $ref = $json->incr_parse ($self->{rbuf});
987
988 if ($ref) {
989 $self->{rbuf} = $json->incr_text;
990 $json->incr_text = "";
991 $cb->($self, $ref);
992
993 1
994 } else {
995 $self->{rbuf} = "";
996 ()
997 }
998 }
999};
1000
820=back 1001=back
821 1002
822=item AnyEvent::Handle::register_read_type type => $coderef->($self, $cb, @args) 1003=item AnyEvent::Handle::register_read_type type => $coderef->($handle, $cb, @args)
823 1004
824This function (not method) lets you add your own types to C<push_read>. 1005This function (not method) lets you add your own types to C<push_read>.
825 1006
826Whenever the given C<type> is used, C<push_read> will invoke the code 1007Whenever the given C<type> is used, C<push_read> will invoke the code
827reference with the handle object, the callback and the remaining 1008reference with the handle object, the callback and the remaining
829 1010
830The code reference is supposed to return a callback (usually a closure) 1011The code reference is supposed to return a callback (usually a closure)
831that works as a plain read callback (see C<< ->push_read ($cb) >>). 1012that works as a plain read callback (see C<< ->push_read ($cb) >>).
832 1013
833It should invoke the passed callback when it is done reading (remember to 1014It should invoke the passed callback when it is done reading (remember to
834pass C<$self> as first argument as all other callbacks do that). 1015pass C<$handle> as first argument as all other callbacks do that).
835 1016
836Note that this is a function, and all types registered this way will be 1017Note that this is a function, and all types registered this way will be
837global, so try to use unique names. 1018global, so try to use unique names.
838 1019
839For examples, see the source of this module (F<perldoc -m AnyEvent::Handle>, 1020For examples, see the source of this module (F<perldoc -m AnyEvent::Handle>,
865 $self->{_rw} = AnyEvent->io (fh => $self->{fh}, poll => "r", cb => sub { 1046 $self->{_rw} = AnyEvent->io (fh => $self->{fh}, poll => "r", cb => sub {
866 my $rbuf = $self->{filter_r} ? \my $buf : \$self->{rbuf}; 1047 my $rbuf = $self->{filter_r} ? \my $buf : \$self->{rbuf};
867 my $len = sysread $self->{fh}, $$rbuf, $self->{read_size} || 8192, length $$rbuf; 1048 my $len = sysread $self->{fh}, $$rbuf, $self->{read_size} || 8192, length $$rbuf;
868 1049
869 if ($len > 0) { 1050 if ($len > 0) {
1051 $self->{_activity} = AnyEvent->now;
1052
870 $self->{filter_r} 1053 $self->{filter_r}
871 ? $self->{filter_r}->($self, $rbuf) 1054 ? $self->{filter_r}($self, $rbuf)
872 : $self->_drain_rbuf; 1055 : $self->_drain_rbuf;
873 1056
874 } elsif (defined $len) { 1057 } elsif (defined $len) {
875 delete $self->{_rw}; 1058 delete $self->{_rw};
876 $self->{_eof} = 1; 1059 $self->{_eof} = 1;
877 $self->_drain_rbuf; 1060 $self->_drain_rbuf;
878 1061
879 } elsif ($! != EAGAIN && $! != EINTR && $! != &AnyEvent::Util::WSAWOULDBLOCK) { 1062 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) {
880 return $self->error; 1063 return $self->_error ($!, 1);
881 } 1064 }
882 }); 1065 });
883 } 1066 }
884} 1067}
885 1068
904 1087
905 my $err = Net::SSLeay::get_error ($self->{tls}, -1); 1088 my $err = Net::SSLeay::get_error ($self->{tls}, -1);
906 1089
907 if ($err!= Net::SSLeay::ERROR_WANT_READ ()) { 1090 if ($err!= Net::SSLeay::ERROR_WANT_READ ()) {
908 if ($err == Net::SSLeay::ERROR_SYSCALL ()) { 1091 if ($err == Net::SSLeay::ERROR_SYSCALL ()) {
909 $self->error; 1092 return $self->_error ($!, 1);
910 } elsif ($err == Net::SSLeay::ERROR_SSL ()) { 1093 } elsif ($err == Net::SSLeay::ERROR_SSL ()) {
911 $! = &Errno::EIO; 1094 return $self->_error (&Errno::EIO, 1);
912 $self->error;
913 } 1095 }
914 1096
915 # all others are fine for our purposes 1097 # all others are fine for our purposes
916 } 1098 }
917} 1099}
932call and can be used or changed to your liking. Note that the handshake 1114call and can be used or changed to your liking. Note that the handshake
933might have already started when this function returns. 1115might have already started when this function returns.
934 1116
935=cut 1117=cut
936 1118
937# TODO: maybe document...
938sub starttls { 1119sub starttls {
939 my ($self, $ssl, $ctx) = @_; 1120 my ($self, $ssl, $ctx) = @_;
940 1121
941 $self->stoptls; 1122 $self->stoptls;
942 1123

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines