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.61 by root, Fri Jun 6 10:23:50 2008 UTC vs.
Revision 1.84 by root, Thu Aug 21 19:13:05 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.14; 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
123 140
124This 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
125(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).
126 143
127To 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.
128 151
129=item timeout => $fractional_seconds 152=item timeout => $fractional_seconds
130 153
131If non-zero, then this enables an "inactivity" timeout: whenever this many 154If non-zero, then this enables an "inactivity" timeout: whenever this many
132seconds pass without a successful read or write on the underlying file 155seconds pass without a successful read or write on the underlying file
156be 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
157(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
158amount 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
159isn't finished). 182isn't finished).
160 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
161=item read_size => <bytes> 208=item read_size => <bytes>
162 209
163The 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
164during each (loop iteration). Default: C<8192>. 211during each (loop iteration). Default: C<8192>.
165 212
166=item low_water_mark => <bytes> 213=item low_water_mark => <bytes>
167 214
168Sets 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
169buffer: 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
170considered empty. 217considered empty.
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.
171 229
172=item tls => "accept" | "connect" | Net::SSLeay::SSL object 230=item tls => "accept" | "connect" | Net::SSLeay::SSL object
173 231
174When this parameter is given, it enables TLS (SSL) mode, that means it 232When this parameter is given, it enables TLS (SSL) mode, that means it
175will start making tls handshake and will transparently encrypt/decrypt 233will start making tls handshake and will transparently encrypt/decrypt
184You can also provide your own TLS connection object, but you have 242You can also provide your own TLS connection object, but you have
185to make sure that you call either C<Net::SSLeay::set_connect_state> 243to make sure that you call either C<Net::SSLeay::set_connect_state>
186or C<Net::SSLeay::set_accept_state> on it before you pass it to 244or C<Net::SSLeay::set_accept_state> on it before you pass it to
187AnyEvent::Handle. 245AnyEvent::Handle.
188 246
189See the C<starttls> method if you need to start TLs negotiation later. 247See the C<starttls> method if you need to start TLS negotiation later.
190 248
191=item tls_ctx => $ssl_ctx 249=item tls_ctx => $ssl_ctx
192 250
193Use the given Net::SSLeay::CTX object to create the new TLS connection 251Use the given Net::SSLeay::CTX object to create the new TLS connection
194(unless a connection object was specified directly). If this parameter is 252(unless a connection object was specified directly). If this parameter is
229 } 287 }
230 288
231 $self->{_activity} = AnyEvent->now; 289 $self->{_activity} = AnyEvent->now;
232 $self->_timeout; 290 $self->_timeout;
233 291
234 $self->on_drain (delete $self->{on_drain}) if $self->{on_drain}; 292 $self->on_drain (delete $self->{on_drain}) if exists $self->{on_drain};
293 $self->no_delay (delete $self->{no_delay}) if exists $self->{no_delay};
294
295 $self->start_read
296 if $self->{on_read};
235 297
236 $self 298 $self
237} 299}
238 300
239sub _shutdown { 301sub _shutdown {
243 delete $self->{_rw}; 305 delete $self->{_rw};
244 delete $self->{_ww}; 306 delete $self->{_ww};
245 delete $self->{fh}; 307 delete $self->{fh};
246 308
247 $self->stoptls; 309 $self->stoptls;
310
311 delete $self->{on_read};
312 delete $self->{_queue};
248} 313}
249 314
250sub _error { 315sub _error {
251 my ($self, $errno, $fatal) = @_; 316 my ($self, $errno, $fatal) = @_;
252 317
298 363
299=cut 364=cut
300 365
301sub on_timeout { 366sub on_timeout {
302 $_[0]{on_timeout} = $_[1]; 367 $_[0]{on_timeout} = $_[1];
368}
369
370=item $handle->autocork ($boolean)
371
372Enables or disables the current autocork behaviour (see C<autocork>
373constructor argument).
374
375=cut
376
377=item $handle->no_delay ($boolean)
378
379Enables or disables the C<no_delay> setting (see constructor argument of
380the same name for details).
381
382=cut
383
384sub no_delay {
385 $_[0]{no_delay} = $_[1];
386
387 eval {
388 local $SIG{__DIE__};
389 setsockopt $_[0]{fh}, &Socket::IPPROTO_TCP, &Socket::TCP_NODELAY, int $_[1];
390 };
303} 391}
304 392
305############################################################################# 393#############################################################################
306 394
307=item $handle->timeout ($seconds) 395=item $handle->timeout ($seconds)
422 $self->_error ($!, 1); 510 $self->_error ($!, 1);
423 } 511 }
424 }; 512 };
425 513
426 # try to write data immediately 514 # try to write data immediately
427 $cb->(); 515 $cb->() unless $self->{autocork};
428 516
429 # if still data left in wbuf, we need to poll 517 # if still data left in wbuf, we need to poll
430 $self->{_ww} = AnyEvent->io (fh => $self->{fh}, poll => "w", cb => $cb) 518 $self->{_ww} = AnyEvent->io (fh => $self->{fh}, poll => "w", cb => $cb)
431 if length $self->{wbuf}; 519 if length $self->{wbuf};
432 }; 520 };
489=cut 577=cut
490 578
491register_write_type packstring => sub { 579register_write_type packstring => sub {
492 my ($self, $format, $string) = @_; 580 my ($self, $format, $string) = @_;
493 581
494 pack "$format/a", $string 582 pack "$format/a*", $string
495}; 583};
496 584
497=item json => $array_or_hashref 585=item json => $array_or_hashref
498 586
499Encodes the given hash or array reference into a JSON object. Unless you 587Encodes the given hash or array reference into a JSON object. Unless you
533 621
534 $self->{json} ? $self->{json}->encode ($ref) 622 $self->{json} ? $self->{json}->encode ($ref)
535 : JSON::encode_json ($ref) 623 : JSON::encode_json ($ref)
536}; 624};
537 625
626=item storable => $reference
627
628Freezes the given reference using L<Storable> and writes it to the
629handle. Uses the C<nfreeze> format.
630
631=cut
632
633register_write_type storable => sub {
634 my ($self, $ref) = @_;
635
636 require Storable;
637
638 pack "w/a*", Storable::nfreeze ($ref)
639};
640
538=back 641=back
539 642
540=item AnyEvent::Handle::register_write_type type => $coderef->($handle, @args) 643=item AnyEvent::Handle::register_write_type type => $coderef->($handle, @args)
541 644
542This function (not method) lets you add your own types to C<push_write>. 645This function (not method) lets you add your own types to C<push_write>.
564ways, the "simple" way, using only C<on_read> and the "complex" way, using 667ways, the "simple" way, using only C<on_read> and the "complex" way, using
565a queue. 668a queue.
566 669
567In the simple case, you just install an C<on_read> callback and whenever 670In the simple case, you just install an C<on_read> callback and whenever
568new data arrives, it will be called. You can then remove some data (if 671new data arrives, it will be called. You can then remove some data (if
569enough is there) from the read buffer (C<< $handle->rbuf >>) if you want 672enough is there) from the read buffer (C<< $handle->rbuf >>). Or you cna
570or not. 673leave the data there if you want to accumulate more (e.g. when only a
674partial message has been received so far).
571 675
572In the more complex case, you want to queue multiple callbacks. In this 676In the more complex case, you want to queue multiple callbacks. In this
573case, AnyEvent::Handle will call the first queued callback each time new 677case, AnyEvent::Handle will call the first queued callback each time new
574data arrives (also the first time it is queued) and removes it when it has 678data arrives (also the first time it is queued) and removes it when it has
575done its job (see C<push_read>, below). 679done its job (see C<push_read>, below).
593 # handle xml 697 # handle xml
594 }); 698 });
595 }); 699 });
596 }); 700 });
597 701
598Example 2: Implement a client for a protocol that replies either with 702Example 2: Implement a client for a protocol that replies either with "OK"
599"OK" and another line or "ERROR" for one request, and 64 bytes for the 703and another line or "ERROR" for the first request that is sent, and 64
600second request. Due tot he availability of a full queue, we can just 704bytes for the second request. Due to the availability of a queue, we can
601pipeline sending both requests and manipulate the queue as necessary in 705just pipeline sending both requests and manipulate the queue as necessary
602the callbacks: 706in the callbacks.
603 707
604 # request one 708When the first callback is called and sees an "OK" response, it will
709C<unshift> another line-read. This line-read will be queued I<before> the
71064-byte chunk callback.
711
712 # request one, returns either "OK + extra line" or "ERROR"
605 $handle->push_write ("request 1\015\012"); 713 $handle->push_write ("request 1\015\012");
606 714
607 # we expect "ERROR" or "OK" as response, so push a line read 715 # we expect "ERROR" or "OK" as response, so push a line read
608 $handle->push_read (line => sub { 716 $handle->push_read (line => sub {
609 # if we got an "OK", we have to _prepend_ another line, 717 # if we got an "OK", we have to _prepend_ another line,
616 ... 724 ...
617 }); 725 });
618 } 726 }
619 }); 727 });
620 728
621 # request two 729 # request two, simply returns 64 octets
622 $handle->push_write ("request 2\015\012"); 730 $handle->push_write ("request 2\015\012");
623 731
624 # simply read 64 bytes, always 732 # simply read 64 bytes, always
625 $handle->push_read (chunk => 64, sub { 733 $handle->push_read (chunk => 64, sub {
626 my $response = $_[1]; 734 my $response = $_[1];
638 746
639 if ( 747 if (
640 defined $self->{rbuf_max} 748 defined $self->{rbuf_max}
641 && $self->{rbuf_max} < length $self->{rbuf} 749 && $self->{rbuf_max} < length $self->{rbuf}
642 ) { 750 ) {
643 return $self->_error (&Errno::ENOSPC, 1); 751 $self->_error (&Errno::ENOSPC, 1), return;
644 } 752 }
645 753
646 while () { 754 while () {
647 no strict 'refs';
648
649 my $len = length $self->{rbuf}; 755 my $len = length $self->{rbuf};
650 756
651 if (my $cb = shift @{ $self->{_queue} }) { 757 if (my $cb = shift @{ $self->{_queue} }) {
652 unless ($cb->($self)) { 758 unless ($cb->($self)) {
653 if ($self->{_eof}) { 759 if ($self->{_eof}) {
654 # no progress can be made (not enough data and no data forthcoming) 760 # no progress can be made (not enough data and no data forthcoming)
655 $self->_error (&Errno::EPIPE, 1), last; 761 $self->_error (&Errno::EPIPE, 1), return;
656 } 762 }
657 763
658 unshift @{ $self->{_queue} }, $cb; 764 unshift @{ $self->{_queue} }, $cb;
659 last; 765 last;
660 } 766 }
668 && !@{ $self->{_queue} } # and the queue is still empty 774 && !@{ $self->{_queue} } # and the queue is still empty
669 && $self->{on_read} # but we still have on_read 775 && $self->{on_read} # but we still have on_read
670 ) { 776 ) {
671 # no further data will arrive 777 # no further data will arrive
672 # so no progress can be made 778 # so no progress can be made
673 $self->_error (&Errno::EPIPE, 1), last 779 $self->_error (&Errno::EPIPE, 1), return
674 if $self->{_eof}; 780 if $self->{_eof};
675 781
676 last; # more data might arrive 782 last; # more data might arrive
677 } 783 }
678 } else { 784 } else {
680 delete $self->{_rw}; 786 delete $self->{_rw};
681 last; 787 last;
682 } 788 }
683 } 789 }
684 790
791 if ($self->{_eof}) {
792 if ($self->{on_eof}) {
685 $self->{on_eof}($self) 793 $self->{on_eof}($self)
686 if $self->{_eof} && $self->{on_eof}; 794 } else {
795 $self->_error (0, 1);
796 }
797 }
687 798
688 # may need to restart read watcher 799 # may need to restart read watcher
689 unless ($self->{_rw}) { 800 unless ($self->{_rw}) {
690 $self->start_read 801 $self->start_read
691 if $self->{on_read} || @{ $self->{_queue} }; 802 if $self->{on_read} || @{ $self->{_queue} };
817 $cb->($_[0], substr $_[0]{rbuf}, 0, $len, ""); 928 $cb->($_[0], substr $_[0]{rbuf}, 0, $len, "");
818 1 929 1
819 } 930 }
820}; 931};
821 932
822# compatibility with older API
823sub push_read_chunk {
824 $_[0]->push_read (chunk => $_[1], $_[2]);
825}
826
827sub unshift_read_chunk {
828 $_[0]->unshift_read (chunk => $_[1], $_[2]);
829}
830
831=item line => [$eol, ]$cb->($handle, $line, $eol) 933=item line => [$eol, ]$cb->($handle, $line, $eol)
832 934
833The callback will be called only once a full line (including the end of 935The callback will be called only once a full line (including the end of
834line marker, C<$eol>) has been read. This line (excluding the end of line 936line marker, C<$eol>) has been read. This line (excluding the end of line
835marker) will be passed to the callback as second argument (C<$line>), and 937marker) will be passed to the callback as second argument (C<$line>), and
850=cut 952=cut
851 953
852register_read_type line => sub { 954register_read_type line => sub {
853 my ($self, $cb, $eol) = @_; 955 my ($self, $cb, $eol) = @_;
854 956
855 $eol = qr|(\015?\012)| if @_ < 3; 957 if (@_ < 3) {
958 # this is more than twice as fast as the generic code below
959 sub {
960 $_[0]{rbuf} =~ s/^([^\015\012]*)(\015?\012)// or return;
961
962 $cb->($_[0], $1, $2);
963 1
964 }
965 } else {
856 $eol = quotemeta $eol unless ref $eol; 966 $eol = quotemeta $eol unless ref $eol;
857 $eol = qr|^(.*?)($eol)|s; 967 $eol = qr|^(.*?)($eol)|s;
858 968
859 sub { 969 sub {
860 $_[0]{rbuf} =~ s/$eol// or return; 970 $_[0]{rbuf} =~ s/$eol// or return;
861 971
862 $cb->($_[0], $1, $2); 972 $cb->($_[0], $1, $2);
973 1
863 1 974 }
864 } 975 }
865}; 976};
866
867# compatibility with older API
868sub push_read_line {
869 my $self = shift;
870 $self->push_read (line => @_);
871}
872
873sub unshift_read_line {
874 my $self = shift;
875 $self->unshift_read (line => @_);
876}
877 977
878=item regex => $accept[, $reject[, $skip], $cb->($handle, $data) 978=item regex => $accept[, $reject[, $skip], $cb->($handle, $data)
879 979
880Makes a regex match against the regex object C<$accept> and returns 980Makes a regex match against the regex object C<$accept> and returns
881everything up to and including the match. 981everything up to and including the match.
1002register_read_type packstring => sub { 1102register_read_type packstring => sub {
1003 my ($self, $cb, $format) = @_; 1103 my ($self, $cb, $format) = @_;
1004 1104
1005 sub { 1105 sub {
1006 # when we can use 5.10 we can use ".", but for 5.8 we use the re-pack method 1106 # when we can use 5.10 we can use ".", but for 5.8 we use the re-pack method
1007 defined (my $len = eval { unpack $format, $_[0]->{rbuf} }) 1107 defined (my $len = eval { unpack $format, $_[0]{rbuf} })
1008 or return; 1108 or return;
1009 1109
1110 $format = length pack $format, $len;
1111
1112 # bypass unshift if we already have the remaining chunk
1113 if ($format + $len <= length $_[0]{rbuf}) {
1114 my $data = substr $_[0]{rbuf}, $format, $len;
1115 substr $_[0]{rbuf}, 0, $format + $len, "";
1116 $cb->($_[0], $data);
1117 } else {
1010 # remove prefix 1118 # remove prefix
1011 substr $_[0]->{rbuf}, 0, (length pack $format, $len), ""; 1119 substr $_[0]{rbuf}, 0, $format, "";
1012 1120
1013 # read rest 1121 # read remaining chunk
1014 $_[0]->unshift_read (chunk => $len, $cb); 1122 $_[0]->unshift_read (chunk => $len, $cb);
1123 }
1015 1124
1016 1 1125 1
1017 } 1126 }
1018}; 1127};
1019 1128
1034the C<json> write type description, above, for an actual example. 1143the C<json> write type description, above, for an actual example.
1035 1144
1036=cut 1145=cut
1037 1146
1038register_read_type json => sub { 1147register_read_type json => sub {
1039 my ($self, $cb, $accept, $reject, $skip) = @_; 1148 my ($self, $cb) = @_;
1040 1149
1041 require JSON; 1150 require JSON;
1042 1151
1043 my $data; 1152 my $data;
1044 my $rbuf = \$self->{rbuf}; 1153 my $rbuf = \$self->{rbuf};
1056 1 1165 1
1057 } else { 1166 } else {
1058 $self->{rbuf} = ""; 1167 $self->{rbuf} = "";
1059 () 1168 ()
1060 } 1169 }
1170 }
1171};
1172
1173=item storable => $cb->($handle, $ref)
1174
1175Deserialises a L<Storable> frozen representation as written by the
1176C<storable> write type (BER-encoded length prefix followed by nfreeze'd
1177data).
1178
1179Raises C<EBADMSG> error if the data could not be decoded.
1180
1181=cut
1182
1183register_read_type storable => sub {
1184 my ($self, $cb) = @_;
1185
1186 require Storable;
1187
1188 sub {
1189 # when we can use 5.10 we can use ".", but for 5.8 we use the re-pack method
1190 defined (my $len = eval { unpack "w", $_[0]{rbuf} })
1191 or return;
1192
1193 my $format = length pack "w", $len;
1194
1195 # bypass unshift if we already have the remaining chunk
1196 if ($format + $len <= length $_[0]{rbuf}) {
1197 my $data = substr $_[0]{rbuf}, $format, $len;
1198 substr $_[0]{rbuf}, 0, $format + $len, "";
1199 $cb->($_[0], Storable::thaw ($data));
1200 } else {
1201 # remove prefix
1202 substr $_[0]{rbuf}, 0, $format, "";
1203
1204 # read remaining chunk
1205 $_[0]->unshift_read (chunk => $len, sub {
1206 if (my $ref = eval { Storable::thaw ($_[1]) }) {
1207 $cb->($_[0], $ref);
1208 } else {
1209 $self->_error (&Errno::EBADMSG);
1210 }
1211 });
1212 }
1213
1214 1
1061 } 1215 }
1062}; 1216};
1063 1217
1064=back 1218=back
1065 1219
1253 1407
1254sub DESTROY { 1408sub DESTROY {
1255 my $self = shift; 1409 my $self = shift;
1256 1410
1257 $self->stoptls; 1411 $self->stoptls;
1412
1413 my $linger = exists $self->{linger} ? $self->{linger} : 3600;
1414
1415 if ($linger && length $self->{wbuf}) {
1416 my $fh = delete $self->{fh};
1417 my $wbuf = delete $self->{wbuf};
1418
1419 my @linger;
1420
1421 push @linger, AnyEvent->io (fh => $fh, poll => "w", cb => sub {
1422 my $len = syswrite $fh, $wbuf, length $wbuf;
1423
1424 if ($len > 0) {
1425 substr $wbuf, 0, $len, "";
1426 } else {
1427 @linger = (); # end
1428 }
1429 });
1430 push @linger, AnyEvent->timer (after => $linger, cb => sub {
1431 @linger = ();
1432 });
1433 }
1258} 1434}
1259 1435
1260=item AnyEvent::Handle::TLS_CTX 1436=item AnyEvent::Handle::TLS_CTX
1261 1437
1262This function creates and returns the Net::SSLeay::CTX object used by 1438This function creates and returns the Net::SSLeay::CTX object used by
1304=over 4 1480=over 4
1305 1481
1306=item * all constructor arguments become object members. 1482=item * all constructor arguments become object members.
1307 1483
1308At least initially, when you pass a C<tls>-argument to the constructor it 1484At least initially, when you pass a C<tls>-argument to the constructor it
1309will end up in C<< $handle->{tls} >>. Those members might be changes or 1485will end up in C<< $handle->{tls} >>. Those members might be changed or
1310mutated later on (for example C<tls> will hold the TLS connection object). 1486mutated later on (for example C<tls> will hold the TLS connection object).
1311 1487
1312=item * other object member names are prefixed with an C<_>. 1488=item * other object member names are prefixed with an C<_>.
1313 1489
1314All object members not explicitly documented (internal use) are prefixed 1490All object members not explicitly documented (internal use) are prefixed

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines