| … | |
… | |
| 1016 | } |
1016 | } |
| 1017 | |
1017 | |
| 1018 | sub _scheduler { |
1018 | sub _scheduler { |
| 1019 | my ($self) = @_; |
1019 | my ($self) = @_; |
| 1020 | |
1020 | |
|
|
1021 | no strict 'refs'; |
|
|
1022 | |
| 1021 | $NOW = time; |
1023 | $NOW = time; |
| 1022 | |
1024 | |
| 1023 | # first clear id reuse queue |
1025 | # first clear id reuse queue |
| 1024 | delete $self->{id}{ (shift @{ $self->{reuse_q} })->[1] } |
1026 | delete $self->{id}{ (shift @{ $self->{reuse_q} })->[1] } |
| 1025 | while @{ $self->{reuse_q} } && $self->{reuse_q}[0][0] <= $NOW; |
1027 | while @{ $self->{reuse_q} } && $self->{reuse_q}[0][0] <= $NOW; |
| … | |
… | |
| 1033 | $self->_scheduler; |
1035 | $self->_scheduler; |
| 1034 | }); |
1036 | }); |
| 1035 | last; |
1037 | last; |
| 1036 | } |
1038 | } |
| 1037 | |
1039 | |
| 1038 | my $req = shift @{ $self->{queue} } |
1040 | if (my $req = shift @{ $self->{queue} }) { |
| 1039 | or last; |
1041 | # found a request in the queue, execute it |
| 1040 | |
|
|
| 1041 | while () { |
1042 | while () { |
| 1042 | $req->[2] = int rand 65536; |
1043 | $req->[2] = int rand 65536; |
| 1043 | last unless exists $self->{id}{$req->[2]}; |
1044 | last unless exists $self->{id}{$req->[2]}; |
|
|
1045 | } |
|
|
1046 | |
|
|
1047 | ++$self->{outstanding}; |
|
|
1048 | $self->{id}{$req->[2]} = 1; |
|
|
1049 | substr $req->[0], 0, 2, pack "n", $req->[2]; |
|
|
1050 | |
|
|
1051 | $self->_exec ($req); |
|
|
1052 | |
|
|
1053 | } elsif (my $cb = shift @{ $self->{wait} }) { |
|
|
1054 | # found a wait_for_slot callback, call that one first |
|
|
1055 | $cb->($self); |
|
|
1056 | |
|
|
1057 | } else { |
|
|
1058 | # nothing to do, just exit |
|
|
1059 | last; |
| 1044 | } |
1060 | } |
| 1045 | |
|
|
| 1046 | ++$self->{outstanding}; |
|
|
| 1047 | $self->{id}{$req->[2]} = 1; |
|
|
| 1048 | substr $req->[0], 0, 2, pack "n", $req->[2]; |
|
|
| 1049 | |
|
|
| 1050 | $self->_exec ($req); |
|
|
| 1051 | } |
1061 | } |
| 1052 | } |
1062 | } |
| 1053 | |
1063 | |
| 1054 | =item $resolver->request ($req, $cb->($res)) |
1064 | =item $resolver->request ($req, $cb->($res)) |
| 1055 | |
1065 | |
| … | |
… | |
| 1242 | }; |
1252 | }; |
| 1243 | |
1253 | |
| 1244 | $do_search->(); |
1254 | $do_search->(); |
| 1245 | } |
1255 | } |
| 1246 | |
1256 | |
|
|
1257 | =item $resolver->wait_for_slot ($cb->($resolver)) |
|
|
1258 | |
|
|
1259 | Wait until a free request slot is available and call the callback with the |
|
|
1260 | resolver object. |
|
|
1261 | |
|
|
1262 | A request slot is used each time a request is actually sent to the |
|
|
1263 | nameservers: There are never more than C<max_outstanding> of them. |
|
|
1264 | |
|
|
1265 | Although you can submit more requests (they will simply be queued until |
|
|
1266 | a request slot becomes available), sometimes, usually for rate-limiting |
|
|
1267 | purposes, it is useful to instead wait for a slot before generating the |
|
|
1268 | request (or simply to know when the request load is low enough so one can |
|
|
1269 | submit requests again). |
|
|
1270 | |
|
|
1271 | This is what this method does: The callback will be called when submitting |
|
|
1272 | a DNS request will not result in that request being queued. The callback |
|
|
1273 | may or may not generate any requests in response. |
|
|
1274 | |
|
|
1275 | Note that the callback will only be invoked when the request queue is |
|
|
1276 | empty, so this does not play well if somebody else keeps the request queue |
|
|
1277 | full at all times. |
|
|
1278 | |
|
|
1279 | =cut |
|
|
1280 | |
|
|
1281 | sub wait_for_slot { |
|
|
1282 | my ($self, $cb) = @_; |
|
|
1283 | |
|
|
1284 | push @{ $self->{wait} }, $cb; |
|
|
1285 | $self->_scheduler; |
|
|
1286 | } |
|
|
1287 | |
| 1247 | use AnyEvent::Socket (); # circular dependency, so do not import anything and do it at the end |
1288 | use AnyEvent::Socket (); # circular dependency, so do not import anything and do it at the end |
| 1248 | |
1289 | |
| 1249 | 1; |
1290 | 1; |
| 1250 | |
1291 | |
| 1251 | =back |
1292 | =back |
