--- AnyEvent/lib/AnyEvent/Handle.pm 2008/07/16 21:17:59 1.72 +++ AnyEvent/lib/AnyEvent/Handle.pm 2008/08/21 19:13:05 1.84 @@ -1,7 +1,7 @@ package AnyEvent::Handle; no warnings; -use strict; +use strict qw(subs vars); use AnyEvent (); use AnyEvent::Util qw(WSAEWOULDBLOCK); @@ -16,7 +16,7 @@ =cut -our $VERSION = 4.21; +our $VERSION = 4.232; =head1 SYNOPSIS @@ -51,6 +51,9 @@ filehandles. For utility functions for doing non-blocking connects and accepts on sockets see L. +The L tutorial contains some well-documented +AnyEvent::Handle examples. + In the following, when the documentation refers to of "bytes" then this means characters. As sysread and syswrite are used for all I/O, their treatment of characters applies to this module as well. @@ -72,19 +75,28 @@ The filehandle this L object will operate on. -NOTE: The filehandle will be set to non-blocking (using -AnyEvent::Util::fh_nonblocking). +NOTE: The filehandle will be set to non-blocking mode (using +C) by the constructor and needs to stay in +that mode. =item on_eof => $cb->($handle) -Set the callback to be called when an end-of-file condition is detcted, +Set the callback to be called when an end-of-file condition is detected, i.e. in the case of a socket, when the other side has closed the connection cleanly. -While not mandatory, it is highly recommended to set an eof callback, +For sockets, this just means that the other side has stopped sending data, +you can still try to write data, and, in fact, one can return from the eof +callback and continue writing data, as only the read part has been shut +down. + +While not mandatory, it is I recommended to set an eof callback, otherwise you might end up with a closed socket while you are still waiting for data. +If an EOF condition has been detected but no C callback has been +set, then a fatal error will be raised with C<$!> set to <0>. + =item on_error => $cb->($handle, $fatal) This is the error callback, which is called when, well, some error @@ -92,10 +104,15 @@ connect or a read error. Some errors are fatal (which is indicated by C<$fatal> being true). On -fatal errors the handle object will be shut down and will not be -usable. Non-fatal errors can be retried by simply returning, but it is -recommended to simply ignore this parameter and instead abondon the handle -object when this callback is invoked. +fatal errors the handle object will be shut down and will not be usable +(but you are free to look at the current C< ->rbuf >). Examples of fatal +errors are an EOF condition with active (but unsatisifable) read watchers +(C) or I/O errors. + +Non-fatal errors can be retried by simply returning, but it is recommended +to simply ignore this parameter and instead abondon the handle object +when this callback is invoked. Examples of non-fatal errors are timeouts +C) or badly-formatted data (C). On callback entrance, the value of C<$!> contains the operating system error (or C, C, C or C). @@ -227,7 +244,7 @@ or C on it before you pass it to AnyEvent::Handle. -See the C method if you need to start TLs negotiation later. +See the C method if you need to start TLS negotiation later. =item tls_ctx => $ssl_ctx @@ -290,6 +307,9 @@ delete $self->{fh}; $self->stoptls; + + delete $self->{on_read}; + delete $self->{_queue}; } sub _error { @@ -728,19 +748,17 @@ defined $self->{rbuf_max} && $self->{rbuf_max} < length $self->{rbuf} ) { - return $self->_error (&Errno::ENOSPC, 1); + $self->_error (&Errno::ENOSPC, 1), return; } while () { - no strict 'refs'; - my $len = length $self->{rbuf}; if (my $cb = shift @{ $self->{_queue} }) { unless ($cb->($self)) { if ($self->{_eof}) { # no progress can be made (not enough data and no data forthcoming) - $self->_error (&Errno::EPIPE, 1), last; + $self->_error (&Errno::EPIPE, 1), return; } unshift @{ $self->{_queue} }, $cb; @@ -758,7 +776,7 @@ ) { # no further data will arrive # so no progress can be made - $self->_error (&Errno::EPIPE, 1), last + $self->_error (&Errno::EPIPE, 1), return if $self->{_eof}; last; # more data might arrive @@ -770,8 +788,13 @@ } } - $self->{on_eof}($self) - if $self->{_eof} && $self->{on_eof}; + if ($self->{_eof}) { + if ($self->{on_eof}) { + $self->{on_eof}($self) + } else { + $self->_error (0, 1); + } + } # may need to restart read watcher unless ($self->{_rw}) { @@ -907,15 +930,6 @@ } }; -# compatibility with older API -sub push_read_chunk { - $_[0]->push_read (chunk => $_[1], $_[2]); -} - -sub unshift_read_chunk { - $_[0]->unshift_read (chunk => $_[1], $_[2]); -} - =item line => [$eol, ]$cb->($handle, $line, $eol) The callback will be called only once a full line (including the end of @@ -940,29 +954,27 @@ register_read_type line => sub { my ($self, $cb, $eol) = @_; - $eol = qr|(\015?\012)| if @_ < 3; - $eol = quotemeta $eol unless ref $eol; - $eol = qr|^(.*?)($eol)|s; + if (@_ < 3) { + # this is more than twice as fast as the generic code below + sub { + $_[0]{rbuf} =~ s/^([^\015\012]*)(\015?\012)// or return; - sub { - $_[0]{rbuf} =~ s/$eol// or return; + $cb->($_[0], $1, $2); + 1 + } + } else { + $eol = quotemeta $eol unless ref $eol; + $eol = qr|^(.*?)($eol)|s; - $cb->($_[0], $1, $2); - 1 + sub { + $_[0]{rbuf} =~ s/$eol// or return; + + $cb->($_[0], $1, $2); + 1 + } } }; -# compatibility with older API -sub push_read_line { - my $self = shift; - $self->push_read (line => @_); -} - -sub unshift_read_line { - my $self = shift; - $self->unshift_read (line => @_); -} - =item regex => $accept[, $reject[, $skip], $cb->($handle, $data) Makes a regex match against the regex object C<$accept> and returns @@ -1092,14 +1104,23 @@ sub { # when we can use 5.10 we can use ".", but for 5.8 we use the re-pack method - defined (my $len = eval { unpack $format, $_[0]->{rbuf} }) + defined (my $len = eval { unpack $format, $_[0]{rbuf} }) or return; - # remove prefix - substr $_[0]->{rbuf}, 0, (length pack $format, $len), ""; + $format = length pack $format, $len; - # read rest - $_[0]->unshift_read (chunk => $len, $cb); + # bypass unshift if we already have the remaining chunk + if ($format + $len <= length $_[0]{rbuf}) { + my $data = substr $_[0]{rbuf}, $format, $len; + substr $_[0]{rbuf}, 0, $format + $len, ""; + $cb->($_[0], $data); + } else { + # remove prefix + substr $_[0]{rbuf}, 0, $format, ""; + + # read remaining chunk + $_[0]->unshift_read (chunk => $len, $cb); + } 1 } @@ -1166,20 +1187,31 @@ sub { # when we can use 5.10 we can use ".", but for 5.8 we use the re-pack method - defined (my $len = eval { unpack "w", $_[0]->{rbuf} }) + defined (my $len = eval { unpack "w", $_[0]{rbuf} }) or return; - # remove prefix - substr $_[0]->{rbuf}, 0, (length pack "w", $len), ""; + my $format = length pack "w", $len; - # read rest - $_[0]->unshift_read (chunk => $len, sub { - if (my $ref = eval { Storable::thaw ($_[1]) }) { - $cb->($_[0], $ref); - } else { - $self->_error (&Errno::EBADMSG); - } - }); + # bypass unshift if we already have the remaining chunk + if ($format + $len <= length $_[0]{rbuf}) { + my $data = substr $_[0]{rbuf}, $format, $len; + substr $_[0]{rbuf}, 0, $format + $len, ""; + $cb->($_[0], Storable::thaw ($data)); + } else { + # remove prefix + substr $_[0]{rbuf}, 0, $format, ""; + + # read remaining chunk + $_[0]->unshift_read (chunk => $len, sub { + if (my $ref = eval { Storable::thaw ($_[1]) }) { + $cb->($_[0], $ref); + } else { + $self->_error (&Errno::EBADMSG); + } + }); + } + + 1 } }; @@ -1450,7 +1482,7 @@ =item * all constructor arguments become object members. At least initially, when you pass a C-argument to the constructor it -will end up in C<< $handle->{tls} >>. Those members might be changes or +will end up in C<< $handle->{tls} >>. Those members might be changed or mutated later on (for example C will hold the TLS connection object). =item * other object member names are prefixed with an C<_>.