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.62 by root, Fri Jun 6 10:49:20 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.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
180This will not work for partial TLS data that could not yet been 227This will not work for partial TLS data that could not yet been
181encoded. This data will be lost. 228encoded. This data will be lost.
182 229
183=item tls => "accept" | "connect" | Net::SSLeay::SSL object 230=item tls => "accept" | "connect" | Net::SSLeay::SSL object
184 231
185When this parameter is given, it enables TLS (SSL) mode, that means it 232When this parameter is given, it enables TLS (SSL) mode, that means
186will start making tls handshake and will transparently encrypt/decrypt 233AnyEvent will start a TLS handshake and will transparently encrypt/decrypt
187data. 234data.
188 235
189TLS mode requires Net::SSLeay to be installed (it will be loaded 236TLS mode requires Net::SSLeay to be installed (it will be loaded
190automatically when you try to create a TLS handle). 237automatically when you try to create a TLS handle).
191 238
192For 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
193connection, use C<connect> mode. 240C<accept>, and for the TLS client side of a connection, use C<connect>
241mode.
194 242
195You can also provide your own TLS connection object, but you have 243You can also provide your own TLS connection object, but you have
196to 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>
197or 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
198AnyEvent::Handle. 246AnyEvent::Handle.
199 247
200See 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.
201 249
202=item tls_ctx => $ssl_ctx 250=item tls_ctx => $ssl_ctx
203 251
204Use 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
205(unless a connection object was specified directly). If this parameter is 253(unless a connection object was specified directly). If this parameter is
208=item json => JSON or JSON::XS object 256=item json => JSON or JSON::XS object
209 257
210This 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.
211 259
212If 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
213suitable 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.
214 263
215Note 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
216use this functionality, as AnyEvent does not have a dependency itself. 265use this functionality, as AnyEvent does not have a dependency itself.
217 266
218=item filter_r => $cb 267=item filter_r => $cb
240 } 289 }
241 290
242 $self->{_activity} = AnyEvent->now; 291 $self->{_activity} = AnyEvent->now;
243 $self->_timeout; 292 $self->_timeout;
244 293
245 $self->on_drain (delete $self->{on_drain}) if $self->{on_drain}; 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
297 $self->start_read
298 if $self->{on_read};
246 299
247 $self 300 $self
248} 301}
249 302
250sub _shutdown { 303sub _shutdown {
254 delete $self->{_rw}; 307 delete $self->{_rw};
255 delete $self->{_ww}; 308 delete $self->{_ww};
256 delete $self->{fh}; 309 delete $self->{fh};
257 310
258 $self->stoptls; 311 $self->stoptls;
312
313 delete $self->{on_read};
314 delete $self->{_queue};
259} 315}
260 316
261sub _error { 317sub _error {
262 my ($self, $errno, $fatal) = @_; 318 my ($self, $errno, $fatal) = @_;
263 319
309 365
310=cut 366=cut
311 367
312sub on_timeout { 368sub on_timeout {
313 $_[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 };
314} 393}
315 394
316############################################################################# 395#############################################################################
317 396
318=item $handle->timeout ($seconds) 397=item $handle->timeout ($seconds)
433 $self->_error ($!, 1); 512 $self->_error ($!, 1);
434 } 513 }
435 }; 514 };
436 515
437 # try to write data immediately 516 # try to write data immediately
438 $cb->(); 517 $cb->() unless $self->{autocork};
439 518
440 # if still data left in wbuf, we need to poll 519 # if still data left in wbuf, we need to poll
441 $self->{_ww} = AnyEvent->io (fh => $self->{fh}, poll => "w", cb => $cb) 520 $self->{_ww} = AnyEvent->io (fh => $self->{fh}, poll => "w", cb => $cb)
442 if length $self->{wbuf}; 521 if length $self->{wbuf};
443 }; 522 };
500=cut 579=cut
501 580
502register_write_type packstring => sub { 581register_write_type packstring => sub {
503 my ($self, $format, $string) = @_; 582 my ($self, $format, $string) = @_;
504 583
505 pack "$format/a", $string 584 pack "$format/a*", $string
506}; 585};
507 586
508=item json => $array_or_hashref 587=item json => $array_or_hashref
509 588
510Encodes 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
544 623
545 $self->{json} ? $self->{json}->encode ($ref) 624 $self->{json} ? $self->{json}->encode ($ref)
546 : JSON::encode_json ($ref) 625 : JSON::encode_json ($ref)
547}; 626};
548 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
549=back 643=back
550 644
551=item AnyEvent::Handle::register_write_type type => $coderef->($handle, @args) 645=item AnyEvent::Handle::register_write_type type => $coderef->($handle, @args)
552 646
553This 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>.
575ways, 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
576a queue. 670a queue.
577 671
578In 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
579new 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
580enough 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
581or not. 675leave the data there if you want to accumulate more (e.g. when only a
676partial message has been received so far).
582 677
583In 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
584case, AnyEvent::Handle will call the first queued callback each time new 679case, AnyEvent::Handle will call the first queued callback each time new
585data arrives (also the first time it is queued) and removes it when it has 680data arrives (also the first time it is queued) and removes it when it has
586done its job (see C<push_read>, below). 681done its job (see C<push_read>, below).
604 # handle xml 699 # handle xml
605 }); 700 });
606 }); 701 });
607 }); 702 });
608 703
609Example 2: Implement a client for a protocol that replies either with 704Example 2: Implement a client for a protocol that replies either with "OK"
610"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
611second 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
612pipeline sending both requests and manipulate the queue as necessary in 707just pipeline sending both requests and manipulate the queue as necessary
613the callbacks: 708in the callbacks.
614 709
615 # 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"
616 $handle->push_write ("request 1\015\012"); 715 $handle->push_write ("request 1\015\012");
617 716
618 # 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
619 $handle->push_read (line => sub { 718 $handle->push_read (line => sub {
620 # if we got an "OK", we have to _prepend_ another line, 719 # if we got an "OK", we have to _prepend_ another line,
627 ... 726 ...
628 }); 727 });
629 } 728 }
630 }); 729 });
631 730
632 # request two 731 # request two, simply returns 64 octets
633 $handle->push_write ("request 2\015\012"); 732 $handle->push_write ("request 2\015\012");
634 733
635 # simply read 64 bytes, always 734 # simply read 64 bytes, always
636 $handle->push_read (chunk => 64, sub { 735 $handle->push_read (chunk => 64, sub {
637 my $response = $_[1]; 736 my $response = $_[1];
649 748
650 if ( 749 if (
651 defined $self->{rbuf_max} 750 defined $self->{rbuf_max}
652 && $self->{rbuf_max} < length $self->{rbuf} 751 && $self->{rbuf_max} < length $self->{rbuf}
653 ) { 752 ) {
654 return $self->_error (&Errno::ENOSPC, 1); 753 $self->_error (&Errno::ENOSPC, 1), return;
655 } 754 }
656 755
657 while () { 756 while () {
658 no strict 'refs';
659
660 my $len = length $self->{rbuf}; 757 my $len = length $self->{rbuf};
661 758
662 if (my $cb = shift @{ $self->{_queue} }) { 759 if (my $cb = shift @{ $self->{_queue} }) {
663 unless ($cb->($self)) { 760 unless ($cb->($self)) {
664 if ($self->{_eof}) { 761 if ($self->{_eof}) {
665 # 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)
666 $self->_error (&Errno::EPIPE, 1), last; 763 $self->_error (&Errno::EPIPE, 1), return;
667 } 764 }
668 765
669 unshift @{ $self->{_queue} }, $cb; 766 unshift @{ $self->{_queue} }, $cb;
670 last; 767 last;
671 } 768 }
679 && !@{ $self->{_queue} } # and the queue is still empty 776 && !@{ $self->{_queue} } # and the queue is still empty
680 && $self->{on_read} # but we still have on_read 777 && $self->{on_read} # but we still have on_read
681 ) { 778 ) {
682 # no further data will arrive 779 # no further data will arrive
683 # so no progress can be made 780 # so no progress can be made
684 $self->_error (&Errno::EPIPE, 1), last 781 $self->_error (&Errno::EPIPE, 1), return
685 if $self->{_eof}; 782 if $self->{_eof};
686 783
687 last; # more data might arrive 784 last; # more data might arrive
688 } 785 }
689 } else { 786 } else {
691 delete $self->{_rw}; 788 delete $self->{_rw};
692 last; 789 last;
693 } 790 }
694 } 791 }
695 792
793 if ($self->{_eof}) {
794 if ($self->{on_eof}) {
696 $self->{on_eof}($self) 795 $self->{on_eof}($self)
697 if $self->{_eof} && $self->{on_eof}; 796 } else {
797 $self->_error (0, 1);
798 }
799 }
698 800
699 # may need to restart read watcher 801 # may need to restart read watcher
700 unless ($self->{_rw}) { 802 unless ($self->{_rw}) {
701 $self->start_read 803 $self->start_read
702 if $self->{on_read} || @{ $self->{_queue} }; 804 if $self->{on_read} || @{ $self->{_queue} };
828 $cb->($_[0], substr $_[0]{rbuf}, 0, $len, ""); 930 $cb->($_[0], substr $_[0]{rbuf}, 0, $len, "");
829 1 931 1
830 } 932 }
831}; 933};
832 934
833# compatibility with older API
834sub push_read_chunk {
835 $_[0]->push_read (chunk => $_[1], $_[2]);
836}
837
838sub unshift_read_chunk {
839 $_[0]->unshift_read (chunk => $_[1], $_[2]);
840}
841
842=item line => [$eol, ]$cb->($handle, $line, $eol) 935=item line => [$eol, ]$cb->($handle, $line, $eol)
843 936
844The 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
845line 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
846marker) 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
861=cut 954=cut
862 955
863register_read_type line => sub { 956register_read_type line => sub {
864 my ($self, $cb, $eol) = @_; 957 my ($self, $cb, $eol) = @_;
865 958
866 $eol = qr|(\015?\012)| if @_ < 3; 959 if (@_ < 3) {
960 # this is more than twice as fast as the generic code below
961 sub {
962 $_[0]{rbuf} =~ s/^([^\015\012]*)(\015?\012)// or return;
963
964 $cb->($_[0], $1, $2);
965 1
966 }
967 } else {
867 $eol = quotemeta $eol unless ref $eol; 968 $eol = quotemeta $eol unless ref $eol;
868 $eol = qr|^(.*?)($eol)|s; 969 $eol = qr|^(.*?)($eol)|s;
869 970
870 sub { 971 sub {
871 $_[0]{rbuf} =~ s/$eol// or return; 972 $_[0]{rbuf} =~ s/$eol// or return;
872 973
873 $cb->($_[0], $1, $2); 974 $cb->($_[0], $1, $2);
975 1
874 1 976 }
875 } 977 }
876}; 978};
877
878# compatibility with older API
879sub push_read_line {
880 my $self = shift;
881 $self->push_read (line => @_);
882}
883
884sub unshift_read_line {
885 my $self = shift;
886 $self->unshift_read (line => @_);
887}
888 979
889=item regex => $accept[, $reject[, $skip], $cb->($handle, $data) 980=item regex => $accept[, $reject[, $skip], $cb->($handle, $data)
890 981
891Makes a regex match against the regex object C<$accept> and returns 982Makes a regex match against the regex object C<$accept> and returns
892everything up to and including the match. 983everything up to and including the match.
1013register_read_type packstring => sub { 1104register_read_type packstring => sub {
1014 my ($self, $cb, $format) = @_; 1105 my ($self, $cb, $format) = @_;
1015 1106
1016 sub { 1107 sub {
1017 # when we can use 5.10 we can use ".", but for 5.8 we use the re-pack method 1108 # when we can use 5.10 we can use ".", but for 5.8 we use the re-pack method
1018 defined (my $len = eval { unpack $format, $_[0]->{rbuf} }) 1109 defined (my $len = eval { unpack $format, $_[0]{rbuf} })
1019 or return; 1110 or return;
1020 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 {
1021 # remove prefix 1120 # remove prefix
1022 substr $_[0]->{rbuf}, 0, (length pack $format, $len), ""; 1121 substr $_[0]{rbuf}, 0, $format, "";
1023 1122
1024 # read rest 1123 # read remaining chunk
1025 $_[0]->unshift_read (chunk => $len, $cb); 1124 $_[0]->unshift_read (chunk => $len, $cb);
1125 }
1026 1126
1027 1 1127 1
1028 } 1128 }
1029}; 1129};
1030 1130
1045the C<json> write type description, above, for an actual example. 1145the C<json> write type description, above, for an actual example.
1046 1146
1047=cut 1147=cut
1048 1148
1049register_read_type json => sub { 1149register_read_type json => sub {
1050 my ($self, $cb, $accept, $reject, $skip) = @_; 1150 my ($self, $cb) = @_;
1051 1151
1052 require JSON; 1152 require JSON;
1053 1153
1054 my $data; 1154 my $data;
1055 my $rbuf = \$self->{rbuf}; 1155 my $rbuf = \$self->{rbuf};
1067 1 1167 1
1068 } else { 1168 } else {
1069 $self->{rbuf} = ""; 1169 $self->{rbuf} = "";
1070 () 1170 ()
1071 } 1171 }
1172 }
1173};
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
1072 } 1217 }
1073}; 1218};
1074 1219
1075=back 1220=back
1076 1221
1337=over 4 1482=over 4
1338 1483
1339=item * all constructor arguments become object members. 1484=item * all constructor arguments become object members.
1340 1485
1341At 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
1342will 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
1343mutated 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).
1344 1489
1345=item * other object member names are prefixed with an C<_>. 1490=item * other object member names are prefixed with an C<_>.
1346 1491
1347All 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