Net-DNS-Async-1.07/0000755000175100001440000000000011071504543013071 5ustar shevekusersNet-DNS-Async-1.07/lib/0000755000175100001440000000000011071504543013637 5ustar shevekusersNet-DNS-Async-1.07/lib/Net/0000755000175100001440000000000011071504543014365 5ustar shevekusersNet-DNS-Async-1.07/lib/Net/DNS/0000755000175100001440000000000011071504543015011 5ustar shevekusersNet-DNS-Async-1.07/lib/Net/DNS/Async.pm0000644000175100001440000001573011071504526016433 0ustar shevekuserspackage Net::DNS::Async; use strict; use warnings; use vars qw($VERSION $_LEVEL); use constant { NDS_CALLBACKS => 0, NDS_RESOLVER => 1, NDS_FQUERY => 2, NDS_RETRIES => 3, NDS_SENDTIME => 4, NDS_SOCKET => 5, }; use Net::DNS::Resolver; use IO::Select; use Time::HiRes; use Storable qw(freeze thaw); $VERSION = '1.07'; $_LEVEL = 0; sub new { my $class = shift; my $self = ($#_ == 0) ? { %{ (shift) } } : { @_ }; $self->{Pending} = [ ]; $self->{Queue} = { }; $self->{QueueSize} = 20 unless $self->{QueueSize}; $self->{Timeout} = 4 unless $self->{Timeout}; $self->{Resolver} = new Net::DNS::Resolver(); $self->{Selector} = new IO::Select(); $self->{Retries} = 3 unless $self->{Retries}; return bless $self, $class; } sub add { my ($self, $params, @query) = @_; my ($callback, @ns); if (ref($params) eq 'HASH') { @query = @{ $params->{Query} } if exists $params->{Query}; $callback = $params->{Callback}; @ns = @{ $params->{Nameservers} } if exists $params->{Nameservers}; } else { $callback = $params; } unless (ref($callback) eq 'CODE') { die "add() requires a CODE reference for a callback"; } unless (@query) { die "add() requires a DNS query"; } my $frozen = freeze(\@query); unless (@ns) { # It's a regular boring query, we can fold it. # I wouldn't like to do this in a multi-threaded environment. for my $data (values %{ $self->{Queue} }) { if ($frozen eq $data->[NDS_FQUERY]) { # Allow the use of slot 0 for custom hacks. unless ($data->[NDS_RESOLVER]) { push(@{ $data->[NDS_CALLBACKS] }, $callback); return; } } } } # if ($_LEVEL) { add to Pending } else { recv/send } $self->recv(0); # Perform fast case unconditionally. # print "Queue size " . scalar(keys %{ $self->{Queue} }); while (scalar(keys %{ $self->{Queue} }) > $self->{QueueSize}) { # I'm fairly sure this can't busy wait since it must # either time out an entry or receive an entry when called # with no arguments. $self->recv(); } # [ [ $callback ], $frozen, 0, undef, undef ]; my $data = [ ]; $data->[NDS_CALLBACKS] = [ $callback ]; $data->[NDS_RESOLVER] = new Net::DNS::Resolver( nameservers => \@ns ) if @ns; $data->[NDS_FQUERY] = $frozen; $data->[NDS_RETRIES] = 0; $self->send($data); } sub cleanup { my ($self, $data) = @_; my $socket = $data->[NDS_SOCKET]; if ($socket) { $self->{Selector}->remove($socket); delete $self->{Queue}->{$socket->fileno}; $socket->close(); } } sub send { my ($self, $data) = @_; my @query = @{ thaw($data->[NDS_FQUERY]) }; my $resolver = $data->[NDS_RESOLVER] || $self->{Resolver}; my $socket = $resolver->bgsend(@query); unless ($socket) { die "No socket returned from bgsend()"; } unless ($socket->fileno) { die "Socket returned from bgsend() has no fileno"; } $data->[NDS_SENDTIME] = time(); $data->[NDS_SOCKET] = $socket; $self->{Queue}->{$socket->fileno} = $data; $self->{Selector}->add($socket); } sub recv { my $self = shift; my $time = shift; unless (defined $time) { $time = time(); # Find first timer. for (values %{ $self->{Queue} }) { $time = $_->[NDS_SENDTIME] if $_->[NDS_SENDTIME] < $time; } # Add timeout, and compute delay until then. $time = $time + $self->{Timeout} - time(); # It could have been a while ago. $time = 0 if $time < 0; } my @sockets = $self->{Selector}->can_read($time); for my $socket (@sockets) { # If we recursed from the user callback into add(), then # we might have read from and closed this socket. # XXX A neater solution would be to collect all the # callbacks and perform them after this loop has exited. next unless $socket->fileno; $self->{Selector}->remove($socket); my $data = delete $self->{Queue}->{$socket->fileno}; unless ($data) { die "No data for socket " . $socket->fileno; } my $response = $self->{Resolver}->bgread($socket); $socket->close(); eval { local $_LEVEL = 1; $_->($response) for @{ $data->[NDS_CALLBACKS] }; }; if ($@) { die "Async died within " . __PACKAGE__ . ": $@"; } } $time = time(); for my $data (values %{ $self->{Queue} }) { if ($data->[NDS_SENDTIME] + $self->{Timeout} < $time) { # It timed out. $self->cleanup($data); if ($self->{Retries} < ++$data->[NDS_RETRIES]) { local $_LEVEL = 1; $_->(undef) for @{ $data->[NDS_CALLBACKS] }; } else { $self->send($data); } } } } sub await { my $self = shift; # If we have Pending, we need a better algorithm here. $self->recv while keys %{ $self->{Queue} }; } *done = \&await; =head1 NAME Net::DNS::Async - Asynchronous DNS helper for high volume applications =head1 SYNOPSIS use Net::DNS::Async; my $c = new Net::DNS::Async(QueueSize => 20, Retries => 3); for (...) { $c->add(\&callback, @query); } $c->await(); sub callback { my $response = shift; ... } =head1 DESCRIPTION Net::DNS::Async is a fire-and-forget asynchronous DNS helper. That is, the user application adds DNS questions to the helper, and the callback will be called at some point in the future without further intervention from the user application. The application need not handle selects, timeouts, waiting for a response or any other such issues. If the same query is added to the queue more than once, the module may combine the queries; that is, it will perform the query only once, and will call each callback registered for that query in turn, passing the same Net::DNS::Response object to each query. For this reason, you should not modify the Net::DNS::Response object in any way lest you break things horribly for a subsequent callback. This module is similar in principle to POE::Component::Client::DNS, but does not require POE. =head1 CONSTRUCTOR The class method new(...) constructs a new helper object. All arguments are optional. The following parameters are recognised as arguments to new(): =over 4 =item QueueSize The size of the query queue. If this is exceeded, further calls to add() will block until some responses are received or time out. =item Retries The number of times to retry a query before giving up. =item Timeout The timeout for an individual query. =back =head1 METHODS =over 4 =item $c->add($callback, @query) Adds a new query for asynchronous handling. The @query arguments are those to Net::DNS::Resolver->bgsend(), q.v. This call will block if the queue is full. When some pending responses are received or timeout events occur, the call will unblock. The user callback will be called at some point in the future, with a Net::DNS::Packet object representing the response. If the query timed out after the specified number of retries, the callback will be called with undef. =item $c->await() Flushes the queue, that is, waits for and handles all remaining responses. =back =head1 BUGS The test suite does not test query timeouts. =head1 SEE ALSO L, L =head1 COPYRIGHT Copyright (c) 2005-2006 Shevek. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; Net-DNS-Async-1.07/META.yml0000644000175100001440000000071211071504543014342 0ustar shevekusers# http://module-build.sourceforge.net/META-spec.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: Net-DNS-Async version: 1.07 version_from: lib/Net/DNS/Async.pm installdirs: site requires: IO::Select: 0 Net::DNS: 0 Storable: 0 Test::More: 0 distribution_type: module generated_by: ExtUtils::MakeMaker version 6.17 Net-DNS-Async-1.07/t/0000755000175100001440000000000011071504543013334 5ustar shevekusersNet-DNS-Async-1.07/t/02_resolve.t0000644000175100001440000000125610605210542015500 0ustar shevekusersuse strict; use warnings; use blib; use Data::Dumper; use Test::More tests => 300; use Net::DNS::Async; my $c = new Net::DNS::Async(); for my $i (1..20) { for my $s (qw(google demon yahoo microsoft)) { $c->add(sub { cb($s, $i, @_) }, "www.$s.com", 'A'); } $c->add(sub { cb('__nxd__', $i, @_) }, "nx$i.__nxd__.com", 'A'); } $c->done(); sub cb { my ($s, $i, $res) = @_; ok(defined $res, "Received $s $i"); my @q = $res->question; my @a = $res->answer; like($q[0]->qname, qr/\.com$/, "Question was a .com"); if ($q[0]->qname =~ /__nxd__/) { is($res->header->rcode, "NXDOMAIN", "Got an nxdomain"); } else { like($a[0]->string, qr/\bIN\b/, "Got an INET response"); } } Net-DNS-Async-1.07/t/01_use.t0000644000175100001440000000013410605210542014606 0ustar shevekusersuse strict; use warnings; use blib; use Test::More tests => 1; use_ok('Net::DNS::Async'); Net-DNS-Async-1.07/MANIFEST0000644000175100001440000000023710605210542014217 0ustar shevekuserslib/Net/DNS/Async.pm Makefile.PL MANIFEST This list of files MANIFEST.SKIP META.yml Module meta-data (added by MakeMaker) README t/01_use.t t/02_resolve.t Net-DNS-Async-1.07/MANIFEST.SKIP0000644000175100001440000000021610605210542014761 0ustar shevekusers^blib Makefile$ Makefile\.[a-z]+$ ^pm_to_blib$ CVS/.* .svn/ ,v$ ^tmp/ \.old$ \.bak$ ~$ ^# \.shar$ \.tar$ \.tgz$ \.tar\.gz$ \.zip$ _uu$ \.swp$ Net-DNS-Async-1.07/Makefile.PL0000644000175100001440000000111210605210542015031 0ustar shevekusersuse 5.006; use ExtUtils::MakeMaker; WriteMakefile( 'NAME' => 'Net::DNS::Async', 'VERSION_FROM' => 'lib/Net/DNS/Async.pm', 'PREREQ_PM' => { 'Test::More' => 0, 'Net::DNS' => 0, 'IO::Select' => 0, 'Storable' => 0, }, ABSTRACT_FROM => 'lib/Net/DNS/Async.pm', AUTHOR => 'Shevek ', ); sub MY::postamble { my $self = shift; my $old = $self->MM::postamble(@_); chomp($old); my $new = <<'EON'; .PHONY : aux readme aux : readme readme : lib/Net/DNS/Async.pm perldoc -t lib/Net/DNS/Async.pm > README EON return $old . $new; } Net-DNS-Async-1.07/README0000644000175100001440000000531110674240521013752 0ustar shevekusersNAME Net::DNS::Async - Asynchronous DNS helper for high volume applications SYNOPSIS use Net::DNS::Async; my $c = new Net::DNS::Async(QueueSize => 20, Retries => 3); for (...) { $c->add(\&callback, @query); } $c->await(); sub callback { my $response = shift; ... } DESCRIPTION Net::DNS::Async is a fire-and-forget asynchronous DNS helper. That is, the user application adds DNS questions to the helper, and the callback will be called at some point in the future without further intervention from the user application. The application need not handle selects, timeouts, waiting for a response or any other such issues. If the same query is added to the queue more than once, the module may combine the queries; that is, it will perform the query only once, and will call each callback registered for that query in turn, passing the same Net::DNS::Response object to each query. For this reason, you should not modify the Net::DNS::Response object in any way lest you break things horribly for a subsequent callback. This module is similar in principle to POE::Component::Client::DNS, but does not require POE. CONSTRUCTOR The class method new(...) constructs a new helper object. All arguments are optional. The following parameters are recognised as arguments to new(): QueueSize The size of the query queue. If this is exceeded, further calls to add() will block until some responses are received or time out. Retries The number of times to retry a query before giving up. Timeout The timeout for an individual query. METHODS $c->add($callback, @query) Adds a new query for asynchronous handling. The @query arguments are those to Net::DNS::Resolver->bgsend(), q.v. This call will block if the queue is full. When some pending responses are received or timeout events occur, the call will unblock. The user callback will be called at some point in the future, with a Net::DNS::Packet object representing the response. If the query timed out after the specified number of retries, the callback will be called with undef. $c->await() Flushes the queue, that is, waits for and handles all remaining responses. BUGS The test suite does not test query timeouts. SEE ALSO Net::DNS, POE::Component::Client::DNS COPYRIGHT Copyright (c) 2005-2006 Shevek. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.