--- AnyEvent/lib/AnyEvent/Handle.pm	2008/05/24 15:03:42	1.21
+++ AnyEvent/lib/AnyEvent/Handle.pm	2008/05/25 03:03:51	1.33
@@ -4,7 +4,7 @@
 use strict;
 
 use AnyEvent ();
-use AnyEvent::Util ();
+use AnyEvent::Util qw(WSAWOULDBLOCK);
 use Scalar::Util ();
 use Carp ();
 use Fcntl ();
@@ -12,9 +12,7 @@
 
 =head1 NAME
 
-AnyEvent::Handle - non-blocking I/O on filehandles via AnyEvent
-
-This module is experimental.
+AnyEvent::Handle - non-blocking I/O on file handles via AnyEvent
 
 =cut
 
@@ -27,22 +25,25 @@
 
    my $cv = AnyEvent->condvar;
 
-   my $ae_fh = AnyEvent::Handle->new (fh => \*STDIN);
-
-   #TODO
-
-   # or use the constructor to pass the callback:
-
-   my $ae_fh2 =
+   my $handle =
       AnyEvent::Handle->new (
          fh => \*STDIN,
          on_eof => sub {
             $cv->broadcast;
          },
-         #TODO
       );
 
-   $cv->wait;
+   # send some request line
+   $handle->push_write ("getinfo\015\012");
+
+   # read the response line
+   $handle->push_read (line => sub {
+      my ($handle, $line) = @_;
+      warn "read line <$line>\n";
+      $cv->send;
+   });
+
+   $cv->recv;
 
 =head1 DESCRIPTION
 
@@ -92,7 +93,7 @@
 called.
 
 On callback entrance, the value of C<$!> contains the operating system
-error (or C<ENOSPC> or C<EPIPE>).
+error (or C<ENOSPC>, C<EPIPE> or C<EBADMSG>).
 
 While not mandatory, it is I<highly> recommended to set this callback, as
 you will not be notified of errors otherwise. The default simply calls
@@ -147,6 +148,9 @@
 will start making tls handshake and will transparently encrypt/decrypt
 data.
 
+TLS mode requires Net::SSLeay to be installed (it will be loaded
+automatically when you try to create a TLS handle).
+
 For the TLS server side, use C<accept>, and for the TLS client side of a
 connection, use C<connect> mode.
 
@@ -155,6 +159,8 @@
 or C<Net::SSLeay::set_accept_state> on it before you pass it to
 AnyEvent::Handle.
 
+See the C<starttls> method if you need to start TLs negotiation later.
+
 =item tls_ctx => $ssl_ctx
 
 Use the given Net::SSLeay::CTX object to create the new TLS connection
@@ -208,13 +214,13 @@
    if ($self->{on_error}) {
       $self->{on_error}($self);
    } else {
-      die "AnyEvent::Handle uncaught fatal error: $!";
+      Carp::croak "AnyEvent::Handle uncaught fatal error: $!";
    }
 }
 
 =item $fh = $handle->fh
 
-This method returns the filehandle of the L<AnyEvent::Handle> object.
+This method returns the file handle of the L<AnyEvent::Handle> object.
 
 =cut
 
@@ -284,12 +290,12 @@
 sub _drain_wbuf {
    my ($self) = @_;
 
-   unless ($self->{ww}) {
+   if (!$self->{ww} && length $self->{wbuf}) {
       Scalar::Util::weaken $self;
       my $cb = sub {
          my $len = syswrite $self->{fh}, $self->{wbuf};
 
-         if ($len > 0) {
+         if ($len >= 0) {
             substr $self->{wbuf}, 0, $len, "";
 
             $self->{on_drain}($self)
@@ -297,7 +303,7 @@
                   && $self->{on_drain};
 
             delete $self->{ww} unless length $self->{wbuf};
-         } elsif ($! != EAGAIN && $! != EINTR) {
+         } elsif ($! != EAGAIN && $! != EINTR && $! != WSAWOULDBLOCK) {
             $self->error;
          }
       };
@@ -308,9 +314,22 @@
    };
 }
 
+our %WH;
+
+sub register_write_type($$) {
+   $WH{$_[0]} = $_[1];
+}
+
 sub push_write {
    my $self = shift;
 
+   if (@_ > 1) {
+      my $type = shift;
+
+      @_ = ($WH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::push_write")
+           ->($self, @_);
+   }
+
    if ($self->{filter_w}) {
       $self->{filter_w}->($self, \$_[0]);
    } else {
@@ -319,6 +338,47 @@
    }
 }
 
+=item $handle->push_write (type => @args)
+
+=item $handle->unshift_write (type => @args)
+
+Instead of formatting your data yourself, you can also let this module do
+the job by specifying a type and type-specific arguments.
+
+Predefined types are (if you have ideas for additional types, feel free to
+drop by and tell us):
+
+=over 4
+
+=item netstring => $string
+
+Formats the given value as netstring
+(http://cr.yp.to/proto/netstrings.txt, this is not a recommendation to use them).
+
+=back
+
+=cut
+
+register_write_type netstring => sub {
+   my ($self, $string) = @_;
+
+   sprintf "%d:%s,", (length $string), $string
+};
+
+=item AnyEvent::Handle::register_write_type type => $coderef->($self, @args)
+
+This function (not method) lets you add your own types to C<push_write>.
+Whenever the given C<type> is used, C<push_write> will invoke the code
+reference with the handle object and the remaining arguments.
+
+The code reference is supposed to return a single octet string that will
+be appended to the write buffer.
+
+Note that this is a function, and all types registered this way will be
+global, so try to use unique names.
+
+=cut
+
 #############################################################################
 
 =back
@@ -415,7 +475,7 @@
    while (my $len = length $self->{rbuf}) {
       no strict 'refs';
       if (my $cb = shift @{ $self->{queue} }) {
-         if (!$cb->($self)) {
+         unless ($cb->($self)) {
             if ($self->{eof}) {
                # no progress can be made (not enough data and no data forthcoming)
                $! = &Errno::EPIPE; return $self->error;
@@ -502,57 +562,90 @@
 
 =cut
 
+our %RH;
+
+sub register_read_type($$) {
+   $RH{$_[0]} = $_[1];
+}
+
 sub push_read {
-   my ($self, $cb) = @_;
+   my $self = shift;
+   my $cb = pop;
+
+   if (@_) {
+      my $type = shift;
+
+      $cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::push_read")
+            ->($self, $cb, @_);
+   }
 
    push @{ $self->{queue} }, $cb;
    $self->_drain_rbuf;
 }
 
 sub unshift_read {
-   my ($self, $cb) = @_;
+   my $self = shift;
+   my $cb = pop;
 
-   push @{ $self->{queue} }, $cb;
+   if (@_) {
+      my $type = shift;
+
+      $cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::unshift_read")
+            ->($self, $cb, @_);
+   }
+
+
+   unshift @{ $self->{queue} }, $cb;
    $self->_drain_rbuf;
 }
 
-=item $handle->push_read_chunk ($len, $cb->($self, $data))
+=item $handle->push_read (type => @args, $cb)
+
+=item $handle->unshift_read (type => @args, $cb)
 
-=item $handle->unshift_read_chunk ($len, $cb->($self, $data))
+Instead of providing a callback that parses the data itself you can chose
+between a number of predefined parsing formats, for chunks of data, lines
+etc.
 
-Append the given callback to the end of the queue (C<push_read_chunk>) or
-prepend it (C<unshift_read_chunk>).
+Predefined types are (if you have ideas for additional types, feel free to
+drop by and tell us):
 
-The callback will be called only once C<$len> bytes have been read, and
-these C<$len> bytes will be passed to the callback.
+=over 4
+
+=item chunk => $octets, $cb->($self, $data)
+
+Invoke the callback only once C<$octets> bytes have been read. Pass the
+data read to the callback. The callback will never be called with less
+data.
+
+Example: read 2 bytes.
+
+   $handle->push_read (chunk => 2, sub {
+      warn "yay ", unpack "H*", $_[1];
+   });
 
 =cut
 
-sub _read_chunk($$) {
-   my ($self, $len, $cb) = @_;
+register_read_type chunk => sub {
+   my ($self, $cb, $len) = @_;
 
    sub {
       $len <= length $_[0]{rbuf} or return;
       $cb->($_[0], substr $_[0]{rbuf}, 0, $len, "");
       1
    }
-}
+};
 
+# compatibility with older API
 sub push_read_chunk {
-   $_[0]->push_read (&_read_chunk);
+   $_[0]->push_read (chunk => $_[1], $_[2]);
 }
 
-
 sub unshift_read_chunk {
-   $_[0]->unshift_read (&_read_chunk);
+   $_[0]->unshift_read (chunk => $_[1], $_[2]);
 }
 
-=item $handle->push_read_line ([$eol, ]$cb->($self, $line, $eol))
-
-=item $handle->unshift_read_line ([$eol, ]$cb->($self, $line, $eol))
-
-Append the given callback to the end of the queue (C<push_read_line>) or
-prepend it (C<unshift_read_line>).
+=item line => [$eol, ]$cb->($self, $line, $eol)
 
 The callback will be called only once a full line (including the end of
 line marker, C<$eol>) has been read. This line (excluding the end of line
@@ -573,12 +666,10 @@
 
 =cut
 
-sub _read_line($$) {
-   my $self = shift;
-   my $cb = pop;
-   my $eol = @_ ? shift : qr|(\015?\012)|;
-   my $pos;
+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;
 
@@ -588,23 +679,86 @@
       $cb->($_[0], $1, $2);
       1
    }
-}
+};
 
+# compatibility with older API
 sub push_read_line {
-   $_[0]->push_read (&_read_line);
+   my $self = shift;
+   $self->push_read (line => @_);
 }
 
 sub unshift_read_line {
-   $_[0]->unshift_read (&_read_line);
+   my $self = shift;
+   $self->unshift_read (line => @_);
 }
 
+=item netstring => $cb->($string)
+
+A netstring (http://cr.yp.to/proto/netstrings.txt, this is not an endorsement).
+
+Throws an error with C<$!> set to EBADMSG on format violations.
+
+=cut
+
+register_read_type netstring => sub {
+   my ($self, $cb) = @_;
+
+   sub {
+      unless ($_[0]{rbuf} =~ s/^(0|[1-9][0-9]*)://) {
+         if ($_[0]{rbuf} =~ /[^0-9]/) {
+            $! = &Errno::EBADMSG;
+            $self->error;
+         }
+         return;
+      }
+
+      my $len = $1;
+
+      $self->unshift_read (chunk => $len, sub {
+         my $string = $_[1];
+         $_[0]->unshift_read (chunk => 1, sub {
+            if ($_[1] eq ",") {
+               $cb->($_[0], $string);
+            } else {
+               $! = &Errno::EBADMSG;
+               $self->error;
+            }
+         });
+      });
+
+      1
+   }
+};
+
+=back
+
+=item AnyEvent::Handle::register_read_type type => $coderef->($self, $cb, @args)
+
+This function (not method) lets you add your own types to C<push_read>.
+
+Whenever the given C<type> is used, C<push_read> will invoke the code
+reference with the handle object, the callback and the remaining
+arguments.
+
+The code reference is supposed to return a callback (usually a closure)
+that works as a plain read callback (see C<< ->push_read ($cb) >>).
+
+It should invoke the passed callback when it is done reading (remember to
+pass C<$self> as first argument as all other callbacks do that).
+
+Note that this is a function, and all types registered this way will be
+global, so try to use unique names.
+
+For examples, see the source of this module (F<perldoc -m AnyEvent::Handle>,
+search for C<register_read_type>)).
+
 =item $handle->stop_read
 
 =item $handle->start_read
 
 In rare cases you actually do not want to read anything from the
 socket. In this case you can call C<stop_read>. Neither C<on_read> no
-any queued callbacks will be executed then. To start readign again, call
+any queued callbacks will be executed then. To start reading again, call
 C<start_read>.
 
 =cut
@@ -635,7 +789,7 @@
             $self->{eof} = 1;
             $self->_drain_rbuf;
 
-         } elsif ($! != EAGAIN && $! != EINTR) {
+         } elsif ($! != EAGAIN && $! != EINTR && $! != &AnyEvent::Util::WSAWOULDBLOCK) {
             return $self->error;
          }
       });
@@ -646,8 +800,9 @@
    my ($self) = @_;
 
    if (length $self->{tls_wbuf}) {
-      my $len = Net::SSLeay::write ($self->{tls}, $self->{tls_wbuf});
-      substr $self->{tls_wbuf}, 0, $len, "" if $len > 0;
+      while ((my $len = Net::SSLeay::write ($self->{tls}, $self->{tls_wbuf})) > 0) {
+         substr $self->{tls_wbuf}, 0, $len, "";
+      }
    }
 
    if (defined (my $buf = Net::SSLeay::BIO_read ($self->{tls_wbio}))) {
@@ -655,13 +810,14 @@
       $self->_drain_wbuf;
    }
 
-   if (defined (my $buf = Net::SSLeay::read ($self->{tls}))) {
+   while (defined (my $buf = Net::SSLeay::read ($self->{tls}))) {
       $self->{rbuf} .= $buf;
       $self->_drain_rbuf;
-   } elsif (
-      (my $err = Net::SSLeay::get_error ($self->{tls}, -1))
-      != Net::SSLeay::ERROR_WANT_READ ()
-   ) {
+   }
+
+   my $err = Net::SSLeay::get_error ($self->{tls}, -1);
+
+   if ($err!= Net::SSLeay::ERROR_WANT_READ ()) {
       if ($err == Net::SSLeay::ERROR_SYSCALL ()) {
          $self->error;
       } elsif ($err == Net::SSLeay::ERROR_SSL ())  {
@@ -673,10 +829,26 @@
    }
 }
 
+=item $handle->starttls ($tls[, $tls_ctx])
+
+Instead of starting TLS negotiation immediately when the AnyEvent::Handle
+object is created, you can also do that at a later time by calling
+C<starttls>.
+
+The first argument is the same as the C<tls> constructor argument (either
+C<"connect">, C<"accept"> or an existing Net::SSLeay object).
+
+The second argument is the optional C<Net::SSLeay::CTX> object that is
+used when AnyEvent::Handle has to create its own TLS connection object.
+
+=cut
+
 # TODO: maybe document...
 sub starttls {
    my ($self, $ssl, $ctx) = @_;
 
+   $self->stoptls;
+
    if ($ssl eq "accept") {
       $ssl = Net::SSLeay::new ($ctx || TLS_CTX ());
       Net::SSLeay::set_accept_state ($ssl);
@@ -691,6 +863,7 @@
    # but the openssl maintainers basically said: "trust us, it just works".
    # (unfortunately, we have to hardcode constants because the abysmally misdesigned
    # and mismaintained ssleay-module doesn't even offer them).
+   # http://www.mail-archive.com/openssl-dev@openssl.org/msg22420.html
    Net::SSLeay::CTX_set_mode ($self->{tls},
       (eval { Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } || 1)
       | (eval { Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER () } || 2));
@@ -710,10 +883,28 @@
    };
 }
 
+=item $handle->stoptls
+
+Destroys the SSL connection, if any. Partial read or write data will be
+lost.
+
+=cut
+
+sub stoptls {
+   my ($self) = @_;
+
+   Net::SSLeay::free (delete $self->{tls}) if $self->{tls};
+   delete $self->{tls_rbio};
+   delete $self->{tls_wbio};
+   delete $self->{tls_wbuf};
+   delete $self->{filter_r};
+   delete $self->{filter_w};
+}
+
 sub DESTROY {
    my $self = shift;
 
-   Net::SSLeay::free (delete $self->{tls}) if $self->{tls};
+   $self->stoptls;
 }
 
 =item AnyEvent::Handle::TLS_CTX