Permalink
Browse files

add prompter role

  • Loading branch information...
1 parent 58c34ce commit fd506785c8055664663d0d0bb8a5c9947a471584 @jberger committed Nov 16, 2012
Showing with 157 additions and 0 deletions.
  1. +78 −0 lib/Moodule/Build/Role/Prompter.pm
  2. +79 −0 t/prompt.t
@@ -0,0 +1,78 @@
+package Moodule::Build::Role::Prompter;
+
+use Moo::Role;
+
+sub _is_interactive {
+ return -t STDIN && (-t STDOUT || !(-f STDOUT || -c STDOUT)) ; # Pipe?
+}
+
+# NOTE this is a blocking operation if(-t STDIN)
+sub _is_unattended {
+ my $self = shift;
+ return $ENV{PERL_MM_USE_DEFAULT} ||
+ ( !$self->_is_interactive && eof STDIN );
+}
+
+sub _readline {
+ my $self = shift;
+ return undef if $self->_is_unattended;
+
+ my $answer = <STDIN>;
+ chomp $answer if defined $answer;
+ return $answer;
+}
+
+sub prompt {
+ my $self = shift;
+ my $mess = shift
+ or die "prompt() called without a prompt message";
+
+ # use a list to distinguish a default of undef() from no default
+ my @def;
+ @def = (shift) if @_;
+ # use dispdef for output
+ my @dispdef = scalar(@def) ?
+ ('[', (defined($def[0]) ? $def[0] . ' ' : ''), ']') :
+ (' ', '');
+
+ local $|=1;
+ print "$mess ", @dispdef;
+
+ if ( $self->_is_unattended && !@def ) {
+ die <<EOF;
+ERROR: This build seems to be unattended, but there is no default value
+for this question. Aborting.
+EOF
+ }
+
+ my $ans = $self->_readline();
+
+ if ( !defined($ans) # Ctrl-D or unattended
+ or !length($ans) ) { # User hit return
+ print "$dispdef[1]\n";
+ $ans = scalar(@def) ? $def[0] : '';
+ }
+
+ return $ans;
+}
+
+sub y_n {
+ my $self = shift;
+ my ($mess, $def) = @_;
+
+ die "y_n() called without a prompt message" unless $mess;
+ die "Invalid default value: y_n() default must be 'y' or 'n'"
+ if $def && $def !~ /^[yn]/i;
+
+ my $answer;
+ while (1) { # XXX Infinite or a large number followed by an exception ?
+ $answer = $self->prompt(@_);
+ return 1 if $answer =~ /^y/i;
+ return 0 if $answer =~ /^n/i;
+ local $|=1;
+ print "Please answer 'y' or 'n'.\n";
+ }
+}
+
+1;
+
View
@@ -0,0 +1,79 @@
+use strict;
+use warnings;
+no warnings 'redefine';
+
+use Test::More;
+
+{
+ package MyTestClass;
+ use Moo;
+ with 'Moodule::Build::Role::Prompter';
+}
+
+ # Test interactive prompting
+
+ my $ans;
+ local $ENV{PERL_MM_USE_DEFAULT};
+
+ local $^W = 0;
+ local *{MyTestClass::_readline} = sub { 'y' };
+
+ ok my $mb = MyTestClass->new();
+
+ eval{ $mb->prompt() };
+ like $@, qr/called without a prompt/, 'prompt() requires a prompt';
+
+ eval{ $mb->y_n() };
+ like $@, qr/called without a prompt/, 'y_n() requires a prompt';
+
+ eval{ $mb->y_n('Prompt?', 'invalid default') };
+ like $@, qr/Invalid default/, "y_n() requires a default of 'y' or 'n'";
+
+
+ $ENV{PERL_MM_USE_DEFAULT} = 1;
+
+ eval{ $mb->y_n('Is this a question?') };
+ print "\n"; # fake <enter> because the prompt prints before the checks
+ like $@, qr/ERROR:/,
+ 'Do not allow default-less y_n() for unattended builds';
+
+ eval{ $ans = $mb->prompt('Is this a question?') };
+ print "\n"; # fake <enter> because the prompt prints before the checks
+ like $@, qr/ERROR:/,
+ 'Do not allow default-less prompt() for unattended builds';
+
+
+ # When running Test::Smoke under a cron job, STDIN will be closed which
+ # will fool our _is_interactive() method causing various failures.
+ {
+ local *{MyTestClass::_is_interactive} = sub { 1 };
+
+ $ENV{PERL_MM_USE_DEFAULT} = 0;
+
+ $ans = $mb->prompt('Is this a question?');
+ print "\n"; # fake <enter> after input
+ is $ans, 'y', "prompt() doesn't require default for interactive builds";
+
+ $ans = $mb->y_n('Say yes');
+ print "\n"; # fake <enter> after input
+ ok $ans, "y_n() doesn't require default for interactive build";
+
+
+ # Test Defaults
+ *{MyTestClass::_readline} = sub { '' };
+
+ $ans = $mb->prompt("Is this a question");
+ is $ans, '', "default for prompt() without a default is ''";
+
+ $ans = $mb->prompt("Is this a question", 'y');
+ is $ans, 'y', " prompt() with a default";
+
+ $ans = $mb->y_n("Is this a question", 'y');
+ ok $ans, " y_n() with a default";
+
+ my @ans = $mb->prompt("Is this a question", undef);
+ is_deeply([@ans], [undef], " prompt() with undef() default");
+ }
+
+done_testing;
+

0 comments on commit fd50678

Please sign in to comment.