Skip to content

Commit

Permalink
Don't require default argument to y_n() unless $ENV{PERL_MM_USE_DEFAU…
Browse files Browse the repository at this point in the history
…LT} is set.

git-svn-id: http://svn.perl.org/modules/Module-Build/trunk@5870 50811bd7-b8ce-0310-adc1-d9db26280581
  • Loading branch information
Randy Sims committed Apr 7, 2006
1 parent 29e225b commit 6c8fa0a
Show file tree
Hide file tree
Showing 3 changed files with 51 additions and 14 deletions.
6 changes: 6 additions & 0 deletions Changes
Expand Up @@ -2,6 +2,12 @@ Revision history for Perl extension Module::Build.

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.

Expand Down
39 changes: 26 additions & 13 deletions lib/Module/Build/Base.pm
Expand Up @@ -463,17 +463,9 @@ sub _is_interactive {
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 ) ) {
Expand All @@ -484,21 +476,42 @@ sub prompt {
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(@_);
Expand Down
20 changes: 19 additions & 1 deletion t/extend.t
Expand Up @@ -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;
Expand Down Expand Up @@ -204,6 +204,24 @@ print "Hello, World!\n";
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': $!";
Expand Down

0 comments on commit 6c8fa0a

Please sign in to comment.