File Coverage

blib/lib/Net/RNDC.pm

Criterion	Covered	Total	%
statement	27	74	36.4
branch	1	14	7.1
condition	1	2	50.0
subroutine	8	16	50.0
pod	4	4	100.0
total	41	110	37.2

package Net::RNDC;
{
  $Net::RNDC::VERSION = '0.003';
}
# ABSTRACT: Speak the BIND RNDC protocol

use strict;
use warnings;

use Carp qw(croak);

use Net::RNDC::Session;

my $sock;

BEGIN {
	eval 'use IO::Socket::INET6;';

	if ($@) {
		eval 'use IO::Socket::INET;';

		die $@ if $@;

		$sock = 'IO::Socket::INET';
	} else {
		$sock = 'IO::Socket::INET6';
	}
}

# Required for new()
my @required_args = qw(
);

# Optional for new()/do()
my @optional_args = qw(
	key
	host
	port
);

sub new {
	my ($class, %args) = @_;

	my %obj = $class->_parse_args(%args);

	return bless \%obj, $class;
}

sub _parse_args {
	my ($class, %args) = @_;

	for my $r (@required_args) {
		unless ($args{$r}) {
			croak("Required argument '$r' is missing");
		}
	}

	$args{port} ||= 953;

	return map {
		$_ => $args{$_}
	} grep { $args{$_} } (@required_args, @optional_args);
}

sub _check_do_args {
	my ($self, %args) = @_;

	for my $r (qw(key host)) {
		unless ($args{$r}) {
			croak("Required argument '$r' is missing");
		}
	}
}

sub do {
	my ($self, $command, %override) = @_;

	$self->{response} = $self->{error} = '';

	my $host = $self->{host};
	my $port = $self->{port};
	my $key  = $self->{key};

	if (%override) {
		my %args = $self->_parse_args(
			host => $host,
			port => $port,
			key => $key,
			%override,
		);

		$host = $args{host};
		$port = $args{port};
		$key  = $args{key};
	}

	$self->_check_do_args(
		host => $host,
		port => $port,
		key  => $key,
	);

	my $c = $sock->new(
		PeerAddr => "$host:$port",
	);

	unless ($c) {
		$self->{error} = "Failed to create a socket: $@ ($!)";

		return 0;
	}

	# Net::RNDC::Session does all of the work
	my $sess = Net::RNDC::Session->new(
		key         => $key,
		command     => $command,
		is_client   => 1,

		want_write => sub {
			my $s = shift;

			$c->send(shift);

			$s->next;
		},

		want_read => sub {
			my $s = shift;

			my $buff;

			$c->recv($buff, 4096);

			$s->next($buff);
		},

		want_finish => sub {
			my $s = shift;
			my $res = shift;

			$self->{response} = $res;
		},

		want_error => sub {
			my $s = shift;
			my $err = shift;

			$self->{error} = $err;
		}
	);

	# Work!
	$sess->start;

	$c->close;

	if ($self->response) {
		return 1;
	} else {
		return 0;
	}
}

sub response {
	my ($self) = @_;

	return $self->{response};
}

sub error {
	my ($self) = @_;

	return $self->{error};
}

1;
__END__;