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
|
