File Coverage

blib/lib/Net/DNS/Method/Constant.pm

Criterion	Covered	Total	%
statement	49	50	98.0
branch	10	14	71.4
condition	7	14	50.0
subroutine	11	11	100.0
pod	0	2	0.0
total	77	91	84.6

package Net::DNS::Method::Constant;

use strict;
use warnings;
use Net::DNS;
use Net::DNS::Method;
use vars qw($VERSION @ISA $AUTOLOAD);

@ISA = qw(Net::DNS::Method);

$VERSION = '2.00';

sub new {
    my $type	= shift;
    my $class	= ref($type) || $type || "Net::DNS::Method::Constant";

    my $self =
    {
	zone	=> lc shift,
	class	=> uc shift,
	type	=> uc shift,
	rr	=> shift
    };

    $self->{zone} =~ s/\.+$//;

    bless $self, $class;
}

sub _match {
    my $q = lc shift;
    my $d = shift;

    $q =~ s/\.+$//;

    my $pos	= index($q, $d);

    return 1 if $q eq $d;
    return 1 if $pos == 0 and (length($q) <= length($d));
    return 1 if substr($q, $pos - 1, 1) eq '.';
    return 0;
}

sub ANY {
    my $self	= shift;
    my $q	= shift;
    my $ans	= shift;

    if ($q->qclass eq $self->{class}
	and ($q->qtype eq $self->{type}
	     or $q->qtype eq 'ANY')
	and _match($q->qname, $self->{zone}))
    {
	my $rr = new Net::DNS::RR $q->qname . ' ' .$self->{rr};
	if ($rr) {
	    $ans->push('answer', $rr);
	    $ans->header->rcode('NOERROR');
	    $ans->header->aa(1);
	    return NS_OK | NS_STOP;
	}

	warn "Net::DNS::Method::Constant failed to produce an RR to answer ",
	$q->qname, "\n";

    }
    return NS_FAIL;
}

sub AUTOLOAD {
    no strict 'refs';
    my $sub = $AUTOLOAD;
    $sub =~ s/.*:://;

				# Insure that the called method has an all
				# uppercase name. This avoids any clash with
				# future extensions for these handlers, which
				# will use mixed case or lowercase.

    return NS_FAIL unless $sub eq uc $sub;
    return undef if $sub eq 'DESTROY';

    *$sub = sub { ANY @_; };
    goto &$sub;
}

1;
__END__