# HG changeset patch
# User Heiko Schlittermann (JUMPER) <hs@schlittermann.de>
# Date 1422392122 -3600
# Node ID e0c8ae0169e47e6c8a8873c2f5cee8dc5069126e
# Parent  ce0fa0e7c89825744e0e1cb348550db17592500b
added more option to confirmation dialog

diff -r ce0fa0e7c898 -r e0c8ae0169e4 Build.PL
--- a/Build.PL	Tue Jan 27 20:03:08 2015 +0100
+++ b/Build.PL	Tue Jan 27 21:55:22 2015 +0100
@@ -7,5 +7,6 @@
     script_files => ['bin/dnsvi'],
     requires => {
 	perl => 5.010,
+	'Term::ReadKey' => '0',
     }
 )->create_build_script;
diff -r ce0fa0e7c898 -r e0c8ae0169e4 bin/dnsvi
--- a/bin/dnsvi	Tue Jan 27 20:03:08 2015 +0100
+++ b/bin/dnsvi	Tue Jan 27 21:55:22 2015 +0100
@@ -1,16 +1,16 @@
 #! /usr/bin/perl
 #line 3
-# Copyright: (C) 2014-2014 Heiko Schlittermann <hs@schlittermann>
+# Copyright: (C) 2014-2015 Heiko Schlittermann <hs@schlittermann>
 # This program is released unter the Terms of the GPL.
-use 5.010;
+use 5.10.1;
 use strict;
 use warnings;
-use if $ENV{DEBUG} // '' eq 'dnsvi' => 'Smart::Comments';
+use if $ENV{DEBUG} => 'Smart::Comments';
 use Getopt::Long;
 use Pod::Usage;
 use File::Copy;
 
-#use blib;
+use experimental 'smartmatch';
 use DNS::Vi;
 
 sub slurp {
@@ -55,14 +55,25 @@
 
     my @zone1 = parse($_ = `@dig`, { -skip => $o{skip} })
       or die "Empty zone\n";
-    my $fh2;
-    my @zone2 = do {
+
+  UNDO:
+    my @zone2 = @zone1;
+    my $backup;    # it's a tmp file containing the original
+
+  EDIT:
+    @zone2 = do {
         if (my $file = shift @ARGV) {
             parse(slurp($file), { -skip => $o{skip} });
         }
         else {
-            edit(@zone1,
-                { -skip => $o{skip}, -editor => $o{editor}, -backup => \$fh2 });
+            edit(
+                @zone2,
+                {
+                    -skip   => $o{skip},
+                    -editor => $o{editor},
+                    -backup => \$backup
+                }
+            );
         }
     };
     ### @zone2
@@ -73,15 +84,48 @@
         return 0;
     }
 
-    say 'The following changes need your confirmation.';
-    say join "\n", show(@delta{qw/add del/});
-    print 'confirm (yes|NO): ';
-    return 1 if <STDIN> !~ /^y/i;
+  VIEW:
+    if ($_ eq 'v' or (map { @{$_} } values %delta) < 10) {
+        say 'The following changes need your confirmation.';
+        say join "\n", show(@delta{qw/add del/});
+    }
+    else {
+        say 'added: ', 0 + @{ $delta{add} }, ', removed: ',
+          0 + @{ $delta{del} };
+    }
+  CONFIRM:
+    print 'action [yqQvVeu?] ?';
+    $_ = get_key;
 
-    update(
+    given ($_) {
+        when ('y') { }
+	when ('q') { }
+	when ('V') { }
+        when ('Q') { return 1 }
+        when ('e') { goto EDIT }
+        when ('v') { goto VIEW }
+        when ('u') { goto UNDO }
+        when ('?') {
+            print <<_;
+  y -- yes: submit changes and exit
+  q -- quit: save changes as ",dnsvi-$$"
+  Q -- quit: discard changes and exit
+  v -- view changes
+  V -- view changes as nsupdate commands
+  e -- edit again
+  u -- undo and edit again
+  ? -- what?
+_
+            goto CONFIRM;
+        }
+        default { goto CONFIRM }
+    }
+
+    /^[yV]$/ and update(
         \@zone1,
         @delta{qw/add del/},
         {
+	    $_ eq 'V' ? (-dry => 1) : (),
             -server => $o{server},
             -local  => $o{local},
             -debug  => $o{debug},
@@ -89,11 +133,12 @@
         }
       )
       or do {
-        copy($fh2->filename, ",dnsvi-$$")
-          and say "Saved as ',dnsvi-$$'"
-          if $fh2;
+	  copy($backup->filename, ",dnsvi-$$")
+          and say "Saved as ',dnsvi-$$'";
       };
 
+    goto CONFIRM if $_ eq 'V';
+
     return 0;
 }
 
diff -r ce0fa0e7c898 -r e0c8ae0169e4 lib/DNS/Vi.pm
--- a/lib/DNS/Vi.pm	Tue Jan 27 20:03:08 2015 +0100
+++ b/lib/DNS/Vi.pm	Tue Jan 27 21:55:22 2015 +0100
@@ -5,15 +5,15 @@
 use if $ENV{DEBUG} // '' eq 'dnsvi' => 'Smart::Comments';
 use Digest::SHA qw(sha512_hex);
 use File::Temp;
+use Term::ReadKey;
 use base 'Exporter';
-no if $^V ge v5.16.0 => (warnings => 'experimental');
+use experimental 'smartmatch';
 
 #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 get_key);
 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);
 
@@ -22,7 +22,7 @@
 # input $arg - hash with options
 #       $data - a long string with the zone data
 sub parse {
-    my %arg   = %{ pop @_ } if ref $_[-1] eq 'HASH';
+    my %arg   = %{ pop @_ } if ref $_[-1] eq ref {};
     my $data  = shift;
     my @lines = split /\n/, $data;
 
@@ -31,17 +31,17 @@
 
     $_ = '';
     foreach (@lines) {
-        s{;.*$}{};  # strip trailing comments
-	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
+        s{;.*$}{};    # strip trailing comments
+        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 }
@@ -80,14 +80,16 @@
                     # origin steht im SOA
                     when ('SOA') {
                         $origin = $rrset{label};
-			my ($primary, $hostmaster, $serial, $refresh, $retry, $expire, $minttl)
-			    = split ' ', $rrset{data};
+                        my ($primary, $hostmaster, $serial, $refresh, $retry,
+                            $expire, $minttl)
+                          = split ' ', $rrset{data};
 
-			$_ .= ".$origin"
-			    foreach grep !/\.$/ => $primary, $hostmaster;
+                        $_ .= ".$origin" foreach grep !/\.$/ => $primary,
+                          $hostmaster;
 
-			$rrset{data} = join ' ',
-			    $primary, $hostmaster, $serial, map { h2ttl } $refresh, $retry, $expire, $minttl;
+                        $rrset{data} = join ' ',
+                          $primary, $hostmaster, $serial,
+                          map { h2ttl } $refresh, $retry, $expire, $minttl;
                     }
 
                     # bei einigen RRs müssen wir die Daten korrigieren
@@ -97,9 +99,10 @@
                           unless substr($rrset{data}, -1) eq '.';
                     }
                 }
-                my $id = sha512_hex(join "\0", map { $_ => $rrset{$_} } sort keys %rrset);
+                my $id = sha512_hex(join "\0",
+                    map { $_ => $rrset{$_} } sort keys %rrset);
                 push @zone, { id => $id, rrset => \%rrset };
-		### x: $zone[-1]
+                ### x: $zone[-1]
             }
         }
     }
@@ -145,41 +148,42 @@
     # 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} } @_;
+      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];
+      (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;
+        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} }
-	};
+        $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};
+        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;
@@ -204,12 +208,14 @@
 }
 
 sub edit {
-    my %arg = %{ pop @_ } if ref $_[-1] eq 'HASH';
+    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->flush();
+
     system $arg{-editor} => $tmp->filename;
     $tmp->seek(0, 0);
     ${ $arg{-backup} } = $tmp if $arg{-backup};
@@ -223,7 +229,7 @@
 }
 
 sub update {
-    my %arg = %{ pop @_ } if ref $_[-1] eq 'HASH';
+    my %arg = %{ pop @_ } if ref $_[-1] eq ref {};
     my ($zone1, $add, $del) = @_;
 
     my $orig_soa =
@@ -234,10 +240,12 @@
         "prereq yxrrset @{$orig_soa}{qw{label rrtype data}}",
         (map { "update delete $_" } @$del),
         (map { "update add $_" } @$add),
-        'show',
         'send',
         'answer',
     );
+    if ($arg{-dry}) {
+	return say join "\n", '', @cmds, ''  if $arg{-dry};
+    }
     my @nsupdate = (
         'nsupdate',
         defined $arg{-debug} ? ('-d') : (),
@@ -263,4 +271,13 @@
 
 }
 
+sub get_key {
+    ReadMode 'cbreak';
+    local $/ = \1;
+    my $x = <STDIN>;
+    ReadMode 'restore';
+    print "\n";
+    return $x;
+}
+
 1;