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.57 by root, Wed Jun 4 11:45:21 2008 UTC vs.
Revision 1.86 by root, Thu Aug 21 20:41:16 2008 UTC

1package AnyEvent::Handle; 1package AnyEvent::Handle;
2 2
3no warnings; 3no warnings;
4use strict; 4use strict qw(subs vars);
5 5
6use AnyEvent (); 6use AnyEvent ();
7use AnyEvent::Util qw(WSAEWOULDBLOCK); 7use AnyEvent::Util qw(WSAEWOULDBLOCK);
8use Scalar::Util (); 8use Scalar::Util ();
9use Carp (); 9use Carp ();
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.13; 19our $VERSION = 4.232;
20 20
21=head1 SYNOPSIS 21=head1 SYNOPSIS
22 22
23 use AnyEvent; 23 use AnyEvent;
24 use AnyEvent::Handle; 24 use AnyEvent::Handle;
49 49
50This module is a helper module to make it easier to do event-based I/O on 50This module is a helper module to make it easier to do event-based I/O on
51filehandles. For utility functions for doing non-blocking connects and accepts 51filehandles. For utility functions for doing non-blocking connects and accepts
52on sockets see L<AnyEvent::Util>. 52on sockets see L<AnyEvent::Util>.
53 53
54The L<AnyEvent::Intro> tutorial contains some well-documented
55AnyEvent::Handle examples.
56
54In the following, when the documentation refers to of "bytes" then this 57In the following, when the documentation refers to of "bytes" then this
55means characters. As sysread and syswrite are used for all I/O, their 58means characters. As sysread and syswrite are used for all I/O, their
56treatment of characters applies to this module as well. 59treatment of characters applies to this module as well.
57 60
58All callbacks will be invoked with the handle object as their first 61All callbacks will be invoked with the handle object as their first
70 73
71=item fh => $filehandle [MANDATORY] 74=item fh => $filehandle [MANDATORY]
72 75
73The filehandle this L<AnyEvent::Handle> object will operate on. 76The filehandle this L<AnyEvent::Handle> object will operate on.
74 77
75NOTE: The filehandle will be set to non-blocking (using 78NOTE: The filehandle will be set to non-blocking mode (using
76AnyEvent::Util::fh_nonblocking). 79C<AnyEvent::Util::fh_nonblocking>) by the constructor and needs to stay in
80that mode.
77 81
78=item on_eof => $cb->($handle) 82=item on_eof => $cb->($handle)
79 83
80Set the callback to be called when an end-of-file condition is detcted, 84Set the callback to be called when an end-of-file condition is detected,
81i.e. in the case of a socket, when the other side has closed the 85i.e. in the case of a socket, when the other side has closed the
82connection cleanly. 86connection cleanly.
83 87
88For sockets, this just means that the other side has stopped sending data,
89you can still try to write data, and, in fact, one can return from the eof
90callback and continue writing data, as only the read part has been shut
91down.
92
84While not mandatory, it is highly recommended to set an eof callback, 93While not mandatory, it is I<highly> recommended to set an eof callback,
85otherwise you might end up with a closed socket while you are still 94otherwise you might end up with a closed socket while you are still
86waiting for data. 95waiting for data.
96
97If an EOF condition has been detected but no C<on_eof> callback has been
98set, then a fatal error will be raised with C<$!> set to <0>.
87 99
88=item on_error => $cb->($handle, $fatal) 100=item on_error => $cb->($handle, $fatal)
89 101
90This is the error callback, which is called when, well, some error 102This is the error callback, which is called when, well, some error
91occured, such as not being able to resolve the hostname, failure to 103occured, such as not being able to resolve the hostname, failure to
92connect or a read error. 104connect or a read error.
93 105
94Some errors are fatal (which is indicated by C<$fatal> being true). On 106Some errors are fatal (which is indicated by C<$fatal> being true). On
95fatal errors the handle object will be shut down and will not be 107fatal errors the handle object will be shut down and will not be usable
108(but you are free to look at the current C< ->rbuf >). Examples of fatal
109errors are an EOF condition with active (but unsatisifable) read watchers
110(C<EPIPE>) or I/O errors.
111
96usable. Non-fatal errors can be retried by simply returning, but it is 112Non-fatal errors can be retried by simply returning, but it is recommended
97recommended to simply ignore this parameter and instead abondon the handle 113to simply ignore this parameter and instead abondon the handle object
98object when this callback is invoked. 114when this callback is invoked. Examples of non-fatal errors are timeouts
115C<ETIMEDOUT>) or badly-formatted data (C<EBADMSG>).
99 116
100On callback entrance, the value of C<$!> contains the operating system 117On callback entrance, the value of C<$!> contains the operating system
101error (or C<ENOSPC>, C<EPIPE>, C<ETIMEDOUT> or C<EBADMSG>). 118error (or C<ENOSPC>, C<EPIPE>, C<ETIMEDOUT> or C<EBADMSG>).
102 119
103While not mandatory, it is I<highly> recommended to set this callback, as 120While not mandatory, it is I<highly> recommended to set this callback, as
105C<croak>. 122C<croak>.
106 123
107=item on_read => $cb->($handle) 124=item on_read => $cb->($handle)
108 125
109This sets the default read callback, which is called when data arrives 126This sets the default read callback, which is called when data arrives
110and no read request is in the queue. 127and no read request is in the queue (unlike read queue callbacks, this
128callback will only be called when at least one octet of data is in the
129read buffer).
111 130
112To access (and remove data from) the read buffer, use the C<< ->rbuf >> 131To access (and remove data from) the read buffer, use the C<< ->rbuf >>
113method or access the C<$handle->{rbuf}> member directly. 132method or access the C<$handle->{rbuf}> member directly.
114 133
115When an EOF condition is detected then AnyEvent::Handle will first try to 134When an EOF condition is detected then AnyEvent::Handle will first try to
121 140
122This sets the callback that is called when the write buffer becomes empty 141This sets the callback that is called when the write buffer becomes empty
123(or when the callback is set and the buffer is empty already). 142(or when the callback is set and the buffer is empty already).
124 143
125To append to the write buffer, use the C<< ->push_write >> method. 144To append to the write buffer, use the C<< ->push_write >> method.
145
146This callback is useful when you don't want to put all of your write data
147into the queue at once, for example, when you want to write the contents
148of some file to the socket you might not want to read the whole file into
149memory and push it into the queue, but instead only read more data from
150the file when the write queue becomes empty.
126 151
127=item timeout => $fractional_seconds 152=item timeout => $fractional_seconds
128 153
129If non-zero, then this enables an "inactivity" timeout: whenever this many 154If non-zero, then this enables an "inactivity" timeout: whenever this many
130seconds pass without a successful read or write on the underlying file 155seconds pass without a successful read or write on the underlying file
154be configured to accept only so-and-so much data that it cannot act on 179be configured to accept only so-and-so much data that it cannot act on
155(for example, when expecting a line, an attacker could send an unlimited 180(for example, when expecting a line, an attacker could send an unlimited
156amount of data without a callback ever being called as long as the line 181amount of data without a callback ever being called as long as the line
157isn't finished). 182isn't finished).
158 183
184=item autocork => <boolean>
185
186When disabled (the default), then C<push_write> will try to immediately
187write the data to the handle if possible. This avoids having to register
188a write watcher and wait for the next event loop iteration, but can be
189inefficient if you write multiple small chunks (this disadvantage is
190usually avoided by your kernel's nagle algorithm, see C<low_delay>).
191
192When enabled, then writes will always be queued till the next event loop
193iteration. This is efficient when you do many small writes per iteration,
194but less efficient when you do a single write only.
195
196=item no_delay => <boolean>
197
198When doing small writes on sockets, your operating system kernel might
199wait a bit for more data before actually sending it out. This is called
200the Nagle algorithm, and usually it is beneficial.
201
202In some situations you want as low a delay as possible, which cna be
203accomplishd by setting this option to true.
204
205The default is your opertaing system's default behaviour, this option
206explicitly enables or disables it, if possible.
207
159=item read_size => <bytes> 208=item read_size => <bytes>
160 209
161The default read block size (the amount of bytes this module will try to read 210The default read block size (the amount of bytes this module will try to read
162during each (loop iteration). Default: C<8192>. 211during each (loop iteration). Default: C<8192>.
163 212
165 214
166Sets the amount of bytes (default: C<0>) that make up an "empty" write 215Sets the amount of bytes (default: C<0>) that make up an "empty" write
167buffer: If the write reaches this size or gets even samller it is 216buffer: If the write reaches this size or gets even samller it is
168considered empty. 217considered empty.
169 218
219=item linger => <seconds>
220
221If non-zero (default: C<3600>), then the destructor of the
222AnyEvent::Handle object will check wether there is still outstanding write
223data and will install a watcher that will write out this data. No errors
224will be reported (this mostly matches how the operating system treats
225outstanding data at socket close time).
226
227This will not work for partial TLS data that could not yet been
228encoded. This data will be lost.
229
170=item tls => "accept" | "connect" | Net::SSLeay::SSL object 230=item tls => "accept" | "connect" | Net::SSLeay::SSL object
171 231
172When this parameter is given, it enables TLS (SSL) mode, that means it 232When this parameter is given, it enables TLS (SSL) mode, that means
173will start making tls handshake and will transparently encrypt/decrypt 233AnyEvent will start a TLS handshake and will transparently encrypt/decrypt
174data. 234data.
175 235
176TLS mode requires Net::SSLeay to be installed (it will be loaded 236TLS mode requires Net::SSLeay to be installed (it will be loaded
177automatically when you try to create a TLS handle). 237automatically when you try to create a TLS handle).
178 238
179For the TLS server side, use C<accept>, and for the TLS client side of a 239Unlike TCP, TLS has a server and client side: for the TLS server side, use
180connection, use C<connect> mode. 240C<accept>, and for the TLS client side of a connection, use C<connect>
241mode.
181 242
182You can also provide your own TLS connection object, but you have 243You can also provide your own TLS connection object, but you have
183to make sure that you call either C<Net::SSLeay::set_connect_state> 244to make sure that you call either C<Net::SSLeay::set_connect_state>
184or C<Net::SSLeay::set_accept_state> on it before you pass it to 245or C<Net::SSLeay::set_accept_state> on it before you pass it to
185AnyEvent::Handle. 246AnyEvent::Handle.
186 247
187See the C<starttls> method if you need to start TLs negotiation later. 248See the C<starttls> method for when need to start TLS negotiation later.
188 249
189=item tls_ctx => $ssl_ctx 250=item tls_ctx => $ssl_ctx
190 251
191Use the given Net::SSLeay::CTX object to create the new TLS connection 252Use the given Net::SSLeay::CTX object to create the new TLS connection
192(unless a connection object was specified directly). If this parameter is 253(unless a connection object was specified directly). If this parameter is
195=item json => JSON or JSON::XS object 256=item json => JSON or JSON::XS object
196 257
197This is the json coder object used by the C<json> read and write types. 258This is the json coder object used by the C<json> read and write types.
198 259
199If you don't supply it, then AnyEvent::Handle will create and use a 260If 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. 261suitable one (on demand), which will write and expect UTF-8 encoded JSON
262texts.
201 263
202Note that you are responsible to depend on the JSON module if you want to 264Note 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. 265use this functionality, as AnyEvent does not have a dependency itself.
204 266
205=item filter_r => $cb 267=item filter_r => $cb
224 if ($self->{tls}) { 286 if ($self->{tls}) {
225 require Net::SSLeay; 287 require Net::SSLeay;
226 $self->starttls (delete $self->{tls}, delete $self->{tls_ctx}); 288 $self->starttls (delete $self->{tls}, delete $self->{tls_ctx});
227 } 289 }
228 290
229# $self->on_eof (delete $self->{on_eof} ) if $self->{on_eof}; # nop
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
232 $self->on_drain (delete $self->{on_drain}) if $self->{on_drain};
233
234 $self->{_activity} = AnyEvent->now; 291 $self->{_activity} = AnyEvent->now;
235 $self->_timeout; 292 $self->_timeout;
236 293
294 $self->on_drain (delete $self->{on_drain}) if exists $self->{on_drain};
295 $self->no_delay (delete $self->{no_delay}) if exists $self->{no_delay};
296
237 $self->start_read; 297 $self->start_read
298 if $self->{on_read};
238 299
239 $self 300 $self
240} 301}
241 302
242sub _shutdown { 303sub _shutdown {
246 delete $self->{_rw}; 307 delete $self->{_rw};
247 delete $self->{_ww}; 308 delete $self->{_ww};
248 delete $self->{fh}; 309 delete $self->{fh};
249 310
250 $self->stoptls; 311 $self->stoptls;
312
313 delete $self->{on_read};
314 delete $self->{_queue};
251} 315}
252 316
253sub _error { 317sub _error {
254 my ($self, $errno, $fatal) = @_; 318 my ($self, $errno, $fatal) = @_;
255 319
301 365
302=cut 366=cut
303 367
304sub on_timeout { 368sub on_timeout {
305 $_[0]{on_timeout} = $_[1]; 369 $_[0]{on_timeout} = $_[1];
370}
371
372=item $handle->autocork ($boolean)
373
374Enables or disables the current autocork behaviour (see C<autocork>
375constructor argument).
376
377=cut
378
379=item $handle->no_delay ($boolean)
380
381Enables or disables the C<no_delay> setting (see constructor argument of
382the same name for details).
383
384=cut
385
386sub no_delay {
387 $_[0]{no_delay} = $_[1];
388
389 eval {
390 local $SIG{__DIE__};
391 setsockopt $_[0]{fh}, &Socket::IPPROTO_TCP, &Socket::TCP_NODELAY, int $_[1];
392 };
306} 393}
307 394
308############################################################################# 395#############################################################################
309 396
310=item $handle->timeout ($seconds) 397=item $handle->timeout ($seconds)
425 $self->_error ($!, 1); 512 $self->_error ($!, 1);
426 } 513 }
427 }; 514 };
428 515
429 # try to write data immediately 516 # try to write data immediately
430 $cb->(); 517 $cb->() unless $self->{autocork};
431 518
432 # if still data left in wbuf, we need to poll 519 # if still data left in wbuf, we need to poll
433 $self->{_ww} = AnyEvent->io (fh => $self->{fh}, poll => "w", cb => $cb) 520 $self->{_ww} = AnyEvent->io (fh => $self->{fh}, poll => "w", cb => $cb)
434 if length $self->{wbuf}; 521 if length $self->{wbuf};
435 }; 522 };
480 my ($self, $string) = @_; 567 my ($self, $string) = @_;
481 568
482 sprintf "%d:%s,", (length $string), $string 569 sprintf "%d:%s,", (length $string), $string
483}; 570};
484 571
572=item packstring => $format, $data
573
574An octet string prefixed with an encoded length. The encoding C<$format>
575uses the same format as a Perl C<pack> format, but must specify a single
576integer only (only one of C<cCsSlLqQiInNvVjJw> is allowed, plus an
577optional C<!>, C<< < >> or C<< > >> modifier).
578
579=cut
580
581register_write_type packstring => sub {
582 my ($self, $format, $string) = @_;
583
584 pack "$format/a*", $string
585};
586
485=item json => $array_or_hashref 587=item json => $array_or_hashref
486 588
487Encodes the given hash or array reference into a JSON object. Unless you 589Encodes the given hash or array reference into a JSON object. Unless you
488provide your own JSON object, this means it will be encoded to JSON text 590provide your own JSON object, this means it will be encoded to JSON text
489in UTF-8. 591in UTF-8.
521 623
522 $self->{json} ? $self->{json}->encode ($ref) 624 $self->{json} ? $self->{json}->encode ($ref)
523 : JSON::encode_json ($ref) 625 : JSON::encode_json ($ref)
524}; 626};
525 627
628=item storable => $reference
629
630Freezes the given reference using L<Storable> and writes it to the
631handle. Uses the C<nfreeze> format.
632
633=cut
634
635register_write_type storable => sub {
636 my ($self, $ref) = @_;
637
638 require Storable;
639
640 pack "w/a*", Storable::nfreeze ($ref)
641};
642
526=back 643=back
527 644
528=item AnyEvent::Handle::register_write_type type => $coderef->($handle, @args) 645=item AnyEvent::Handle::register_write_type type => $coderef->($handle, @args)
529 646
530This function (not method) lets you add your own types to C<push_write>. 647This function (not method) lets you add your own types to C<push_write>.
552ways, the "simple" way, using only C<on_read> and the "complex" way, using 669ways, the "simple" way, using only C<on_read> and the "complex" way, using
553a queue. 670a queue.
554 671
555In the simple case, you just install an C<on_read> callback and whenever 672In the simple case, you just install an C<on_read> callback and whenever
556new data arrives, it will be called. You can then remove some data (if 673new data arrives, it will be called. You can then remove some data (if
557enough is there) from the read buffer (C<< $handle->rbuf >>) if you want 674enough is there) from the read buffer (C<< $handle->rbuf >>). Or you cna
558or not. 675leave the data there if you want to accumulate more (e.g. when only a
676partial message has been received so far).
559 677
560In the more complex case, you want to queue multiple callbacks. In this 678In the more complex case, you want to queue multiple callbacks. In this
561case, AnyEvent::Handle will call the first queued callback each time new 679case, AnyEvent::Handle will call the first queued callback each time new
562data arrives and removes it when it has done its job (see C<push_read>, 680data arrives (also the first time it is queued) and removes it when it has
563below). 681done its job (see C<push_read>, below).
564 682
565This way you can, for example, push three line-reads, followed by reading 683This way you can, for example, push three line-reads, followed by reading
566a chunk of data, and AnyEvent::Handle will execute them in order. 684a chunk of data, and AnyEvent::Handle will execute them in order.
567 685
568Example 1: EPP protocol parser. EPP sends 4 byte length info, followed by 686Example 1: EPP protocol parser. EPP sends 4 byte length info, followed by
581 # handle xml 699 # handle xml
582 }); 700 });
583 }); 701 });
584 }); 702 });
585 703
586Example 2: Implement a client for a protocol that replies either with 704Example 2: Implement a client for a protocol that replies either with "OK"
587"OK" and another line or "ERROR" for one request, and 64 bytes for the 705and another line or "ERROR" for the first request that is sent, and 64
588second request. Due tot he availability of a full queue, we can just 706bytes for the second request. Due to the availability of a queue, we can
589pipeline sending both requests and manipulate the queue as necessary in 707just pipeline sending both requests and manipulate the queue as necessary
590the callbacks: 708in the callbacks.
591 709
592 # request one 710When the first callback is called and sees an "OK" response, it will
711C<unshift> another line-read. This line-read will be queued I<before> the
71264-byte chunk callback.
713
714 # request one, returns either "OK + extra line" or "ERROR"
593 $handle->push_write ("request 1\015\012"); 715 $handle->push_write ("request 1\015\012");
594 716
595 # we expect "ERROR" or "OK" as response, so push a line read 717 # we expect "ERROR" or "OK" as response, so push a line read
596 $handle->push_read (line => sub { 718 $handle->push_read (line => sub {
597 # if we got an "OK", we have to _prepend_ another line, 719 # if we got an "OK", we have to _prepend_ another line,
604 ... 726 ...
605 }); 727 });
606 } 728 }
607 }); 729 });
608 730
609 # request two 731 # request two, simply returns 64 octets
610 $handle->push_write ("request 2\015\012"); 732 $handle->push_write ("request 2\015\012");
611 733
612 # simply read 64 bytes, always 734 # simply read 64 bytes, always
613 $handle->push_read (chunk => 64, sub { 735 $handle->push_read (chunk => 64, sub {
614 my $response = $_[1]; 736 my $response = $_[1];
620=cut 742=cut
621 743
622sub _drain_rbuf { 744sub _drain_rbuf {
623 my ($self) = @_; 745 my ($self) = @_;
624 746
747 local $self->{_in_drain} = 1;
748
625 if ( 749 if (
626 defined $self->{rbuf_max} 750 defined $self->{rbuf_max}
627 && $self->{rbuf_max} < length $self->{rbuf} 751 && $self->{rbuf_max} < length $self->{rbuf}
628 ) { 752 ) {
629 return $self->_error (&Errno::ENOSPC, 1); 753 $self->_error (&Errno::ENOSPC, 1), return;
630 } 754 }
631 755
632 return if $self->{in_drain}; 756 while () {
633 local $self->{in_drain} = 1;
634
635 while (my $len = length $self->{rbuf}) { 757 my $len = length $self->{rbuf};
636 no strict 'refs'; 758
637 if (my $cb = shift @{ $self->{_queue} }) { 759 if (my $cb = shift @{ $self->{_queue} }) {
638 unless ($cb->($self)) { 760 unless ($cb->($self)) {
639 if ($self->{_eof}) { 761 if ($self->{_eof}) {
640 # no progress can be made (not enough data and no data forthcoming) 762 # no progress can be made (not enough data and no data forthcoming)
641 return $self->_error (&Errno::EPIPE, 1); 763 $self->_error (&Errno::EPIPE, 1), return;
642 } 764 }
643 765
644 unshift @{ $self->{_queue} }, $cb; 766 unshift @{ $self->{_queue} }, $cb;
645 last; 767 last;
646 } 768 }
647 } elsif ($self->{on_read}) { 769 } elsif ($self->{on_read}) {
770 last unless $len;
771
648 $self->{on_read}($self); 772 $self->{on_read}($self);
649 773
650 if ( 774 if (
651 $len == length $self->{rbuf} # if no data has been consumed 775 $len == length $self->{rbuf} # if no data has been consumed
652 && !@{ $self->{_queue} } # and the queue is still empty 776 && !@{ $self->{_queue} } # and the queue is still empty
653 && $self->{on_read} # but we still have on_read 777 && $self->{on_read} # but we still have on_read
654 ) { 778 ) {
655 # no further data will arrive 779 # no further data will arrive
656 # so no progress can be made 780 # so no progress can be made
657 return $self->_error (&Errno::EPIPE, 1) 781 $self->_error (&Errno::EPIPE, 1), return
658 if $self->{_eof}; 782 if $self->{_eof};
659 783
660 last; # more data might arrive 784 last; # more data might arrive
661 } 785 }
662 } else { 786 } else {
664 delete $self->{_rw}; 788 delete $self->{_rw};
665 last; 789 last;
666 } 790 }
667 } 791 }
668 792
793 if ($self->{_eof}) {
794 if ($self->{on_eof}) {
669 $self->{on_eof}($self) 795 $self->{on_eof}($self)
670 if $self->{_eof} && $self->{on_eof}; 796 } else {
797 $self->_error (0, 1);
798 }
799 }
671 800
672 # may need to restart read watcher 801 # may need to restart read watcher
673 unless ($self->{_rw}) { 802 unless ($self->{_rw}) {
674 $self->start_read 803 $self->start_read
675 if $self->{on_read} || @{ $self->{_queue} }; 804 if $self->{on_read} || @{ $self->{_queue} };
686 815
687sub on_read { 816sub on_read {
688 my ($self, $cb) = @_; 817 my ($self, $cb) = @_;
689 818
690 $self->{on_read} = $cb; 819 $self->{on_read} = $cb;
820 $self->_drain_rbuf if $cb && !$self->{_in_drain};
691} 821}
692 822
693=item $handle->rbuf 823=item $handle->rbuf
694 824
695Returns the read buffer (as a modifiable lvalue). 825Returns the read buffer (as a modifiable lvalue).
744 $cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::push_read") 874 $cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::push_read")
745 ->($self, $cb, @_); 875 ->($self, $cb, @_);
746 } 876 }
747 877
748 push @{ $self->{_queue} }, $cb; 878 push @{ $self->{_queue} }, $cb;
749 $self->_drain_rbuf; 879 $self->_drain_rbuf unless $self->{_in_drain};
750} 880}
751 881
752sub unshift_read { 882sub unshift_read {
753 my $self = shift; 883 my $self = shift;
754 my $cb = pop; 884 my $cb = pop;
760 ->($self, $cb, @_); 890 ->($self, $cb, @_);
761 } 891 }
762 892
763 893
764 unshift @{ $self->{_queue} }, $cb; 894 unshift @{ $self->{_queue} }, $cb;
765 $self->_drain_rbuf; 895 $self->_drain_rbuf unless $self->{_in_drain};
766} 896}
767 897
768=item $handle->push_read (type => @args, $cb) 898=item $handle->push_read (type => @args, $cb)
769 899
770=item $handle->unshift_read (type => @args, $cb) 900=item $handle->unshift_read (type => @args, $cb)
800 $cb->($_[0], substr $_[0]{rbuf}, 0, $len, ""); 930 $cb->($_[0], substr $_[0]{rbuf}, 0, $len, "");
801 1 931 1
802 } 932 }
803}; 933};
804 934
805# compatibility with older API
806sub push_read_chunk {
807 $_[0]->push_read (chunk => $_[1], $_[2]);
808}
809
810sub unshift_read_chunk {
811 $_[0]->unshift_read (chunk => $_[1], $_[2]);
812}
813
814=item line => [$eol, ]$cb->($handle, $line, $eol) 935=item line => [$eol, ]$cb->($handle, $line, $eol)
815 936
816The callback will be called only once a full line (including the end of 937The callback will be called only once a full line (including the end of
817line marker, C<$eol>) has been read. This line (excluding the end of line 938line marker, C<$eol>) has been read. This line (excluding the end of line
818marker) will be passed to the callback as second argument (C<$line>), and 939marker) will be passed to the callback as second argument (C<$line>), and
833=cut 954=cut
834 955
835register_read_type line => sub { 956register_read_type line => sub {
836 my ($self, $cb, $eol) = @_; 957 my ($self, $cb, $eol) = @_;
837 958
838 $eol = qr|(\015?\012)| if @_ < 3; 959 if (@_ < 3) {
839 $eol = quotemeta $eol unless ref $eol; 960 # this is more than twice as fast as the generic code below
840 $eol = qr|^(.*?)($eol)|s;
841
842 sub { 961 sub {
843 $_[0]{rbuf} =~ s/$eol// or return; 962 $_[0]{rbuf} =~ s/^([^\015\012]*)(\015?\012)// or return;
844 963
845 $cb->($_[0], $1, $2); 964 $cb->($_[0], $1, $2);
846 1
847 }
848};
849
850# compatibility with older API
851sub push_read_line {
852 my $self = shift;
853 $self->push_read (line => @_);
854}
855
856sub unshift_read_line {
857 my $self = shift;
858 $self->unshift_read (line => @_);
859}
860
861=item netstring => $cb->($handle, $string)
862
863A netstring (http://cr.yp.to/proto/netstrings.txt, this is not an endorsement).
864
865Throws an error with C<$!> set to EBADMSG on format violations.
866
867=cut
868
869register_read_type netstring => sub {
870 my ($self, $cb) = @_;
871
872 sub {
873 unless ($_[0]{rbuf} =~ s/^(0|[1-9][0-9]*)://) {
874 if ($_[0]{rbuf} =~ /[^0-9]/) {
875 $self->_error (&Errno::EBADMSG);
876 } 965 1
877 return;
878 } 966 }
967 } else {
968 $eol = quotemeta $eol unless ref $eol;
969 $eol = qr|^(.*?)($eol)|s;
879 970
880 my $len = $1; 971 sub {
972 $_[0]{rbuf} =~ s/$eol// or return;
881 973
882 $self->unshift_read (chunk => $len, sub { 974 $cb->($_[0], $1, $2);
883 my $string = $_[1];
884 $_[0]->unshift_read (chunk => 1, sub {
885 if ($_[1] eq ",") {
886 $cb->($_[0], $string);
887 } else {
888 $self->_error (&Errno::EBADMSG);
889 }
890 }); 975 1
891 }); 976 }
892
893 1
894 } 977 }
895}; 978};
896 979
897=item regex => $accept[, $reject[, $skip], $cb->($handle, $data) 980=item regex => $accept[, $reject[, $skip], $cb->($handle, $data)
898 981
962 1045
963 () 1046 ()
964 } 1047 }
965}; 1048};
966 1049
1050=item netstring => $cb->($handle, $string)
1051
1052A netstring (http://cr.yp.to/proto/netstrings.txt, this is not an endorsement).
1053
1054Throws an error with C<$!> set to EBADMSG on format violations.
1055
1056=cut
1057
1058register_read_type netstring => sub {
1059 my ($self, $cb) = @_;
1060
1061 sub {
1062 unless ($_[0]{rbuf} =~ s/^(0|[1-9][0-9]*)://) {
1063 if ($_[0]{rbuf} =~ /[^0-9]/) {
1064 $self->_error (&Errno::EBADMSG);
1065 }
1066 return;
1067 }
1068
1069 my $len = $1;
1070
1071 $self->unshift_read (chunk => $len, sub {
1072 my $string = $_[1];
1073 $_[0]->unshift_read (chunk => 1, sub {
1074 if ($_[1] eq ",") {
1075 $cb->($_[0], $string);
1076 } else {
1077 $self->_error (&Errno::EBADMSG);
1078 }
1079 });
1080 });
1081
1082 1
1083 }
1084};
1085
1086=item packstring => $format, $cb->($handle, $string)
1087
1088An octet string prefixed with an encoded length. The encoding C<$format>
1089uses the same format as a Perl C<pack> format, but must specify a single
1090integer only (only one of C<cCsSlLqQiInNvVjJw> is allowed, plus an
1091optional C<!>, C<< < >> or C<< > >> modifier).
1092
1093DNS over TCP uses a prefix of C<n>, EPP uses a prefix of C<N>.
1094
1095Example: read a block of data prefixed by its length in BER-encoded
1096format (very efficient).
1097
1098 $handle->push_read (packstring => "w", sub {
1099 my ($handle, $data) = @_;
1100 });
1101
1102=cut
1103
1104register_read_type packstring => sub {
1105 my ($self, $cb, $format) = @_;
1106
1107 sub {
1108 # when we can use 5.10 we can use ".", but for 5.8 we use the re-pack method
1109 defined (my $len = eval { unpack $format, $_[0]{rbuf} })
1110 or return;
1111
1112 $format = length pack $format, $len;
1113
1114 # bypass unshift if we already have the remaining chunk
1115 if ($format + $len <= length $_[0]{rbuf}) {
1116 my $data = substr $_[0]{rbuf}, $format, $len;
1117 substr $_[0]{rbuf}, 0, $format + $len, "";
1118 $cb->($_[0], $data);
1119 } else {
1120 # remove prefix
1121 substr $_[0]{rbuf}, 0, $format, "";
1122
1123 # read remaining chunk
1124 $_[0]->unshift_read (chunk => $len, $cb);
1125 }
1126
1127 1
1128 }
1129};
1130
967=item json => $cb->($handle, $hash_or_arrayref) 1131=item json => $cb->($handle, $hash_or_arrayref)
968 1132
969Reads a JSON object or array, decodes it and passes it to the callback. 1133Reads a JSON object or array, decodes it and passes it to the callback.
970 1134
971If a C<json> object was passed to the constructor, then that will be used 1135If a C<json> object was passed to the constructor, then that will be used
981the C<json> write type description, above, for an actual example. 1145the C<json> write type description, above, for an actual example.
982 1146
983=cut 1147=cut
984 1148
985register_read_type json => sub { 1149register_read_type json => sub {
986 my ($self, $cb, $accept, $reject, $skip) = @_; 1150 my ($self, $cb) = @_;
987 1151
988 require JSON; 1152 require JSON;
989 1153
990 my $data; 1154 my $data;
991 my $rbuf = \$self->{rbuf}; 1155 my $rbuf = \$self->{rbuf};
1006 () 1170 ()
1007 } 1171 }
1008 } 1172 }
1009}; 1173};
1010 1174
1175=item storable => $cb->($handle, $ref)
1176
1177Deserialises a L<Storable> frozen representation as written by the
1178C<storable> write type (BER-encoded length prefix followed by nfreeze'd
1179data).
1180
1181Raises C<EBADMSG> error if the data could not be decoded.
1182
1183=cut
1184
1185register_read_type storable => sub {
1186 my ($self, $cb) = @_;
1187
1188 require Storable;
1189
1190 sub {
1191 # when we can use 5.10 we can use ".", but for 5.8 we use the re-pack method
1192 defined (my $len = eval { unpack "w", $_[0]{rbuf} })
1193 or return;
1194
1195 my $format = length pack "w", $len;
1196
1197 # bypass unshift if we already have the remaining chunk
1198 if ($format + $len <= length $_[0]{rbuf}) {
1199 my $data = substr $_[0]{rbuf}, $format, $len;
1200 substr $_[0]{rbuf}, 0, $format + $len, "";
1201 $cb->($_[0], Storable::thaw ($data));
1202 } else {
1203 # remove prefix
1204 substr $_[0]{rbuf}, 0, $format, "";
1205
1206 # read remaining chunk
1207 $_[0]->unshift_read (chunk => $len, sub {
1208 if (my $ref = eval { Storable::thaw ($_[1]) }) {
1209 $cb->($_[0], $ref);
1210 } else {
1211 $self->_error (&Errno::EBADMSG);
1212 }
1213 });
1214 }
1215
1216 1
1217 }
1218};
1219
1011=back 1220=back
1012 1221
1013=item AnyEvent::Handle::register_read_type type => $coderef->($handle, $cb, @args) 1222=item AnyEvent::Handle::register_read_type type => $coderef->($handle, $cb, @args)
1014 1223
1015This function (not method) lets you add your own types to C<push_read>. 1224This function (not method) lets you add your own types to C<push_read>.
1033=item $handle->stop_read 1242=item $handle->stop_read
1034 1243
1035=item $handle->start_read 1244=item $handle->start_read
1036 1245
1037In rare cases you actually do not want to read anything from the 1246In rare cases you actually do not want to read anything from the
1038socket. In this case you can call C<stop_read>. Neither C<on_read> no 1247socket. In this case you can call C<stop_read>. Neither C<on_read> nor
1039any queued callbacks will be executed then. To start reading again, call 1248any queued callbacks will be executed then. To start reading again, call
1040C<start_read>. 1249C<start_read>.
1041 1250
1042Note that AnyEvent::Handle will automatically C<start_read> for you when 1251Note that AnyEvent::Handle will automatically C<start_read> for you when
1043you change the C<on_read> callback or push/unshift a read callback, and it 1252you change the C<on_read> callback or push/unshift a read callback, and it
1065 if ($len > 0) { 1274 if ($len > 0) {
1066 $self->{_activity} = AnyEvent->now; 1275 $self->{_activity} = AnyEvent->now;
1067 1276
1068 $self->{filter_r} 1277 $self->{filter_r}
1069 ? $self->{filter_r}($self, $rbuf) 1278 ? $self->{filter_r}($self, $rbuf)
1070 : $self->_drain_rbuf; 1279 : $self->{_in_drain} || $self->_drain_rbuf;
1071 1280
1072 } elsif (defined $len) { 1281 } elsif (defined $len) {
1073 delete $self->{_rw}; 1282 delete $self->{_rw};
1074 $self->{_eof} = 1; 1283 $self->{_eof} = 1;
1075 $self->_drain_rbuf; 1284 $self->_drain_rbuf unless $self->{_in_drain};
1076 1285
1077 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) { 1286 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) {
1078 return $self->_error ($!, 1); 1287 return $self->_error ($!, 1);
1079 } 1288 }
1080 }); 1289 });
1098 } 1307 }
1099 1308
1100 while (defined ($buf = Net::SSLeay::read ($self->{tls}))) { 1309 while (defined ($buf = Net::SSLeay::read ($self->{tls}))) {
1101 if (length $buf) { 1310 if (length $buf) {
1102 $self->{rbuf} .= $buf; 1311 $self->{rbuf} .= $buf;
1103 $self->_drain_rbuf; 1312 $self->_drain_rbuf unless $self->{_in_drain};
1104 } else { 1313 } else {
1105 # let's treat SSL-eof as we treat normal EOF 1314 # let's treat SSL-eof as we treat normal EOF
1106 $self->{_eof} = 1; 1315 $self->{_eof} = 1;
1107 $self->_shutdown; 1316 $self->_shutdown;
1108 return; 1317 return;
1200 1409
1201sub DESTROY { 1410sub DESTROY {
1202 my $self = shift; 1411 my $self = shift;
1203 1412
1204 $self->stoptls; 1413 $self->stoptls;
1414
1415 my $linger = exists $self->{linger} ? $self->{linger} : 3600;
1416
1417 if ($linger && length $self->{wbuf}) {
1418 my $fh = delete $self->{fh};
1419 my $wbuf = delete $self->{wbuf};
1420
1421 my @linger;
1422
1423 push @linger, AnyEvent->io (fh => $fh, poll => "w", cb => sub {
1424 my $len = syswrite $fh, $wbuf, length $wbuf;
1425
1426 if ($len > 0) {
1427 substr $wbuf, 0, $len, "";
1428 } else {
1429 @linger = (); # end
1430 }
1431 });
1432 push @linger, AnyEvent->timer (after => $linger, cb => sub {
1433 @linger = ();
1434 });
1435 }
1205} 1436}
1206 1437
1207=item AnyEvent::Handle::TLS_CTX 1438=item AnyEvent::Handle::TLS_CTX
1208 1439
1209This function creates and returns the Net::SSLeay::CTX object used by 1440This function creates and returns the Net::SSLeay::CTX object used by
1251=over 4 1482=over 4
1252 1483
1253=item * all constructor arguments become object members. 1484=item * all constructor arguments become object members.
1254 1485
1255At least initially, when you pass a C<tls>-argument to the constructor it 1486At least initially, when you pass a C<tls>-argument to the constructor it
1256will end up in C<< $handle->{tls} >>. Those members might be changes or 1487will end up in C<< $handle->{tls} >>. Those members might be changed or
1257mutated later on (for example C<tls> will hold the TLS connection object). 1488mutated later on (for example C<tls> will hold the TLS connection object).
1258 1489
1259=item * other object member names are prefixed with an C<_>. 1490=item * other object member names are prefixed with an C<_>.
1260 1491
1261All object members not explicitly documented (internal use) are prefixed 1492All object members not explicitly documented (internal use) are prefixed

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines