File Coverage

blib/lib/Net/DNS/Create/Tiny.pm
Criterion Covered Total %
statement 36 38 94.7
branch 15 16 93.7
condition 1 2 50.0
subroutine 11 13 84.6
pod 0 7 0.0
total 63 76 82.8


line stmt bran cond sub pod time code
1             # Copyright (c) 2009-2014 David Caldwell, All Rights Reserved.
2              
3             package Net::DNS::Create::Tiny;
4 1     1   7 use feature ':5.10';
  1         1  
  1         155  
5 1     1   6 use strict;
  1         2  
  1         44  
6 1     1   6 use warnings;
  1         1  
  1         47  
7              
8 1     1   5 use Net::DNS::Create qw(internal full_host email interval);
  1         1  
  1         10  
9 1     1   1246 use File::Slurp qw(write_file);
  1         15716  
  1         1056  
10              
11             our %config;
12             sub import {
13 1     1   3 my $package = shift;
14 1         4 my %c = @_;
15 1         9 $config{$_} = $c{$_} for keys %c;
16             }
17              
18             sub tiny_escape($) {
19 8     8 0 298 my ($f) = @_;
20 8         113 $f =~ s/(:|\\|[^ -~])/sprintf "\\%03o", ord($1)/eg;
  25         141  
21 8         42 $f
22             }
23              
24             sub domainname_encode($;$) {
25 3     3 0 109 my ($node, $domain) = @_;
26 3         9 $node = full_host($node, $domain);
27 3         18 join('', map { chr(length $_).$_ } split /\./, $node, -1);
  13         50  
28             }
29              
30             sub C(@) { # "Colon"
31 27     27 0 560 join(':', @_)
32             }
33              
34             my @domain;
35             sub domain($$) {
36 1     1 0 3 my ($package, $domain, $entries) = @_;
37              
38 1         4 my @conf = map { ;
39 27         133 my $rr = lc $_->type;
40 27         331 my $fqdn = $_->name . '.';
41              
42 27 50 50     806 $rr eq 'a' ? '='.C($fqdn,$_->address,$_->ttl) :
    100          
    100          
    100          
    100          
    100          
    100          
    100          
43             $rr eq 'cname' ? 'C'.C($fqdn,$_->cname.'.',$_->ttl) :
44             $rr eq 'rp' ? ':'.C($fqdn,17,tiny_escape(domainname_encode(email($_->mbox)).domainname_encode($_->txtdname)),$_->ttl) :
45             $rr eq 'mx' ? '@'.C($fqdn,'',$_->exchange.'.',$_->preference,'',$_->ttl) :
46             $rr eq 'ns' ? '&'.C($fqdn,'',$_->nsdname.'.',$_->ttl) :
47             $rr eq 'txt' ? "'".C($fqdn,tiny_escape(join('',$_->char_str_list)),$_->ttl) :
48             $rr eq 'soa' ? 'Z'.C($fqdn,
49             $_->mname.'.',
50             email($_->rname),
51             $_->serial || '',
52             $_->refresh, $_->retry, $_->expire, $_->minimum, $_->ttl) :
53             $rr eq 'srv' ? ':'.C($fqdn,33,tiny_escape(pack("nnn", $_->priority, $_->weight, $_->port)
54             .domainname_encode($_->target)),$_->ttl) :
55             die "Don't know how to handle \"$rr\" RRs yet.";
56              
57             } @$entries;
58              
59 27         193 push @domain, "# $domain\n" .
60             "#\n" .
61 1         8 join('', map { "$_\n" } @conf) .
62             "\n";
63             }
64              
65             sub master {
66 1     1 0 4 my ($package, $filename) = @_;
67 1         10 write_file($filename, @domain);
68             }
69              
70 0     0 0   sub domain_list($@) {
71             # There are no separate zone files in a tiny setup.
72             }
73              
74             sub master_list($$) {
75 0     0 0   print "$_[0]\n"
76             }
77              
78             1;
79             __END__