File Coverage

blib/lib/Net/DNS/RR/AMTRELAY.pm

Criterion	Covered	Total	%
statement	94	94	100.0
branch	36	36	100.0
condition	6	6	100.0
subroutine	18	18	100.0
pod	3	5	100.0
total	157	159	100.0

package Net::DNS::RR::AMTRELAY;

use strict;
use warnings;
our $VERSION = (qw$Id: AMTRELAY.pm 1896 2023-01-30 12:59:25Z willem $)[2];

use base qw(Net::DNS::RR);


=head1 NAME

Net::DNS::RR::AMTRELAY - DNS AMTRELAY resource record

=cut

use integer;

use Carp;

use Net::DNS::DomainName;
use Net::DNS::RR::A;
use Net::DNS::RR::AAAA;


sub _decode_rdata {			## decode rdata from wire-format octet string
	my ( $self, $data, $offset ) = @_;

	my $size = $self->{rdlength} - 2;
	@{$self}{qw(precedence relaytype relay)} = unpack "\@$offset C2 a$size", $$data;

	for ( $self->relaytype ) {
		/^3$/ && return $self->{relay} = Net::DNS::DomainName->decode( $data, $offset + 2 );
		/^2$/ && return $self->{relay} = pack( 'a16', $self->{relay} );
		/^1$/ && return $self->{relay} = pack( 'a4',  $self->{relay} );
	}
	$self->{relay} = '';
	return;
}


sub _encode_rdata {			## encode rdata as wire-format octet string
	my $self = shift;

	for ( $self->relaytype ) {
		/^3$/ && return pack( 'C2 a*',	@{$self}{qw(precedence relaytype)}, $self->{relay}->encode );
		/^2$/ && return pack( 'C2 a16', @{$self}{qw(precedence relaytype relay)} );
		/^1$/ && return pack( 'C2 a4',	@{$self}{qw(precedence relaytype relay)} );
	}
	return pack( 'C2', @{$self}{qw(precedence relaytype)} );
}


sub _format_rdata {			## format rdata portion of RR string.
	my $self = shift;

	my @rdata = map { $self->$_ } qw(precedence dbit relaytype relay);
	return @rdata;
}


sub _parse_rdata {			## populate RR from rdata in argument list
	my ( $self, @argument ) = @_;

	foreach (qw(precedence dbit relaytype relay)) {
		$self->$_( shift @argument );
	}
	return;
}


sub _defaults {				## specify RR attribute default values
	my $self = shift;

	@{$self}{qw(precedence relaytype relay)} = ( 0, 0, '' );
	return;
}


sub precedence {
	my ( $self, @value ) = @_;
	for (@value) { $self->{precedence} = 0 + $_ }
	return $self->{precedence} || 0;
}


sub dbit {
	my ( $self, @value ) = @_;				# uncoverable pod
	for (@value) { $self->{relaytype} = $self->relaytype | ( $_ ? 0x80 : 0 ) }
	return ( $self->{relaytype} || 0 ) >> 7;
}

sub d { return &dbit }						# uncoverable pod


sub relaytype {
	my ( $self, @value ) = @_;
	for (@value) { $self->{relaytype} = $self->dbit ? ( 0x80 | $_ ) : $_ }
	return 0x7f & ( $self->{relaytype} || 0 );
}


sub relay {
	my ( $self, @value ) = @_;

	for (@value) {
		/^\.*$/ && do {
			$self->relaytype(0);
			$self->{relay} = '';			# no relay
			last;
		};
		/:.*:/ && do {
			$self->relaytype(2);
			$self->{relay} = Net::DNS::RR::AAAA::address( {}, $_ );
			last;
		};
		/\.\d+$/ && do {
			$self->relaytype(1);
			$self->{relay} = Net::DNS::RR::A::address( {}, $_ );
			last;
		};
		/\..+/ && do {
			$self->relaytype(3);
			$self->{relay} = Net::DNS::DomainName->new($_);
			last;
		};
		croak 'unrecognised relay type';
	}

	if ( defined wantarray ) {
		for ( $self->relaytype ) {
			/^1$/ && return Net::DNS::RR::A::address( {address => $self->{relay}} );
			/^2$/ && return Net::DNS::RR::AAAA::address( {address => $self->{relay}} );
			/^3$/ && return wantarray ? $self->{relay}->string : $self->{relay}->name;
		}
	}
	return wantarray ? '.' : undef;
}


my $function = sub {			## sort RRs in numerically ascending order.
	$Net::DNS::a->{'preference'} <=> $Net::DNS::b->{'preference'};
};

__PACKAGE__->set_rrsort_func( 'preference', $function );

__PACKAGE__->set_rrsort_func( 'default_sort', $function );


1;
__END__