File Coverage

blib/lib/Net/DNS/ZoneParse/Generator/Native.pm
Criterion Covered Total %
statement 34 35 97.1
branch 7 12 58.3
condition 1 2 50.0
subroutine 7 7 100.0
pod 1 1 100.0
total 50 57 87.7


line stmt bran cond sub pod time code
1             package Net::DNS::ZoneParse::Generator::Native;
2              
3 2     2   4578 use 5.008000;
  2         9  
  2         81  
4 2     2   11 use strict;
  2         3  
  2         63  
5 2     2   11 use warnings;
  2         5  
  2         87  
6 2     2   10 use vars qw($VERSION);
  2         4  
  2         93  
7              
8 2     2   13 use Net::DNS;
  2         4  
  2         1206  
9              
10             $VERSION = 0.101;
11              
12             =pod
13              
14             =head1 NAME
15              
16             Net::DNS::ZoneParse::Generator::Native - Net::DNS::ZoneParse's native generator.
17              
18             =head1 DESCRIPTION
19              
20             The native generator generates valid files, which can be read by most parsers.
21             If the corresponding information is available, it will generate correct
22             $TTL and $ORIGIN directives and - at least for the name of the resource records
23             shorten the names, if applicable.
24              
25             =cut
26              
27             #####################
28             # private functions #
29             #####################
30              
31             # return one line of text for one RR
32             sub _writerr {
33 4     4   8 my ($rr, $zre, $ttl) = @_;
34 4         6 my $name = $rr->{name};
35 4 50       717 if($name =~ $zre) {
    50          
36 0         0 $name = $1;
37             } elsif( $name !~ m/\.$/) {
38 4         9 $name .= ".";
39             }
40 4 50       18 $ttl = 0 unless $ttl;
41 4   50     329 $ttl = (($rr->{ttl} == $ttl)?"":$rr->{ttl}) || "";
42 4         37 my $data = $rr->rdatastr;
43 4 50       160 $data = '; no data' unless $data;
44 4         35 return join("\t", $name, $ttl, $rr->{class}, $rr->{type}, $data);
45             }
46              
47             =pod
48              
49             =head2 EXPORT
50              
51             =head3 generate
52              
53             This will be called by the Interface of Net::DNS:ZoneParse and return the
54             corresponding zonetext.
55              
56             =cut
57              
58             sub generate {
59 2     2 1 5 my ($self, $param) = @_;
60 2         3 my $ret = "";
61 2         50 my $zre = qr/^\(\)$/;
62 2 100       7 if($param->{origin}) {
63 1         4 $ret .= "\$ORIGIN\t$param->{origin}\n";
64 1         24 $zre = qr/^(.*)\.$param->{origin}$/;
65             }
66 2 50       7 $ret .= "\$TTL\t$param->{ttl}\n" if($param->{ttl});
67 2         2 return $ret.join("\n", map { _writerr($_, $zre, $param->{ttl}); } @{$param->{rr}})."\n";
  4         11  
  2         6  
68             }
69              
70             =pod
71              
72             =head1 SEE ALSO
73              
74             Net::DNS::ZoneParse
75              
76             =head1 AUTHOR
77              
78             Benjamin Tietz Ebenjamin@micronet24.deE
79              
80             =head1 COPYRIGHT
81              
82             Copyright (C) 2010 by Benjamin Tietz
83              
84             This library is free software; you can redistribute it and/or modify
85             it under the same terms as Perl itself, either Perl version 5.10.0 or,
86             at your option, any later version of Perl 5 you may have available.
87              
88             =cut
89              
90             1;