# HG changeset patch # User Heiko Schlittermann (JUMPER) # Date 1418030575 -3600 # Node ID 908e41fe9b3019a4c302c1cbddafd62c9bdfe966 # Parent 5040471ee5ab179ce7d171f9fb6f1155badbeb4b Changed the sort order. When displaying the zone we sort in a way where same domains are kept together with their subdomains. We do this by reverting the label and sorting these reverted labels. diff -r 5040471ee5ab -r 908e41fe9b30 lib/DNS/Vi.pm --- a/lib/DNS/Vi.pm Fri Nov 14 11:41:32 2014 +0100 +++ b/lib/DNS/Vi.pm Mon Dec 08 10:22:55 2014 +0100 @@ -2,19 +2,20 @@ use 5.010; use strict; use warnings; -use if $ENV{DEBUG}//'' eq 'dnsvi' => 'Smart::Comments'; +use if $ENV{DEBUG} // '' eq 'dnsvi' => 'Smart::Comments'; use Digest::SHA qw(sha512_hex); use File::Temp; use base 'Exporter'; no if $^V ge v5.16.0 => (warnings => 'experimental'); + #no if $warnings::Offset{'experimental'} => (warnings => 'experimental'); -our @EXPORT = qw(ttl2h h2ttl parse delta nice edit update show); +our @EXPORT = qw(ttl2h h2ttl parse delta nice edit update show); our @EXPORT_OK = (); sub parse { - my %arg = %{pop @_} if ref $_[-1] eq 'HASH'; - my $data = shift; + my %arg = %{ pop @_ } if ref $_[-1] eq 'HASH'; + my $data = shift; my @lines = split /\n/, $data; my @zone; @@ -45,7 +46,7 @@ rrtype => uc $+{rrtype}, data => $+{data}, ); - next if $rrset{rrtype} ~~ $arg{-skip}; + next if $rrset{rrtype} ~~ $arg{-skip}; if ($rrset{rrtype} eq 'SOA') { next if $soa_seen; @@ -71,7 +72,7 @@ # bei einigen RRs müssen wir die Daten korrigieren when ([qw/CNAME MX NS PTR SOA/]) { - $rrset{data} =~ s/\@/$origin/g; + $rrset{data} =~ s/\@/$origin/g; $rrset{data} .= ".$origin" unless substr($rrset{data}, -1) eq '.'; } @@ -123,49 +124,56 @@ } { - my %order = map { state $n = 0; $_ => ++$n } qw(SOA NS TXT MX A AAAA); -sub nice { + my %order = map { state $n = 0; $_ => ++$n } qw(SOA NS TXT MX A AAAA SSHFP); - # get a list of { id => $id, rrset => \%rrset } - my @zone = - sort { - length $a->{label} <=> length $b->{label} - or $a->{label} cmp $b->{label} - or ($order{$a->{rrtype}}//99) <=> ($order{$b->{rrtype}}//99) - } map { $_->{rrset} } @_; + sub nice { - my @out; - my $origin = (grep { $_->{rrtype} eq 'SOA' } @zone)[0]->{label}; - my $ttl = (grep { $_->{rrtype} eq 'SOA' } @zone)[0]->{ttl}; - my $len1 = (sort { $a <=> $b } map { index $_->{label}, '.' } @zone)[-1]; - my $len2 = (sort { $a <=> $b } map { length $_->{rrtype} } @zone)[-1]; - push @out, "\$ORIGIN $origin", "\$TTL " . ttl2h($ttl); + # get a list of { id => $id, rrset => \%rrset } + # we do a schwartz transformation here + # [ reverse LABEL, RRSET ] + my @zone = map { $_->[1] } + sort { + $a->[0] cmp $b->[0] + or length $a->[1]{label} <=> length $b->[1]{label} + or ($order{ $a->[1]{rrtype} } // 99) <=> ($order{ $b->[1]{rrtype} } // 99) + } + map { [scalar reverse($_->{label}), $_] } map { $_->{rrset} } @_; - my $print = sub { - my %r = %{ +shift }; - state $last_label; + my @out; + my $origin = (grep { $_->{rrtype} eq 'SOA' } @zone)[0]->{label}; + my $ttl = (grep { $_->{rrtype} eq 'SOA' } @zone)[0]->{ttl}; + my $len1 = + (sort { $a <=> $b } map { index $_->{label}, '.' } @zone)[-1]; + my $len2 = (sort { $a <=> $b } map { length $_->{rrtype} } @zone)[-1]; + push @out, "\$ORIGIN $origin", "\$TTL " . ttl2h($ttl); - $r{label} = '@' if $r{label} eq $origin; - $r{label} =~ s{\.\Q$origin\E$}{}; - $r{data} =~ s{\.\Q$origin\E$}{} if $r{rrtype} ~~ [qw(CNAME MX SOA PTR)]; - $r{data} =~ s{\Q$origin\E$}{\@} if $r{rrtype} ~~ [qw(CNAME MX)]; - $r{ttl} = $r{ttl} == $ttl ? '' : ttl2h($r{ttl}); - $r{label} = do { - if (defined $last_label and $r{label} eq $last_label) { '' } - else { $last_label = $r{label} } - }; + my $print = sub { + my %r = %{ +shift }; + state $last_label; - return sprintf '%-*s %6s %-*s %s', - $len1 => $r{label}, - $r{ttl}, - $len2 => $r{rrtype}, - $r{data}; - }; - push @out, '; do NOT EDIT the SOA records SERIAL number!'; - push @out, $print->($_) foreach @zone; - return join "\n", @out, ''; + $r{label} = '@' if $r{label} eq $origin; + $r{label} =~ s{\.\Q$origin\E$}{}; + $r{data} =~ s{\.\Q$origin\E$}{} + if $r{rrtype} ~~ [qw(CNAME MX SOA PTR)]; + $r{data} =~ s{\Q$origin\E$}{\@} if $r{rrtype} ~~ [qw(CNAME MX)]; + $r{ttl} = $r{ttl} == $ttl ? '' : ttl2h($r{ttl}); + $r{label} = do { + if (defined $last_label and $r{label} eq $last_label) { '' } + else { $last_label = $r{label} } + }; + + return sprintf '%-*s %6s %-*s %s', + $len1 => $r{label}, + $r{ttl}, + $len2 => $r{rrtype}, + $r{data}; + }; + push @out, '; do NOT EDIT the SOA records SERIAL number!'; + push @out, $print->($_) foreach @zone; + return join "\n", @out, ''; + } } -} + sub delta { my ($zone1, $zone2) = @_; my %zone1 = map { $_->{id}, $_->{rrset} } @$zone1; @@ -183,7 +191,7 @@ } sub edit { - my %arg = %{pop @_} if ref $_[-1] eq 'HASH'; + my %arg = %{ pop @_ } if ref $_[-1] eq 'HASH'; my @zone = @_; my $tmp = File::Temp->new(); @@ -191,21 +199,18 @@ $tmp->flush(); system $arg{-editor} => $tmp->filename; $tmp->seek(0, 0); - ${$arg{-backup}} = $tmp if $arg{-backup}; - return parse(do { local $/ = undef; <$tmp>}, {-skip => $arg{-skip}}); + ${ $arg{-backup} } = $tmp if $arg{-backup}; + return parse(do { local $/ = undef; <$tmp> }, { -skip => $arg{-skip} }); } sub show { my ($add, $del) = @_; - my @out = ( - (map { " - $_ " } @$del), - (map { " + $_ " } @$add), - ); + my @out = ((map { " - $_ " } @$del), (map { " + $_ " } @$add),); return @out; } sub update { - my %arg = %{pop @_} if ref $_[-1] eq 'HASH'; + my %arg = %{ pop @_ } if ref $_[-1] eq 'HASH'; my ($zone1, $add, $del) = @_; my $orig_soa = @@ -242,7 +247,7 @@ open(my $fh, '>', $file) or die "Can't open >$file: $!\n"; print $fh nice @$zone; close($fh); - + } 1;