File Coverage

blib/lib/TinyDNS/Reader.pm
Criterion Covered Total %
statement 27 36 75.0
branch 6 14 42.8
condition 3 9 33.3
subroutine 5 6 83.3
pod 2 2 100.0
total 43 67 64.1


line stmt bran cond sub pod time code
1              
2             =head1 NAME
3            
4             TinyDNS::Reader - Read TinyDNS files.
5            
6             =head1 DESCRIPTION
7            
8             This module allows the parsing of a TinyDNS data-file, or individual records
9             taken from one.
10            
11             =cut
12              
13             =head1 SYNOPSIS
14            
15             use TinyDNS::Reader;
16            
17             my $tmp = TinyDNS::Reader->new( file => "./zones/example.com" );
18             my $dns = $tmp->parse();
19            
20             foreach my $record ( @$dns )
21             {
22             print $record . "\n";
23             }
24            
25            
26             =head1 DESCRIPTION
27            
28             This module contains code for reading a zone-file which has been
29             created for use with L<DJB's tinydns|http://cr.yp.to/djbdns/tinydns.html>.
30            
31             A zonefile may be parsed and turned into a series of L<TinyDNS::Record> objects,
32             one for each valid record which is found.
33            
34             If you wish to merge multiple records, referring to the same hostname, you should also consult the documentation for the L<TinyeDNS::Reader::Merged> module.
35            
36             =cut
37              
38             =head1 METHODS
39            
40             =cut
41              
42 3     3   44888 use strict;
  3         6  
  3         76  
43 3     3   12 use warnings;
  3         5  
  3         104  
44              
45             package TinyDNS::Reader;
46              
47 3     3   1047 use TinyDNS::Record;
  3         7  
  3         1095  
48              
49             our $VERSION = '0.7.6';
50              
51              
52              
53             =head2 new
54            
55             The constructor should be given either a "C<file>" or "C<text>" parameter,
56             containing the filename to parse, or the text to parse, respectively.
57            
58             =cut
59              
60             sub new
61             {
62 10     10 1 18183     my ( $proto, %supplied ) = (@_);
63 10   33     51     my $class = ref($proto) || $proto;
64              
65 10         16     my $self = {};
66 10         18     bless( $self, $class );
67              
68 10 50       33     if ( $supplied{ 'file' } )
    50          
69                 {
70 0         0         $self->{ 'data' } = $self->_readFile( $supplied{ 'file' } );
71                 }
72                 elsif ( $supplied{ 'text' } )
73                 {
74 10         34         $self->{ 'data' } = $supplied{ 'text' };
75                 }
76                 else
77                 {
78 0         0         die "Missing 'text' or 'file' argument.";
79                 }
80              
81 10         32     return $self;
82              
83             }
84              
85              
86             =begin doc
87            
88             Read the contents of the specified file.
89            
90             Invoked by the constructor if it was passed a C<file> argument.
91            
92             =end doc
93            
94             =cut
95              
96             sub _readFile
97             {
98 0     0   0     my ( $self, $file ) = (@_);
99              
100 0 0       0     open( my $handle, "<", $file ) or
101                   die "Failed to read $file - $!";
102              
103 0         0     my $text = "";
104              
105 0         0     while ( my $line = <$handle> )
106                 {
107 0         0         $text .= $line;
108                 }
109 0         0     close($handle);
110              
111 0         0     return ($text);
112             }
113              
114              
115             =head2 parse
116            
117             Process and return an array of L<TinyDNS::Records> from the data contained
118             in the file specified by our constructor, or the scalar reference.
119            
120             =cut
121              
122             sub parse
123             {
124 10     10 1 2791     my ($self) = (@_);
125              
126 10         11     my $records;
127              
128 10         44     foreach my $line ( split( /[\n\r]/, $self->{ 'data' } ) )
129                 {
130 11         20         chomp($line);
131              
132             # Skip empty lines.
133 11 50 33     48         next if ( !$line || !length($line) );
134              
135             # Strip trailing comments.
136 11         20         $line =~ s/#.*$//s;
137              
138             # Skip empty lines.
139 11 50 33     36         next if ( !$line || !length($line) );
140              
141              
142             #
143             # Ignore "." + ":" records
144             #
145 11 50       32         next if ( $line =~ /^\s*[:.]/ );
146              
147             #
148             # Construct a new object, and add it to the list.
149             #
150 11         67         my $rec = TinyDNS::Record->new($line);
151 11 50       38         push( @$records, $rec ) if ($rec);
152                 }
153              
154 10         26     return ($records);
155             }
156              
157              
158             1;
159              
160              
161             =head1 AUTHOR
162            
163             Steve Kemp <steve@steve.org.uk>
164            
165             =cut
166              
167             =head1 COPYRIGHT AND LICENSE
168            
169             Copyright (C) 2014-2015 Steve Kemp <steve@steve.org.uk>.
170            
171             This code was developed for an online Git-based DNS hosting solution,
172             which can be found at:
173            
174             =over 8
175            
176             =item *
177             https://dns-api.com/
178            
179             =back
180            
181             This library is free software. You can modify and or distribute it under
182             the same terms as Perl itself.
183            
184             =cut
185