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

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

Author: randys
Date: Thu Apr  6 21:16:01 2006
New Revision: 5870

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

Log:
Don't require default argument to y_n() unless $ENV{PERL_MM_USE_DEFAULT} is set.

Modified: Module-Build/trunk/Changes
==============================================================================
--- Module-Build/trunk/Changes	(original)
+++ Module-Build/trunk/Changes	Thu Apr  6 21:16:01 2006
@@ -2,6 +2,12 @@
 
 0.27_11
 
+ - Backing out a requirement added in 0.27_06 on the method y_n()
+   to always include a default. This behavior would cause existing
+   build scripts to start failing. We now fail with a missing default
+   only when $ENV{PERL_MM_USE_DEFAULT} is set because there is no
+   reasonable default.
+
  - Make install_types() method smarter with respect to custom install
    types.
 

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	Thu Apr  6 21:16:01 2006
@@ -463,17 +463,9 @@
   return -t STDIN && (-t STDOUT || !(-f STDOUT || -c STDOUT)) ;   # Pipe?
 }
 
-sub prompt {
+sub _readline {
   my $self = shift;
-  my ($mess, $def) = @_;
-  die "prompt() called without a prompt message" unless @_;
-  
-  ($def, my $dispdef) = defined $def ? ($def, "[$def] ") : ('', ' ');
 
-  {
-    local $|=1;
-    print "$mess $dispdef";
-  }
   my $ans;
   if ( ! $ENV{PERL_MM_USE_DEFAULT} &&
        ( $self->_is_interactive || ! eof STDIN ) ) {
@@ -484,21 +476,42 @@
       print "\n";
     }
   }
-  
+
+  return $ans;
+}
+
+sub prompt {
+  my $self = shift;
+  my ($mess, $def) = @_;
+  die "prompt() called without a prompt message" unless @_;
+
+  ($def, my $dispdef) = defined $def ? ($def, "[$def] ") : ('', ' ');
+
+  {
+    local $|=1;
+    print "$mess $dispdef";
+  }
+  my $ans = $self->_readline();
+
   unless (defined($ans) and length($ans)) {
     print "$def\n";
     $ans = $def;
   }
-  
+
   return $ans;
 }
 
 sub y_n {
   my $self = shift;
   die "y_n() called without a prompt message" unless @_;
-  die "y_n() called without y or n default" unless ($_[1]||"")=~/^[yn]/i;
 
-  my $interactive = $self->_is_interactive;
+  unless ( $ENV{PERL_MM_USE_DEFAULT} && ($_[1]||"")=~/^[yn]/i ) {
+    die <<EOF;
+ERROR: The y_n() prompt requires a default arguemnt to run safely
+for unattended or automated installs. Please inform the author.
+EOF
+  }
+
   my $answer;
   while (1) {
     $answer = $self->prompt(@_);

Modified: Module-Build/trunk/t/extend.t
==============================================================================
--- Module-Build/trunk/t/extend.t	(original)
+++ Module-Build/trunk/t/extend.t	Thu Apr  6 21:16:01 2006
@@ -2,7 +2,7 @@
 
 use strict;
 use lib $ENV{PERL_CORE} ? '../lib/Module/Build/t/lib' : 't/lib';
-use MBTest tests => 53;
+use MBTest tests => 57;
 
 use Cwd ();
 my $cwd = Cwd::cwd;
@@ -204,6 +204,24 @@
   is_deeply $data{conflicts}, {'Foo::Bazxx' => 0, 'Foo::Fooxx' => 0};
 }
 
+{
+  # Test interactive prompting
+  local $ENV{PERL_MM_USE_DEFAULT} = 1;
+
+  ok my $mb = Module::Build->new(
+				  module_name => $dist->name,
+				  license => 'perl',
+			        );
+
+  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("Is this a question?") };
+  like $@, qr/ERROR:/, 'Do not allow y_n() prompts for unattended builds';
+}
 
 # cleanup
 chdir( $cwd ) or die "Can''t chdir to '$cwd': $!";