File Coverage

blib/lib/Net/DNS/Create/Tiny.pm
Criterion Covered Total %
statement 13 15 86.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 18 20 90.0


line stmt bran cond sub pod time code
1             # Copyright (c) 2009-2013 David Caldwell, All Rights Reserved.
2              
3             package Net::DNS::Create::Tiny;
4 1     1   8 use feature ':5.10';
  1         1  
  1         143  
5 1     1   5 use strict;
  1         2  
  1         277  
6 1     1   6 use warnings;
  1         2  
  1         46  
7              
8 1     1   15 use Net::DNS::Create qw(internal full_host email interval);
  1         2  
  1         12  
9 1     1   825 use File::Slurp qw(write_file);
  0            
  0            
10              
11             our %config;
12             sub import {
13             my $package = shift;
14             my %c = @_;
15             $config{$_} = $c{$_} for keys %c;
16             }
17              
18             sub tiny_escape($) {
19             my ($f) = @_;
20             $f =~ s/(:|\\|[^ -~])/sprintf "\\%03o", ord($1)/eg;
21             $f
22             }
23              
24             sub domainname_encode($;$) {
25             my ($node, $domain) = @_;
26             $node = full_host($node, $domain);
27             join('', map { chr(length $_).$_ } split /\./, $node, -1);
28             }
29              
30             sub C(@) { # "Colon"
31             join(':', @_)
32             }
33              
34             my @domain;
35             sub domain($$) {
36             my ($package, $domain, $entries) = @_;
37              
38             my @conf = map { ;
39             my $rr = lc $_->type;
40             my $fqdn = $_->name . '.';
41              
42             $rr eq 'a' ? '='.C($fqdn,$_->address,$_->ttl) :
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             push @domain, "# $domain\n" .
60             "#\n" .
61             join('', map { "$_\n" } @conf) .
62             "\n";
63             }
64              
65             sub master {
66             my ($package, $filename) = @_;
67             write_file($filename, @domain);
68             }
69              
70             sub domain_list($@) {
71             # There are no separate zone files in a tiny setup.
72             }
73              
74             sub master_list($$) {
75             print "$_[0]\n"
76             }
77              
78             1;
79             __END__