[Module-build-checkins] [svn:Module-Build] r5871 - in Module-Build/trunk: lib/Module/Build t

[<ra...@cv...>]

Author: randys
Date: Fri Apr  7 03:03:53 2006
New Revision: 5871

Modified:
   Module-Build/trunk/lib/Module/Build/Base.pm
   Module-Build/trunk/t/extend.t

Log:
More cleanup of interactive prompting along with tests.

Modified: Module-Build/trunk/lib/Module/Build/Base.pm
==============================================================================
--- Module-Build/trunk/lib/Module/Build/Base.pm	(original)
+++ Module-Build/trunk/lib/Module/Build/Base.pm	Fri Apr  7 03:03:53 2006
@@ -470,11 +470,7 @@
   if ( ! $ENV{PERL_MM_USE_DEFAULT} &&
        ( $self->_is_interactive || ! eof STDIN ) ) {
     $ans = <STDIN>;
-    if ( defined $ans ) {
-      chomp $ans;
-    } else { # user hit ctrl-D
-      print "\n";
-    }
+    chomp $ans if defined $ans;
   }
 
   return $ans;
@@ -483,17 +479,19 @@
 sub prompt {
   my $self = shift;
   my ($mess, $def) = @_;
-  die "prompt() called without a prompt message" unless @_;
+
+  die "prompt() called without a prompt message" unless $mess;
 
   ($def, my $dispdef) = defined $def ? ($def, "[$def] ") : ('', ' ');
 
-  {
-    local $|=1;
-    print "$mess $dispdef";
-  }
+  local $|=1;
+  print "$mess $dispdef";
+
   my $ans = $self->_readline();
 
-  unless (defined($ans) and length($ans)) {
+  if ( !defined($ans) ) {     # Ctrl-D
+    print "\n";
+  } elsif ( !length($ans) ) { # Default
     print "$def\n";
     $ans = $def;
   }
@@ -503,9 +501,13 @@
 
 sub y_n {
   my $self = shift;
-  die "y_n() called without a prompt message" unless @_;
+  my ($mess, $def)  = @_;
 
-  unless ( $ENV{PERL_MM_USE_DEFAULT} && ($_[1]||"")=~/^[yn]/i ) {
+  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;
+
+  if ( $ENV{PERL_MM_USE_DEFAULT} && !$def ) {
     die <<EOF;
 ERROR: The y_n() prompt requires a default arguemnt to run safely
 for unattended or automated installs. Please inform the author.
@@ -513,10 +515,11 @@
   }
 
   my $answer;
-  while (1) {
+  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";
   }
 }

Modified: Module-Build/trunk/t/extend.t
==============================================================================
--- Module-Build/trunk/t/extend.t	(original)
+++ Module-Build/trunk/t/extend.t	Fri Apr  7 03:03:53 2006
@@ -2,7 +2,7 @@
 
 use strict;
 use lib $ENV{PERL_CORE} ? '../lib/Module/Build/t/lib' : 't/lib';
-use MBTest tests => 57;
+use MBTest tests => 64;
 
 use Cwd ();
 my $cwd = Cwd::cwd;
@@ -206,7 +206,12 @@
 
 {
   # Test interactive prompting
-  local $ENV{PERL_MM_USE_DEFAULT} = 1;
+
+  my $ans;
+  local $ENV{PERL_MM_USE_DEFAULT};
+
+  local $^W = 0;
+  *{Module::Build::_readline} = sub { 'y' };
 
   ok my $mb = Module::Build->new(
 				  module_name => $dist->name,
@@ -219,8 +224,42 @@
   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?") };
   like $@, qr/ERROR:/, 'Do not allow y_n() prompts for unattended builds';
+
+  $ans = $mb->prompt('Is this a question?');
+  print "\n"; # fake <enter> after input
+  is $ans, 'y', "prompt() doesn't require default for unattended builds";
+
+
+  $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
+  *{Module::Build::_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";
 }
 
 # cleanup