Author: ericwilhelm
Date: Fri Mar 9 13:30:58 2007
New Revision: 9216
Modified:
Module-Build/trunk/Changes
Module-Build/trunk/lib/Module/Build/API.pod
Module-Build/trunk/lib/Module/Build/Base.pm
Module-Build/trunk/t/extend.t
Log:
t/extend.t - update for "prompt prints first",
check explicit undef() in prompt()
lib/Module/Build/Base.pm - rearranged "no default" strictures to happen just
before _readline(),
handling of explicit undef() in prompt()
lib/Module/Build/API.pod - clarified prompt()'s behavior
Modified: Module-Build/trunk/Changes
==============================================================================
--- Module-Build/trunk/Changes (original)
+++ Module-Build/trunk/Changes Fri Mar 9 13:30:58 2007
@@ -1,5 +1,8 @@
Revision history for Perl extension Module::Build.
+ - Added support for an explicit default value of undef in prompt().
+ [Eric Wilhelm]
+
- Improved our prompt() method, which could sometimes hang before the
user got a chance to see a prompt. [Andreas Koenig]
Modified: Module-Build/trunk/lib/Module/Build/API.pod
==============================================================================
--- Module-Build/trunk/lib/Module/Build/API.pod (original)
+++ Module-Build/trunk/lib/Module/Build/API.pod Fri Mar 9 13:30:58 2007
@@ -1421,10 +1421,15 @@
If C<prompt()> detects that it is not running interactively and there
is nothing on STDIN or if the PERL_MM_USE_DEFAULT environment variable
-is set to true, the $default will be used without prompting. This
-prevents automated processes from blocking on user input.
+is set to true, the $default will be used without prompting.
-If no $default is provided an empty string will be used instead.
+To prevent automated processes from blocking, the user must either set
+PERL_MM_USE_DEFAULT or attach something to STDIN (this can be a
+pipe/file containing a scripted set of answers or /dev/null.)
+
+If no $default is provided an empty string will be used instead. In
+non-interactive mode, the absence of $default is an error (though
+explicitly passing C<undef()> as the default is valid as of 0.27.)
This method may be called as a class or object method.
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 Mar 9 13:30:58 2007
@@ -469,10 +469,11 @@
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 && (-t STDIN || eof(STDIN)));
+ ( !$self->_is_interactive && eof STDIN );
}
sub _readline {
@@ -489,25 +490,30 @@
my $mess = shift
or die "prompt() called without a prompt message";
- my $def;
- if ( $self->_is_unattended && [EMAIL PROTECTED] ) {
+ # 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 && [EMAIL PROTECTED] ) {
die <<EOF;
ERROR: This build seems to be unattended, but there is no default value
for this question. Aborting.
EOF
}
- $def = shift if @_;
- ($def, my $dispdef) = defined $def ? ($def, "[$def] ") : ('', ' ');
-
- local $|=1;
- print "$mess $dispdef";
my $ans = $self->_readline();
if ( !defined($ans) # Ctrl-D or unattended
or !length($ans) ) { # User hit return
- print "$def\n";
- $ans = $def;
+ print "$dispdef[1]\n";
+ $ans = scalar(@def) ? $def[0] : '';
}
return $ans;
@@ -521,13 +527,6 @@
die "Invalid default value: y_n() default must be 'y' or 'n'"
if $def && $def !~ /^[yn]/i;
- 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 $answer;
while (1) { # XXX Infinite or a large number followed by an exception ?
$answer = $self->prompt(@_);
Modified: Module-Build/trunk/t/extend.t
==============================================================================
--- Module-Build/trunk/t/extend.t (original)
+++ Module-Build/trunk/t/extend.t Fri Mar 9 13:30:58 2007
@@ -2,7 +2,7 @@
use strict;
use lib $ENV{PERL_CORE} ? '../lib/Module/Build/t/lib' : 't/lib';
-use MBTest tests => 64;
+use MBTest tests => 65;
use Cwd ();
my $cwd = Cwd::cwd;
@@ -231,10 +231,12 @@
$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';
@@ -266,6 +268,9 @@
$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([EMAIL PROTECTED], [undef], " prompt() with undef() default");
}
}
