File Coverage

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

Criterion	Covered	Total	%
statement	92	92	100.0
branch	24	24	100.0
condition	12	12	100.0
subroutine	20	20	100.0
pod	7	7	100.0
total	155	155	100.0

package Net::DNS::RR::SOA;

use strict;
use warnings;
our $VERSION = (qw$Id: SOA.pm 1931 2023-08-23 13:14:15Z willem $)[2];

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


=head1 NAME

Net::DNS::RR::SOA - DNS SOA resource record

=cut

use integer;

use Net::DNS::DomainName;
use Net::DNS::Mailbox;


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

	( $self->{mname}, $offset ) = Net::DNS::DomainName1035->decode(@argument);
	( $self->{rname}, $offset ) = Net::DNS::Mailbox1035->decode( $data, $offset, @opaque );
	@{$self}{qw(serial refresh retry expire minimum)} = unpack "\@$offset N5", $$data;
	return;
}


sub _encode_rdata {			## encode rdata as wire-format octet string
	my ( $self,   @argument ) = @_;
	my ( $offset, @opaque )	  = @argument;

	my $rname = $self->{rname};
	my $rdata = $self->{mname}->encode(@argument);
	$rdata .= $rname->encode( $offset + length($rdata), @opaque );
	$rdata .= pack 'N5', $self->serial, @{$self}{qw(refresh retry expire minimum)};
	return $rdata;
}


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

	my $mname  = $self->{mname}->string;
	my $rname  = $self->{rname}->string;
	my $serial = $self->serial;
	my $spacer = length "$serial" > 7 ? "" : "\t";
	return ($mname, $rname,
		join( "\n\t\t\t\t",
			"\t\t\t$serial$spacer\t;serial", "$self->{refresh}\t\t;refresh",
			"$self->{retry}\t\t;retry",	 "$self->{expire}\t\t;expire",
			"$self->{minimum}\t\t;minimum\n" ) );
}


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

	for (qw(mname rname)) { $self->$_( shift @argument ) }
	$self->serial( shift @argument ) if scalar @argument;	# possibly undefined
	for (qw(refresh retry expire minimum)) {
		last unless scalar @argument;
		$self->$_( Net::DNS::RR::ttl( {}, shift @argument ) );
	}
	return;
}


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

	$self->_parse_rdata(qw(. . 0 4h 1h 3w 1h));
	delete $self->{serial};
	return;
}


sub mname {
	my ( $self, @value ) = @_;
	for (@value) { $self->{mname} = Net::DNS::DomainName1035->new($_) }
	return $self->{mname} ? $self->{mname}->name : undef;
}


sub rname {
	my ( $self, @value ) = @_;
	for (@value) { $self->{rname} = Net::DNS::Mailbox1035->new($_) }
	return $self->{rname} ? $self->{rname}->address : undef;
}


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

	return $self->{serial} || 0 unless scalar @value;	# current/default value

	my $value = shift @value;				# replace if in sequence
	return $self->{serial} = ( $value & 0xFFFFFFFF ) if _ordered( $self->{serial}, $value );

	# unwise to assume 64-bit arithmetic, or that 32-bit integer overflow goes unpunished
	my $serial = 0xFFFFFFFF & ( $self->{serial} || 0 );
	return $self->{serial} = 0x80000000 if $serial == 0x7FFFFFFF;	 # wrap
	return $self->{serial} = 0x00000000 if $serial == 0xFFFFFFFF;	 # wrap
	return $self->{serial} = $serial + 1;			# increment
}


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


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


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


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


########################################

sub _ordered() {			## irreflexive 32-bit partial ordering
	my ( $n1, $n2 ) = @_;

	return 0 unless defined $n2;				# ( any, undef )
	return 1 unless defined $n1;				# ( undef, any )

	# unwise to assume 64-bit arithmetic, or that 32-bit integer overflow goes unpunished
	use integer;						# fold, leaving $n2 non-negative
	$n1 = ( $n1 & 0xFFFFFFFF ) ^ ( $n2 & 0x80000000 );	# -2**31 <= $n1 < 2**32
	$n2 = ( $n2 & 0x7FFFFFFF );				#  0	 <= $n2 < 2**31

	return $n1 < $n2 ? ( $n1 > ( $n2 - 0x80000000 ) ) : ( $n2 < ( $n1 - 0x80000000 ) );
}

########################################


1;
__END__