diff -r 9069ce49fd83 -r 140d7537105e lib/DNS/Vi.pm
--- a/lib/DNS/Vi.pm	Thu Jul 14 10:30:58 2016 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,317 +0,0 @@
-package DNS::Vi;
-use 5.0101;
-use strict;
-use warnings;
-use if $ENV{DEBUG} // '' eq 'dnsvi' => 'Smart::Comments';
-use Digest::SHA qw(sha512_hex);
-use File::Temp;
-use Net::DNS;
-use Term::ReadKey;
-use base 'Exporter';
-use if $] >= 5.020, experimental => 'smartmatch';
-
-our @EXPORT = qw(ttl2h h2ttl parse delta nice edit update show get_key
-  get_auth_info);
-our @EXPORT_OK = ();
-
-# the sort order for the records of the same label
-my %ORDER = map { state $n = 0; $_ => ++$n } qw(SOA NS TXT MX A AAAA SSHFP);
-
-sub h2ttl(_);
-
-# input $arg - hash with options
-#       $data - a long string with the zone data
-sub parse {
-    my %arg   = %{ pop @_ } if ref $_[-1] eq ref {};
-    my $data  = shift;
-    my @lines = split /\n/, $data;
-
-    my @zone;
-    my ($origin, $ttl, $last_label, $soa_seen);
-
-    $_ = '';
-    foreach (@lines) {
-	# simplificated comment remover
-	# after the comment character no '"' is allowed!
-#        s{^\s*;.*$}{};		  # strip comment lines
-#	s{\s*;[^"]*$}{};	  # strip trailing comments
-
-	# see https://regex101.com/r/cG6fK3/2
- 	s{\s*(?:;)(?:(?:[^"]|"[^"]*")*$)}{};
-        state $line;
-        if (my $range = /(.*)\(\s*$/ .. /(.*)\)\s*/) {
-            $line .= defined $1 ? $1 : $_;
-            next unless $range =~ /E0$/;
-        }
-        if (defined $line) {
-            $_    = $line;    # accumulated continuation line
-            $line = undef;
-        }
-        s{\s*$}{};            # strip off trailing spaces
-        given ($_) {
-            when (m{^\s*$})                { next }
-            when (m{^\s*\$ORIGIN\s+(\S+)}) { $origin = $1 }
-            when (m{^\s*\$TTL\s+(\S+)})    { $ttl = $1 }
-            when (
-                m{^(?:(?<label>\S+)(?=\s))?
-		    (?:\s+(?<ttl>\d[\dwdmhs]*(?=\s+)))?
-		    (?:\s+(?:(?:IN|ANY)\s+)?(?<rrtype>[a-z]\S*(?=\s+)))
-		    \s+(?<data>.*)
-		  }ix
-              )
-            {
-                my %rrset = (
-                    label => $last_label =
-                      defined $+{label}
-                    ? $+{label} eq '@'
-                          ? $origin
-                          : $+{label}
-                    : $last_label,
-                      ttl => h2ttl($+{ttl} // $ttl),
-                      rrtype => uc $+{rrtype},
-                      data   => $+{data},
-                );
-                next if $rrset{rrtype} ~~ $arg{-skip};
-
-                if ($rrset{rrtype} eq 'SOA') {
-                    next if $soa_seen++;
-                }
-
-                # label ergänzen, wenn nicht FQDN
-                $rrset{label} .= ".$origin"
-                  unless substr($rrset{label}, -1) eq '.';
-
-                given ($rrset{rrtype}) {
-
-                    # origin steht im SOA
-                    when ('SOA') {
-                        $origin = $rrset{label};
-                        my ($primary, $hostmaster, $serial, $refresh, $retry,
-                            $expire, $minttl)
-                          = split ' ', $rrset{data};
-
-                        $_ .= ".$origin" foreach grep !/\.$/ => $primary,
-                          $hostmaster;
-
-                        $rrset{data} = join ' ',
-                          $primary, $hostmaster, $serial,
-                          map { h2ttl } $refresh, $retry, $expire, $minttl;
-                    }
-
-                    # bei einigen RRs müssen wir die Daten korrigieren
-                    when ([qw/CNAME MX NS PTR SOA/]) {
-                        $rrset{data} =~ s/\@/$origin/g;
-                        $rrset{data} .= ".$origin"
-                          unless substr($rrset{data}, -1) eq '.';
-                    }
-                }
-                my $id = sha512_hex(join "\0",
-                    map { $_ => $rrset{$_} } sort keys %rrset);
-                push @zone, { id => $id, rrset => \%rrset };
-                ### x: $zone[-1]
-            }
-        }
-    }
-
-    return @zone;
-}
-
-sub ttl2h {
-    my $seconds = shift;
-    my @out;
-    my @units = ([w => 604800], [d => 86400], [h => 3600], [m => 60], [s => 1]);
-
-    foreach (@units) {
-        my $x = int($seconds / $_->[1]);
-        push @out, "$x$_->[0]" if $x;
-        $seconds %= $_->[1] or last;
-    }
-
-    return join '', @out;
-}
-
-sub h2ttl(_) {
-    my $ttl = shift;
-    my $out;
-    my %factor = (
-        w => 604800,
-        d => 86400,
-        h => 3600,
-        m => 60,
-        s => 1,
-    );
-
-    while ($ttl =~ m{(\d+)([wdhms])}g) {
-        $out += $1 * $factor{$2};
-    }
-
-    return $out // $ttl;
-}
-
-sub nice {
-
-    # 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 @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);
-
-    my $print = sub {
-        my %r = %{ +shift };
-        state $last_label;
-
-        $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, '; IF YOU EDIT the SOA record, INCREASE the serial number too!';
-    push @out, $print->($_) foreach @zone;
-    return join "\n", @out, '';
-}
-
-sub delta {
-    my ($zone1, $zone2) = @_;
-    my %zone1 = map { $_->{id}, $_->{rrset} } @$zone1;
-    my %zone2 = map { $_->{id}, $_->{rrset} } @$zone2;
-    my @keys1 = keys %zone1;
-    my @keys2 = keys %zone2;
-    delete @zone1{@keys2};
-    delete @zone2{@keys1};
-
-    my (@add, @del);
-    push @add, "@{$_}{qw/label ttl rrtype data/}" foreach values %zone2;
-    push @del, "@{$_}{qw/label ttl rrtype data/}" foreach values %zone1;
-
-    return () if (!@add and !@del);
-    return (add => \@add, del => \@del);
-}
-
-sub edit {
-    my %arg = %{ pop @_ } if ref $_[-1] eq ref {};
-    my @zone = @_;
-
-    # first make a backup copy
-    my $tmp = File::Temp->new();
-    $tmp->print(nice @zone);
-    $tmp->say('; vim:tw=0:');
-    $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} });
-}
-
-sub show {
-    my ($add, $del) = @_;
-    my @out = ((map { " - $_ " } @$del), (map { " + $_ " } @$add));
-    return @out;
-}
-
-sub update {
-    my %arg = %{ pop @_ } if ref $_[-1] eq ref {};
-    my ($zone1, $add, $del) = @_;
-
-    my $orig_soa =
-      (grep { $_->{rrtype} eq 'SOA' } map { $_->{rrset} } @$zone1)[0];
-
-    my @cmds = (
-        $arg{-local} ? () : "server $arg{-server}",
-        "prereq yxrrset @{$orig_soa}{qw{label rrtype data}}",
-        (map { "update delete $_" } @$del),
-        (map { "update add $_" } @$add),
-        'send',
-        'answer',
-    );
-    if ($arg{-dry}) {
-        return say join "\n", '', @cmds, '' if $arg{-dry};
-    }
-    my @nsupdate = (
-        'nsupdate',
-        defined $arg{-debug} ? ('-d') : (),
-        defined $arg{-key} ? (-k => $arg{-key}) : (),
-        defined $arg{-local} ? ('-l') : (),
-    );
-
-    open(my $nsupdate, '|-') or do {
-        exec @nsupdate;
-        die "Can't exec @nsupdate: $!\n";
-    };
-    say $nsupdate join "\n", @cmds;
-    close($nsupdate);
-    say "nsupdate returned $?";
-    return $? ? undef : 1;
-}
-
-sub save {
-    my ($zone, $file) = @_;
-    open(my $fh, '>', $file) or die "Can't open >$file: $!\n";
-    print $fh nice @$zone;
-    close($fh);
-
-}
-
-sub get_key {
-    ReadMode 'cbreak';
-    local $/ = \1;
-    my $x = <STDIN>;
-    ReadMode 'restore';
-    print "\n";
-    return $x;
-}
-
-sub get_auth_info {
-    my $name = shift;
-    my $server = shift;
-    my %auth = (zone => undef, master => undef);
-    state $resolver = Net::DNS::Resolver->new(
-        defined $server ? (nameservers => [$server]) : ()
-    );
-    my $response = $resolver->send($name, 'SOA')
-      or die $resolver->errorstring, "\n";
-
-    #    use Data::Dumper;
-    #    die Dumper $response;
-
-    if (my @soa = grep { $_->type eq 'SOA' } $response->answer,
-        $response->authority)
-    {
-        die "got multiple soa records\n" if @soa > 1;
-        my $soa = $soa[0];
-        return (
-            name  => $soa->name,
-            mname => $soa->mname,
-        );
-    }
-
-    return $response->authority;
-}
-
-1;