view release on metacpan or  search on metacpan

lib/Net/DNS/Async.pm  view on Meta::CPAN

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();