equal
deleted
inserted
replaced
|
1 package DNS::Vi; |
1 use 5.010; |
2 use 5.010; |
2 use strict; |
3 use strict; |
3 use warnings; |
4 use warnings; |
4 use if $ENV{DEBUG}//'' eq 'dnsvi' => 'Smart::Comments'; |
5 use if $ENV{DEBUG}//'' eq 'dnsvi' => 'Smart::Comments'; |
5 use Digest::SHA qw(sha512_hex); |
6 use Digest::SHA qw(sha512_hex); |
6 |
7 |
7 use base 'Exporter'; |
8 use base 'Exporter'; |
8 |
9 |
9 our @EXPORT = qw(ttl2h h2ttl parse delta); |
10 our @EXPORT = qw(ttl2h h2ttl parse delta nice); |
10 our @EXPORT_OK = (); |
11 our @EXPORT_OK = (); |
11 |
12 |
12 sub parse { |
13 sub parse { |
13 my $data = join '', @_; |
14 my $data = join '', @_; |
14 my @lines = split /\n/, $data; |
15 my @lines = split /\n/, $data; |
115 |
116 |
116 return $out // $ttl; |
117 return $out // $ttl; |
117 } |
118 } |
118 |
119 |
119 sub nice { |
120 sub nice { |
|
121 my %order = map { state $n = 0; $_ => ++$n } qw(SOA NS TXT MX A AAAA); |
120 |
122 |
121 # get a list of { id => $id, rrset => \%rrset } |
123 # get a list of { id => $id, rrset => \%rrset } |
122 my @zone = |
124 my @zone = |
123 sort { |
125 sort { |
124 length $a->{label} <=> length $b->{label} |
126 length $a->{label} <=> length $b->{label} |
125 or $a->{label} |
127 or $a->{label} cmp $b->{label} |
126 cmp $b->{label} |
128 or ($order{$a->{rrtype}}//99) <=> ($order{$b->{rrtype}}//99) |
127 } map { $_->{rrset} } @_; |
129 } map { $_->{rrset} } @_; |
128 |
130 |
129 my @out; |
131 my @out; |
130 my $origin = (grep { $_->{rrtype} eq 'SOA' } @zone)[0]->{label}; |
132 my $origin = (grep { $_->{rrtype} eq 'SOA' } @zone)[0]->{label}; |
131 my $ttl = (grep { $_->{rrtype} eq 'SOA' } @zone)[0]->{ttl}; |
133 my $ttl = (grep { $_->{rrtype} eq 'SOA' } @zone)[0]->{ttl}; |
132 my $l1 = (sort map { index $_->{label}, '.' } @zone)[-1]; |
134 my $len1 = (sort map { index $_->{label}, '.' } @zone)[-1]; |
133 my $l2 = (sort map { length $_->{rrtype} } @zone)[-1]; |
135 my $len2 = (sort map { length $_->{rrtype} } @zone)[-1]; |
134 push @out, "\$ORIGIN $origin", "\$TTL " . ttl2h($ttl); |
136 push @out, "\$ORIGIN $origin", "\$TTL " . ttl2h($ttl); |
135 |
137 |
136 my $print = sub { |
138 my $print = sub { |
137 my %r = %{ +shift }; |
139 my %r = %{ +shift }; |
138 state $last_label; |
140 state $last_label; |
145 if (defined $last_label and $r{label} eq $last_label) { '' } |
147 if (defined $last_label and $r{label} eq $last_label) { '' } |
146 else { $last_label = $r{label} } |
148 else { $last_label = $r{label} } |
147 }; |
149 }; |
148 |
150 |
149 return sprintf '%-*s %6s %-*s %s', |
151 return sprintf '%-*s %6s %-*s %s', |
150 $l1 => $r{label}, |
152 $len1 => $r{label}, |
151 $r{ttl}, |
153 $r{ttl}, |
152 $l2 => $r{rrtype}, |
154 $len2 => $r{rrtype}, |
153 $r{data}; |
155 $r{data}; |
154 }; |
156 }; |
155 push @out, $print->($_) foreach @zone; |
157 push @out, $print->($_) foreach @zone; |
156 return join "\n", @out; |
158 return join "\n", @out; |
157 } |
159 } |