| Net-DNS-Method documentation | Contained in the Net-DNS-Method distribution. |
Net::DNS::Method::Constant - Provides constant answers to queries
use Net::DNS::Method;
use Net::DNS::Method::Constant;
my $c = new Net::DNS::Method::Constant ('domain.com', 'IN', 'A',
'IN A 127.0.0.1');
For any question matching the domain, class and type supplied, this module responds with an authoritative answer containing the specified RR.
The response RR will be built using the partial data passed as the
fourth parameter to ->new(). The query name will be used to
build a Net::DNS::RR object, which will be put in the answer
section of the response.
$Id: Constant.pm,v 1.2 2002/10/23 04:43:58 lem Exp $
AUTOLOAD to support any RR that Net::DNS supports. Note
that only uppercase names are dynamically created, as this is assumed
to be the name of an RR.Luis E. Munoz <luismunoz@cpan.org>
perl(1), Net::DNS, Net::DNS::RR, Net::DNS::Method.
| Net-DNS-Method documentation | Contained in the Net-DNS-Method distribution. |
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__