--- AnyEvent/lib/AnyEvent/DNS.pm	2008/05/29 22:34:51	1.49
+++ AnyEvent/lib/AnyEvent/DNS.pm	2008/05/30 09:40:41	1.53
@@ -392,7 +392,7 @@
 
 =item $pkt = AnyEvent::DNS::dns_pack $dns
 
-Packs a perl data structure into a DNS packet. Reading RFC1034 is strongly
+Packs a perl data structure into a DNS packet. Reading RFC 1035 is strongly
 recommended, then everything will be totally clear. Or maybe not.
 
 Resource records are not yet encodable.
@@ -883,6 +883,34 @@
    }
 }
 
+=item $resolver->timeout ($timeout, ...)
+
+Sets the timeout values. See the C<timeout> constructor argument (and note
+that this method uses the values itselt, not an array-reference).
+
+=cut
+
+sub timeout {
+   my ($self, @timeout) = @_;
+
+   $self->{timeout} = \@timeout;
+   $self->_compile;
+}
+
+=item $resolver->max_outstanding ($nrequests)
+
+Sets the maximum number of outstanding requests to C<$nrequests>. See the
+C<max_outstanding> constructor argument.
+
+=cut
+
+sub max_outstanding {
+   my ($self, $max) = @_;
+
+   $self->{max_outstanding} = $max;
+   $self->_scheduler;
+}
+
 sub _compile {
    my $self = shift;
 
@@ -976,12 +1004,17 @@
          if ($res->{tc}) {
             # success, but truncated, so use tcp
             AnyEvent::Socket::tcp_connect (AnyEvent::Socket::format_address ($server), DOMAIN_PORT, sub {
+               return unless $do_retry; # some other request could have invalidated us already
+
                my ($fh) = @_
                   or return &$do_retry;
 
-               my $handle = new AnyEvent::Handle
+               my $handle; $handle = new AnyEvent::Handle
                   fh       => $fh,
+                  timeout  => $timeout,
                   on_error => sub {
+                     undef $handle;
+                     return unless $do_retry; # some other request could have invalidated us already
                      # failure, try next
                      &$do_retry;
                   };
@@ -989,10 +1022,10 @@
                $handle->push_write (pack "n/a", $req->[0]);
                $handle->push_read (chunk => 2, sub {
                   $handle->unshift_read (chunk => (unpack "n", $_[1]), sub {
+                     undef $handle;
                      $self->_feed ($_[1]);
                   });
                });
-               shutdown $fh, 1;
 
             }, sub { $timeout });
 
@@ -1018,6 +1051,8 @@
 sub _scheduler {
    my ($self) = @_;
 
+   no strict 'refs';
+
    $NOW = time;
 
    # first clear id reuse queue
@@ -1035,19 +1070,27 @@
          last;
       }
 
-      my $req = shift @{ $self->{queue} }
-         or last;
-
-      while () {
-         $req->[2] = int rand 65536;
-         last unless exists $self->{id}{$req->[2]};
-      }
+      if (my $req = shift @{ $self->{queue} }) {
+         # found a request in the queue, execute it
+         while () {
+            $req->[2] = int rand 65536;
+            last unless exists $self->{id}{$req->[2]};
+         }
 
-      ++$self->{outstanding};
-      $self->{id}{$req->[2]} = 1;
-      substr $req->[0], 0, 2, pack "n", $req->[2];
+         ++$self->{outstanding};
+         $self->{id}{$req->[2]} = 1;
+         substr $req->[0], 0, 2, pack "n", $req->[2];
+
+         $self->_exec ($req);
+
+      } elsif (my $cb = shift @{ $self->{wait} }) {
+         # found a wait_for_slot callback, call that one first
+         $cb->($self);
 
-      $self->_exec ($req);
+      } else {
+         # nothing to do, just exit
+         last;
+      }
    }
 }
 
@@ -1073,7 +1116,7 @@
 
 A C<$qtype> is either a numerical query type (e.g. C<1> for A recods) or
 a lowercase name (you have to look at the source to see which aliases are
-supported, but all types from RFC 1034, C<aaaa>, C<srv>, C<spf> and a few
+supported, but all types from RFC 1035, C<aaaa>, C<srv>, C<spf> and a few
 more are known to this module). A qtype of "*" is supported and means
 "any" record type.
 
@@ -1091,7 +1134,7 @@
 be the textual IPv4 addresses, for C<ns> or C<cname> records this will be
 a domain name, for C<txt> records these are all the strings and so on.
 
-All types mentioned in RFC 1034, C<aaaa>, C<srv> and C<spf> are
+All types mentioned in RFC 1035, C<aaaa>, C<srv> and C<spf> are
 decoded. All resource records not known to this module will just return
 the raw C<rdata> field as fourth entry.
 
@@ -1244,6 +1287,37 @@
    $do_search->();
 }
 
+=item $resolver->wait_for_slot ($cb->($resolver))
+
+Wait until a free request slot is available and call the callback with the
+resolver object.
+
+A request slot is used each time a request is actually sent to the
+nameservers: There are never more than C<max_outstanding> of them.
+
+Although you can submit more requests (they will simply be queued until
+a request slot becomes available), sometimes, usually for rate-limiting
+purposes, it is useful to instead wait for a slot before generating the
+request (or simply to know when the request load is low enough so one can
+submit requests again).
+
+This is what this method does: The callback will be called when submitting
+a DNS request will not result in that request being queued. The callback
+may or may not generate any requests in response.
+
+Note that the callback will only be invoked when the request queue is
+empty, so this does not play well if somebody else keeps the request queue
+full at all times.
+
+=cut
+
+sub wait_for_slot {
+   my ($self, $cb) = @_;
+
+   push @{ $self->{wait} }, $cb;
+   $self->_scheduler;
+}
+
 use AnyEvent::Socket (); # circular dependency, so do not import anything and do it at the end
 
 1;