prompt for confirmation on mapping --delete

metacpan · May 19, 2016 · 64f0232 · 64f0232
1 parent c022205
commit 64f0232
Show file tree

Hide file tree

Showing 3 changed files with 42 additions and 0 deletions.
diff --git a/cpanfile b/cpanfile
@@ -70,6 +70,7 @@ requires 'HTTP::Request::Common';
 requires 'Hash::Merge::Simple';
 requires 'IO::All';
 requires 'IO::Interactive';
+requires 'IO::Prompt';
 requires 'IO::String';
 requires 'IO::Uncompress::Bunzip2';
 requires 'IO::Zlib';

diff --git a/cpanfile.snapshot b/cpanfile.snapshot
@@ -3630,6 +3630,18 @@ DISTRIBUTIONS
       File::Spec::Functions 0
       perl 5.008
       version 0.78
+  IO-Prompt-0.997003
+    pathname: D/DC/DCONWAY/IO-Prompt-0.997003.tar.gz
+    provides:
+      IO::Prompt 0.997003
+      IO::Prompt::ReturnVal 0.997003
+    requirements:
+      IO::Handle 0
+      POSIX 0
+      Term::ReadKey 0
+      Test::More 0
+      Want 0
+      version 0
   IO-Socket-IP-0.37
     pathname: P/PE/PEVANS/IO-Socket-IP-0.37.tar.gz
     provides:
@@ -7833,6 +7845,12 @@ DISTRIBUTIONS
       ExtUtils::CBuilder 0
       ExtUtils::MakeMaker 0
       Test::More 0
+  TermReadKey-2.33
+    pathname: J/JS/JSTOWE/TermReadKey-2.33.tar.gz
+    provides:
+      Term::ReadKey 2.33
+    requirements:
+      ExtUtils::MakeMaker 0
   Test-Aggregate-0.373
     pathname: R/RW/RWSTAUNER/Test-Aggregate-0.373.tar.gz
     provides:
@@ -8905,6 +8923,12 @@ DISTRIBUTIONS
       Fcntl 0
       URI 1.10
       perl 5.008001
+  Want-0.29
+    pathname: R/RO/ROBIN/Want-0.29.tar.gz
+    provides:
+      Want 0.29
+    requirements:
+      ExtUtils::MakeMaker 0
   XML-NamespaceSupport-1.11
     pathname: P/PE/PERIGRIN/XML-NamespaceSupport-1.11.tar.gz
     provides:

diff --git a/lib/MetaCPAN/Script/Mapping.pm b/lib/MetaCPAN/Script/Mapping.pm
@@ -6,6 +6,9 @@ use warnings;
 use Log::Contextual qw( :log );
 use Moose;
 use MetaCPAN::Types qw( Bool );
+use Term::ANSIColor qw( colored );
+use IO::Interactive qw( is_interactive );
+use IO::Prompt;
 
 with 'MetaCPAN::Role::Script', 'MooseX::Getopt';
 
@@ -18,6 +21,20 @@ has delete => (
 
 sub run {
     my $self = shift;
+    if (is_interactive) {
+        print colored(
+            ['bold red'],
+            '*** Warning ***: this will delete EVERYTHING and re-create the (empty) indexes'
+            ),
+            "\n";
+        my $answer = prompt
+            'Are you sure you want to do this (type "YES" to confirm) ? ';
+        if ( $answer ne 'YES' ) {
+            print "bye.\n";
+            exit 0;
+        }
+        print "alright then...\n";
+    }
     log_info {"Putting mapping to ElasticSearch server"};
     $self->model->deploy( delete => $self->delete );
 }