lib/DNS/Vi.pm
branchdeb
changeset 53 908e41fe9b30
parent 33 7d0fac2ec585
child 60 34d98030d4c0
--- 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;