File Coverage

blib/lib/TinyDNS/Reader/Merged.pm
Criterion Covered Total %
statement 40 42 95.2
branch 9 14 64.2
condition 2 6 33.3
subroutine 5 5 100.0
pod 2 2 100.0
total 58 69 84.0


line stmt bran cond sub pod time code
1              
2             =head1 NAME
3            
4             TinyDNS::Reader::Merged - Read a TinyDNS file and merge records.
5            
6             =head1 DESCRIPTION
7            
8             The L<TinyDNS::Reader> module will allow you to parse a TinyDNS zonefile,
9             into a number of distinct records, one for each line.
10            
11             However there is no handling the case where you'd expect a single DNS
12             value to have multiple values.
13            
14             For example if you were to parse this file you would get two records:
15            
16             =for example begin
17            
18             db.example.com:1.2.3.4:300
19             db.example.com:10.20.30.40:300
20            
21             =for example end
22            
23             On a purely record-by-record basis that is as-expected, however when you
24             actually come to manipulate your DNS records you'd expect to have a single
25             logical object with values something like this:
26            
27             =for example begin
28            
29             {
30             'ttl' => '300',
31             'value' => [
32             '1.2.3.4',
33             '10.20.30.40'
34             ],
35             'name' => 'db.example.com',
36             'type' => 'A'
37             },
38            
39             =for example end
40            
41             This module takes care of that for you, by merging records which consist
42             of identical "name" + "type" pairs.
43            
44             Use it as a drop-in replacing for L<TinyDNS::Reader>.
45            
46             =cut
47              
48              
49             =head2 METHODS
50            
51             =cut
52              
53              
54             package TinyDNS::Reader::Merged;
55              
56 2     2   13469 use TinyDNS::Reader;
  2         3  
  2         49  
57              
58 2     2   12 use strict;
  2         2  
  2         30  
59 2     2   6 use warnings;
  2         1  
  2         512  
60              
61              
62             =head2 new
63            
64             Constructor.
65            
66             This module expects to be given a C<file> parameter, pointing to a
67             file which can be parsed, or a C<text> parameter containing the text of the
68             records to parse.
69            
70             =cut
71              
72             sub new
73             {
74 4     4 1 4617     my ( $proto, %supplied ) = (@_);
75 4   33     15     my $class = ref($proto) || $proto;
76              
77 4         5     my $self = {};
78 4         5     bless( $self, $class );
79              
80             #
81             # Create our child object.
82             #
83 4 50       10     if ( $supplied{ 'file' } )
    50          
84                 {
85 0         0         $self->{ 'obj' } = TinyDNS::Reader->new( file => $supplied{ 'file' } );
86                 }
87                 elsif ( $supplied{ 'text' } )
88                 {
89 4         13         $self->{ 'obj' } = TinyDNS::Reader->new( text => $supplied{ 'text' } );
90                 }
91                 else
92                 {
93 0         0         die "Missing 'text' or 'file' argument";
94                 }
95 4         6     return $self;
96             }
97              
98              
99             =head2 parse
100            
101             Parse the records and return a merged set.
102            
103             The parsing is delegated to L<TinyDNS::Reader>, so all supported record-types
104             work as expected.
105            
106             =cut
107              
108             sub parse
109             {
110 4     4 1 783     my ($self) = (@_);
111              
112 4         9     my $records = $self->{ 'obj' }->parse();
113              
114              
115             #
116             # Process each entry
117             #
118 4         3     my $res;
119              
120 4         5     my %seen = ();
121              
122 4         6     foreach my $r (@$records)
123                 {
124              
125             # Test that the record was recognized.
126 5 50       9         next unless ( $r->valid() );
127              
128 5         6         my $name = $r->name();
129 5         6         my $type = $r->type();
130 5         6         my $val = $r->value();
131 5         6         my $ttl = $r->ttl();
132 5         8         my $hash = $r->hash();
133              
134             # skip if we've seen this name+type pair before.
135 5 100       12         next if ( $seen{ $name }{ $type } );
136              
137             #
138             # Look for other values with the same type.
139             #
140             # NOTE: O(N^2) - needs improvement.
141             #
142 4         5         foreach my $x (@$records)
143                     {
144              
145             # Test that the record was recognized.
146 5 50       6             next if ( !$x->valid() );
147              
148 5         7             my $name2 = $x->name();
149 5         6             my $type2 = $x->type();
150 5         6             my $val2 = $x->value();
151 5         5             my $hash2 = $x->hash();
152              
153 5 100       11             next if ( $hash eq $hash2 );
154              
155             #
156             # If this record has the same name/type as the
157             # previous one then merge in the new value.
158             #
159             # NOTE: This means the TTL comes from the first
160             # of the records. Which is fine.
161             #
162 1 50 33     6             if ( ( $name eq $name2 ) &&
163                              ( $type eq $type2 ) )
164                         {
165 1         2                 $r->add($val2);
166                         }
167                     }
168              
169 4         9         push( @$res,
170                           { name => $name,
171                              value => $r->value(),
172                              ttl => $ttl,
173                              type => $type
174                           } );
175              
176              
177             #
178             # We've seen this name/type pair now.
179             #
180 4         8         $seen{ $name }{ $type } += 1;
181                 }
182              
183             #
184             # Return the merged/updated results.
185             #
186 4         16     return ($res);
187             }
188              
189             1;
190              
191              
192             =head1 AUTHOR
193            
194             Steve Kemp <steve@steve.org.uk>
195            
196             =cut
197              
198             =head1 COPYRIGHT AND LICENSE
199            
200             Copyright (C) 2014-2015 Steve Kemp <steve@steve.org.uk>.
201            
202             This code was developed for an online Git-based DNS hosting solution,
203             which can be found at:
204            
205             =over 8
206            
207             =item *
208             https://dns-api.com/
209            
210             =back
211            
212             This library is free software. You can modify and or distribute it under
213             the same terms as Perl itself.
214            
215             =cut
216