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


line stmt bran cond sub pod time code
1             package Net::DNS::RR::AMTRELAY;
2              
3 1     1   7 use strict;
  1         2  
  1         30  
4 1     1   5 use warnings;
  1         2  
  1         45  
5             our $VERSION = (qw$Id: AMTRELAY.pm 1896 2023-01-30 12:59:25Z willem $)[2];
6              
7 1     1   6 use base qw(Net::DNS::RR);
  1         2  
  1         97  
8              
9              
10             =head1 NAME
11              
12             Net::DNS::RR::AMTRELAY - DNS AMTRELAY resource record
13              
14             =cut
15              
16 1     1   8 use integer;
  1         2  
  1         6  
17              
18 1     1   35 use Carp;
  1         1  
  1         63  
19              
20 1     1   6 use Net::DNS::DomainName;
  1         2  
  1         35  
21 1     1   485 use Net::DNS::RR::A;
  1         3  
  1         28  
22 1     1   465 use Net::DNS::RR::AAAA;
  1         2  
  1         1262  
23              
24              
25             sub _decode_rdata { ## decode rdata from wire-format octet string
26 5     5   9 my ( $self, $data, $offset ) = @_;
27              
28 5         10 my $size = $self->{rdlength} - 2;
29 5         18 @{$self}{qw(precedence relaytype relay)} = unpack "\@$offset C2 a$size", $$data;
  5         16  
30              
31 5         12 for ( $self->relaytype ) {
32 5 100       21 /^3$/ && return $self->{relay} = Net::DNS::DomainName->decode( $data, $offset + 2 );
33 3 100       14 /^2$/ && return $self->{relay} = pack( 'a16', $self->{relay} );
34 2 100       11 /^1$/ && return $self->{relay} = pack( 'a4', $self->{relay} );
35             }
36 1         3 $self->{relay} = '';
37 1         3 return;
38             }
39              
40              
41             sub _encode_rdata { ## encode rdata as wire-format octet string
42 9     9   15 my $self = shift;
43              
44 9         19 for ( $self->relaytype ) {
45 9 100       38 /^3$/ && return pack( 'C2 a*', @{$self}{qw(precedence relaytype)}, $self->{relay}->encode );
  6         21  
46 3 100       18 /^2$/ && return pack( 'C2 a16', @{$self}{qw(precedence relaytype relay)} );
  1         7  
47 2 100       9 /^1$/ && return pack( 'C2 a4', @{$self}{qw(precedence relaytype relay)} );
  1         5  
48             }
49 1         2 return pack( 'C2', @{$self}{qw(precedence relaytype)} );
  1         3  
50             }
51              
52              
53             sub _format_rdata { ## format rdata portion of RR string.
54 23     23   43 my $self = shift;
55              
56 23         38 my @rdata = map { $self->$_ } qw(precedence dbit relaytype relay);
  92         170  
57 23         77 return @rdata;
58             }
59              
60              
61             sub _parse_rdata { ## populate RR from rdata in argument list
62 7     7   19 my ( $self, @argument ) = @_;
63              
64 7         15 foreach (qw(precedence dbit relaytype relay)) {
65 28         62 $self->$_( shift @argument );
66             }
67 7         15 return;
68             }
69              
70              
71             sub _defaults { ## specify RR attribute default values
72 1     1   2 my $self = shift;
73              
74 1         2 @{$self}{qw(precedence relaytype relay)} = ( 0, 0, '' );
  1         7  
75 1         3 return;
76             }
77              
78              
79             sub precedence {
80 33     33 1 61 my ( $self, @value ) = @_;
81 33         60 for (@value) { $self->{precedence} = 0 + $_ }
  8         20  
82 33   100     107 return $self->{precedence} || 0;
83             }
84              
85              
86             sub dbit {
87 61     61 0 97 my ( $self, @value ) = @_; # uncoverable pod
88 61 100       101 for (@value) { $self->{relaytype} = $self->relaytype | ( $_ ? 0x80 : 0 ) }
  12         20  
89 61   100     199 return ( $self->{relaytype} || 0 ) >> 7;
90             }
91              
92 11     11 0 18 sub d { return &dbit } # uncoverable pod
93              
94              
95             sub relaytype {
96 100     100 1 975 my ( $self, @value ) = @_;
97 100 100       152 for (@value) { $self->{relaytype} = $self->dbit ? ( 0x80 | $_ ) : $_ }
  20         30  
98 100   100     283 return 0x7f & ( $self->{relaytype} || 0 );
99             }
100              
101              
102             sub relay {
103 42     42 1 1221 my ( $self, @value ) = @_;
104              
105 42         75 for (@value) {
106 13 100       58 /^\.*$/ && do {
107 2         6 $self->relaytype(0);
108 2         4 $self->{relay} = ''; # no relay
109 2         4 last;
110             };
111 11 100       28 /:.*:/ && do {
112 2         6 $self->relaytype(2);
113 2         8 $self->{relay} = Net::DNS::RR::AAAA::address( {}, $_ );
114 2         7 last;
115             };
116 9 100       31 /\.\d+$/ && do {
117 2         5 $self->relaytype(1);
118 2         10 $self->{relay} = Net::DNS::RR::A::address( {}, $_ );
119 2         6 last;
120             };
121 7 100       21 /\..+/ && do {
122 6         17 $self->relaytype(3);
123 6         19 $self->{relay} = Net::DNS::DomainName->new($_);
124 6         14 last;
125             };
126 1         211 croak 'unrecognised relay type';
127             }
128              
129 41 100       81 if ( defined wantarray ) {
130 29         46 for ( $self->relaytype ) {
131 29 100       96 /^1$/ && return Net::DNS::RR::A::address( {address => $self->{relay}} );
132 23 100       77 /^2$/ && return Net::DNS::RR::AAAA::address( {address => $self->{relay}} );
133 17 100       84 /^3$/ && return wantarray ? $self->{relay}->string : $self->{relay}->name;
    100          
134             }
135             }
136 19 100       61 return wantarray ? '.' : undef;
137             }
138              
139              
140             my $function = sub { ## sort RRs in numerically ascending order.
141             $Net::DNS::a->{'preference'} <=> $Net::DNS::b->{'preference'};
142             };
143              
144             __PACKAGE__->set_rrsort_func( 'preference', $function );
145              
146             __PACKAGE__->set_rrsort_func( 'default_sort', $function );
147              
148              
149             1;
150             __END__