File Coverage

blib/lib/Net/DNS/RR/NAPTR.pm
Criterion Covered Total %
statement 69 69 100.0
branch 8 8 100.0
condition 4 4 100.0
subroutine 16 16 100.0
pod 6 6 100.0
total 103 103 100.0


line stmt bran cond sub pod time code
1             package Net::DNS::RR::NAPTR;
2              
3 1     1   8 use strict;
  1         1  
  1         30  
4 1     1   4 use warnings;
  1         2  
  1         57  
5             our $VERSION = (qw$Id: NAPTR.pm 1898 2023-02-15 14:27:22Z willem $)[2];
6              
7 1     1   7 use base qw(Net::DNS::RR);
  1         1  
  1         96  
8              
9              
10             =head1 NAME
11              
12             Net::DNS::RR::NAPTR - DNS NAPTR resource record
13              
14             =cut
15              
16 1     1   7 use integer;
  1         2  
  1         5  
17              
18 1     1   36 use Net::DNS::DomainName;
  1         2  
  1         23  
19 1     1   468 use Net::DNS::Text;
  1         6  
  1         839  
20              
21              
22             sub _decode_rdata { ## decode rdata from wire-format octet string
23 1     1   2 my ( $self, $data, $offset ) = @_;
24              
25 1         2 @{$self}{qw(order preference)} = unpack "\@$offset n2", $$data;
  1         4  
26 1         4 ( $self->{flags}, $offset ) = Net::DNS::Text->decode( $data, $offset + 4 );
27 1         3 ( $self->{service}, $offset ) = Net::DNS::Text->decode( $data, $offset );
28 1         2 ( $self->{regexp}, $offset ) = Net::DNS::Text->decode( $data, $offset );
29 1         6 $self->{replacement} = Net::DNS::DomainName2535->decode( $data, $offset );
30 1         2 return;
31             }
32              
33              
34             sub _encode_rdata { ## encode rdata as wire-format octet string
35 5     5   11 my ( $self, $offset, @opaque ) = @_;
36              
37 5         8 my $rdata = pack 'n2', @{$self}{qw(order preference)};
  5         14  
38 5         15 $rdata .= $self->{flags}->encode;
39 5         11 $rdata .= $self->{service}->encode;
40 5         12 $rdata .= $self->{regexp}->encode;
41 5         17 $rdata .= $self->{replacement}->encode( $offset + length($rdata), @opaque );
42 5         16 return $rdata;
43             }
44              
45              
46             sub _format_rdata { ## format rdata portion of RR string.
47 2     2   3 my $self = shift;
48              
49 2         3 my @order = @{$self}{qw(order preference)};
  2         6  
50 2         3 my @rdata = ( @order, map { $_->string } @{$self}{qw(flags service regexp replacement)} );
  8         22  
  2         4  
51 2         16 return @rdata;
52             }
53              
54              
55             sub _parse_rdata { ## populate RR from rdata in argument list
56 1     1   4 my ( $self, @argument ) = @_;
57              
58 1         2 foreach (qw(order preference flags service regexp replacement)) { $self->$_( shift @argument ) }
  6         14  
59 1         3 return;
60             }
61              
62              
63             sub order {
64 4     4 1 18 my ( $self, @value ) = @_;
65 4         7 for (@value) { $self->{order} = 0 + $_ }
  2         8  
66 4   100     31 return $self->{order} || 0;
67             }
68              
69              
70             sub preference {
71 4     4 1 1146 my ( $self, @value ) = @_;
72 4         8 for (@value) { $self->{preference} = 0 + $_ }
  2         6  
73 4   100     21 return $self->{preference} || 0;
74             }
75              
76              
77             sub flags {
78 4     4 1 1047 my ( $self, @value ) = @_;
79 4         9 for (@value) { $self->{flags} = Net::DNS::Text->new($_) }
  2         7  
80 4 100       16 return $self->{flags} ? $self->{flags}->value : undef;
81             }
82              
83              
84             sub service {
85 4     4 1 1037 my ( $self, @value ) = @_;
86 4         8 for (@value) { $self->{service} = Net::DNS::Text->new($_) }
  2         4  
87 4 100       16 return $self->{service} ? $self->{service}->value : undef;
88             }
89              
90              
91             sub regexp {
92 4     4 1 1032 my ( $self, @value ) = @_;
93 4         8 for (@value) { $self->{regexp} = Net::DNS::Text->new($_) }
  2         5  
94 4 100       17 return $self->{regexp} ? $self->{regexp}->value : undef;
95             }
96              
97              
98             sub replacement {
99 4     4 1 1098 my ( $self, @value ) = @_;
100 4         7 for (@value) { $self->{replacement} = Net::DNS::DomainName2535->new($_) }
  2         15  
101 4 100       29 return $self->{replacement} ? $self->{replacement}->name : undef;
102             }
103              
104              
105             my $function = sub {
106             my ( $a, $b ) = ( $Net::DNS::a, $Net::DNS::b );
107             return $a->{order} <=> $b->{order}
108             || $a->{preference} <=> $b->{preference};
109             };
110              
111             __PACKAGE__->set_rrsort_func( 'order', $function );
112              
113             __PACKAGE__->set_rrsort_func( 'default_sort', $function );
114              
115              
116             1;
117             __END__