File Coverage

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

Criterion	Covered	Total	%
statement	44	44	100.0
branch	12	12	100.0
condition			n/a
subroutine	11	11	100.0
pod	3	3	100.0
total	70	70	100.0

package Net::DNS::RR::AAAA;

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

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


=head1 NAME

Net::DNS::RR::AAAA - DNS AAAA resource record

=cut

use integer;


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

	$self->{address} = unpack "\@$offset a16", $$data;
	return;
}


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

	return pack 'a16', $self->{address};
}


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

	return $self->address_short;
}


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

	$self->address(@argument);
	return;
}


sub address_long {
	my $addr = pack 'a*@16', grep {defined} shift->{address};
	return sprintf '%x:%x:%x:%x:%x:%x:%x:%x', unpack 'n8', $addr;
}


sub address_short {
	my $addr = pack 'a*@16', grep {defined} shift->{address};
	local $_ = sprintf ':%x:%x:%x:%x:%x:%x:%x:%x:', unpack 'n8', $addr;
	s/(:0[:0]+:)(?!.+:0\1)/::/;				# squash longest zero sequence
	s/^:// unless /^::/;					# prune LH :
	s/:$// unless /::$/;					# prune RH :
	return $_;
}


sub address {
	my ( $self, $addr ) = @_;

	return address_long($self) unless defined $addr;

	my @parse = split /:/, "0$addr";

	if ( (@parse)[$#parse] =~ /\./ ) {			# embedded IPv4
		my @ip4 = split /\./, pop(@parse);
		my $rhs = pop(@ip4);
		my @ip6 = map { /./ ? hex($_) : (0) x ( 7 - @parse ) } @parse;
		return $self->{address} = pack 'n6 C4', @ip6, @ip4, (0) x ( 3 - @ip4 ), $rhs;
	}

	# Note: pack() masks overlarge values, mostly without warning.
	my @expand = map { /./ ? hex($_) : (0) x ( 9 - @parse ) } @parse;
	return $self->{address} = pack 'n8', @expand;
}


1;
__END__