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

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

Author: randys
Date: Thu Apr 27 19:18:43 2006
New Revision: 5976

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:
Remove ask() method.

Modified: Module-Build/trunk/Changes
==============================================================================
--- Module-Build/trunk/Changes	(original)
+++ Module-Build/trunk/Changes	Thu Apr 27 19:18:43 2006
@@ -2,12 +2,6 @@
 
 0.27_11
 
- - Add new method ask(), intended to provide a more complete tool for
-   authors to query users when performing a build. It provides better
-   support for unattended builds as well as providing better
-   validation of input. This new method is preferred over prompt() and
-   y_n().
-
  - When y_n() or prompt() are called without a default value and the
    build seems to be unattended (e.g. in automatic CPAN testing), we
    now die() with an error message rather than silently returning

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	Thu Apr 27 19:18:43 2006
@@ -819,118 +819,6 @@
 the second argument is assigned to the args hash under the key passed as the
 first argument.
 
-=item ask()
-
-[version 0.28]
-
-Asks the user a question and returns the answer as a string.
-
-The following is a list of arguments.  Only C<prompt> and C<default>
-are required.
-
-=over
-
-=item allow_nonoption_default
-
-Normally, if an C<options> array is present, then the value of the
-C<default> argument must exist in C<options>.  Setting
-C<allow_nonoption_default> to true allows the C<default> argument to
-be set to an arbitrary value.
-
-Default is false.
-
-=item default   [required]
-
-This is the default value that will be used if the user presses
-E<lt>enterE<gt> or if running an unattended build.
-
-The value assigned to C<default> must exist in the C<options> argument
-if it is present unless the C<allow_nonoption_default> flag is set to
-true.  If there are no C<options> then C<default> may be set to any
-value.
-
-=item getopts_name
-
-The name of a command line option.  If an option with this name is
-given on the command line, the value of the option will be used as the
-answer to the prompt.  The value will still be subject to the normal
-checks for validity.
-
-=item on_validate
-
-This is a code reference that can be used to validate or modify the
-answer entered by the user.  The value the user enters will be passed
-in as the first argument, and it will also be stored in the C<$_>
-variable.  Any modification to the C<$_> variable will be retained as
-the new answer.
-
-The subroutine passed to C<on_validate> must return a value to
-indicate how to proceed.
-
-If the return value is true, then the answer will be accepted as is,
-without further testing.  In particular, there will be no test to
-ensure that the answer is in the C<options> array if any were given.
-
-If the return value is false, then the answer will be rejected and a
-new answer will be requested, regardless of whether the answer would
-normally be accepted by the usual checks.
-
-If the return value is C<undef>, then the answer will be subject to
-the normal checks: if there is an C<options> array and the answer is
-one of the options, it will be accepted; if it is an open-ended query
-without an C<options> array, it will be accepted; otherwise it will be
-rejected.
-
-=item options
-
-A reference to an array containing a list of valid options.  If options
-are provided, C<ask()> will not return until a valid option is
-entered, or the C<default> is selected by pressing E<lt>enterE<gt>
-without entering a value.  Option names are case-insensitive, but the
-option returned will be normalized to the form used in the argument to
-C<options>.  It is not necessary for the user to enter the entire
-option name; C<ask()> will accept any unambiguous sequence of
-characters that will match only one option.  Eg. If the options are
-C<qw(yes no)> it will accept any of 'y', 'ye', or 'yes' to mean
-yes.  The complete option name will be returned.
-
-If no options are provided, C<ask()> will accept any response from the
-user.
-
-=item prompt   [required]
-
-This string will be displayed to the user to indicate that input is
-needed.  It should indicate the type of input required.
-
-=item show_default
-
-A boolean value that indicates whether the default value should be
-displayed as part of the prompt.  If true and if the default is a
-non-empty string, the default will be displayed at the end of the
-prompt, after the list of options if present.  It will be enclosed in
-square brackets.
-
-Default is true.
-
-=item show_options
-
-A boolean value that indicates whether the list of options should be
-displayed as part of the prompt.  If true and if C<options> contains a
-non-empty array, the list of options will be displayed at the end of
-the prompt, and before the C<default> value if it is shown.  The
-options will be separated by slashes and enclosed in parenthesis.
-
-Default is true.
-
-=back
-
-If C<ask()> 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 C<default> will be used without prompting.  This
-prevents automated processes from blocking on user input.
-
-This method may be called as a class or object method.
-
 =item autosplit_file($from, $to)
 
 [version 0.28]

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 27 19:18:43 2006
@@ -530,144 +530,6 @@
   }
 }
 
-sub ask {
-  my $self = shift;
-  my %args = @_;
-
-  # Check argument requirements
-  croak("ask() called without a prompt message") unless $args{prompt};
-  croak("ask() called without a default value") unless exists($args{default});
-
-  # Set defaults
-  my $show_options = exists($args{show_options}) ? $args{show_options} : 1;
-  my $show_default = exists($args{show_default}) ? $args{show_default} : 1;
-
-  my $getopts_name = exists($args{getopts_name}) ? $args{getopts_name} : undef;
-
-  my $allow_nonoption_default = exists($args{allow_nonoption_default})
-      ? $args{allow_nonoption_default} : 0;
-
-  my $on_validate = ref( $args{on_validate} ) eq 'CODE'
-    ? sub {
-        my $ans_ref = shift;
-        local $_ = $$ans_ref;
-        my $ret = $args{on_validate}->($_);
-        $$ans_ref = $_;
-        return $ret;
-      }
-    : sub { return undef };
-
-
-  # Setup options & abbrevs
-  my @options = ();
-  my $disp_options = '';
-  my %abbrev_of = ();
-  my %proper_case_of = ();
-
-  if ( $args{options} && ref($args{options}) eq 'ARRAY' ) {
-    @options = @{$args{options}};
-    if ( @options ) {
-      require Text::Abbrev;
-      %abbrev_of = Text::Abbrev::abbrev(map lc, @options);
-      %proper_case_of = map { lc $_, $_ } @options;
-      $disp_options = '(' . join('/', @options) . ')';
-    }
-  }
-
-  # Validate the default
-  my $default;
-  if ( $allow_nonoption_default ||
-       !$args{options}          ||
-       grep( {$_ eq $args{default}} @options ) )
-  {
-    $default = $args{default};
-  } else {
-    croak("The 'default' argument must exist in 'options' array.");
-  }
-
-  my $disp_default = '[' . $proper_case_of{$abbrev_of{lc $default}} . ']'
-    if $default && exists($abbrev_of{lc $default});
-
-  # Format prompt
-  my $prompt = $args{prompt};
-
-  # if $prompt ends in new-line, don't insert inital space
-  my $space = sub { (substr($_[0], -1) eq "\n") ? '' : ' ' };
-
-  $prompt .= $space->($prompt) . $disp_options
-      if $disp_options && $show_options;
-
-  $prompt .= $space->($prompt) . $disp_default
-      if $disp_default && $show_default;
-
-  $prompt .= $space->($prompt);
-
-
-  local $|=1;
-
-  # Guess
-  if ( $getopts_name && ref($self) ) {
-
-    my %cmdline_args = $self->args;
-    if ( exists( $cmdline_args{$getopts_name} ) ) {
-
-      my $answer = $cmdline_args{$getopts_name} || '';
-      print $args{prompt} . $space->($args{prompt}) . "$answer\n";
-
-      $answer = $proper_case_of{$abbrev_of{lc $answer}}
-          if exists($abbrev_of{lc $answer});
-
-      my $is_valid = $on_validate->(\$answer);
-      if ( $is_valid ) {
-        return $answer;
-      } elsif ( defined( $is_valid ) ) {
-        # defined, but false return: do not continue other checks
-      } elsif ( @options ) {
-        if ( exists($abbrev_of{lc $answer}) || $answer eq $default ) {
-          return $answer;
-        } else {
-          warn "Invalid option '$getopts_name=$answer'\n\n";
-        }
-      } else {
-        return $answer;
-      }
-    }
-  }
-
-  # Get answer
-  my $answer;
-  my $needs_answer = 1;
-  while ( $needs_answer ) {
-    print $prompt;
-    $answer = $self->_readline();
-
-    if ( !defined($answer) || !length($answer) ) { # Ctrl-D || Default
-      print "$default\n";
-      $answer = $default;
-      $needs_answer = 0;
-
-    } else {
-      $answer = $proper_case_of{$abbrev_of{lc $answer}}
-          if exists($abbrev_of{lc $answer});
-
-      my $is_valid = $on_validate->(\$answer);
-      if ( $is_valid ) {
-        $needs_answer = 0;
-      } elsif ( defined( $is_valid ) ) {
-        # defined, but false return: do not continue other checks
-      } elsif ( @options ) {
-        if ( exists($abbrev_of{lc $answer}) || $answer eq $default ) {
-          $needs_answer = 0;
-        }
-      } else {
-        $needs_answer = 0;
-      }
-    }
-  }
-
-  return $answer;
-}
-
 sub current_action { shift->{action} }
 sub invoked_action { shift->{invoked_action} }
 

Modified: Module-Build/trunk/t/extend.t
==============================================================================
--- Module-Build/trunk/t/extend.t	(original)
+++ Module-Build/trunk/t/extend.t	Thu Apr 27 19:18:43 2006
@@ -2,7 +2,7 @@
 
 use strict;
 use lib $ENV{PERL_CORE} ? '../lib/Module/Build/t/lib' : 't/lib';
-use MBTest tests => 82;
+use MBTest tests => 64;
 
 use Cwd ();
 my $cwd = Cwd::cwd;
@@ -262,104 +262,6 @@
   ok $ans, "  y_n() with a default";
 }
 
-{
-  # Test interactive prompting
-
-  my $ans;
-  local $ENV{PERL_MM_USE_DEFAULT};
-
-  local $^W = 0;
-  local *{Module::Build::_readline} = sub { 'y' };
-
-  ok my $mb = Module::Build->new(
-				  module_name => $dist->name,
-				  license => 'perl',
-                                  args => {login => 'randys',
-                                           boolean => 'yes'},
-			        );
-
-  eval{ $mb->ask() };
-  like $@, qr/called without a prompt/, 'ask() requires a prompt';
-
-  eval{ $mb->ask(prompt => 'prompt?') };
-  like $@, qr/called without a default/, 'ask() requires a default';
-
-  eval{ $mb->ask(prompt => 'prompt?', default => 'y') };
-  print "\n";
-  is $@, '', 'default not required in options when options is undefined';
-
-  eval{ $mb->ask(prompt => 'prompt?', default => 'y',
-                 options => [qw(a b c)]) };
-  like $@, qr/'default' argument must exist in 'options' array/,
-      'default must exist in options when options is non-empty';
-
-  eval{ $mb->ask(prompt  => 'prompt?',
-                 default => 'y',
-                 allow_nonoption_default => 1) };
-  print "\n";
-  is $@, '', 'open ended query';
-
-  eval{ $mb->ask(prompt  => 'prompt?',
-                 default => 'y',
-                 options => [qw(a b c)],
-                 allow_nonoption_default => 1) };
-  print "\n";
-  is $@, '', 'multi-choice with nonoption default';
-
-  eval{ $mb->ask(prompt  => 'prompt?',
-                 default => 'y',
-                 options => [qw(a b c y)] ) };
-  print "\n";
-  is $@, '', 'multi-choice with option default';
-
-  undef( $ans );
-  eval{ $ans = $mb->ask(prompt  => 'login?',
-                        default => 'guest',
-                        getopts_name => 'login',
-                        allow_nonoption_default => 1) };
-  print "\n";
-  is $@, '';
-  is $ans, 'randys', 'get answer from command line option';
-
-  undef( $ans );
-  eval{ $ans = $mb->ask(prompt  => 'prompt?',
-                        default => 'yes',
-                        options => [qw(yes no)],
-                        getopts_name => 'boolean' ) };
-  print "\n";
-  is $@, '';
-  is $ans, 'yes', 'get answer from command line option';
-
-  undef( $ans );
-  eval{ $ans = $mb->ask(prompt  => 'prompt?',
-                        default => 'yes',
-                        options => [qw(yes no)],
-                        on_validate => sub { s/yes/true/; 1 } ) };
-  print "\n";
-  is $@, '';
-  is $ans, 'true', 'change/validate answer';
-
-
-
-  *{Module::Build::_readline} = sub { undef };
-  undef( $ans );
-  eval{ $ans = $mb->ask(prompt  => 'prompt?',
-                        default => 'y',
-                        options => [qw(y n)] ) };
-  print "\n";
-  is $@, '';
-  is $ans, 'y', '<ctrl-d> - default answer';
-
-  *{Module::Build::_readline} = sub { '' };
-  undef( $ans );
-  eval{ $ans = $mb->ask(prompt  => 'prompt?',
-                        default => 'y',
-                        options => [qw(y n)] ) };
-  print "\n";
-  is $@, '';
-  is $ans, 'y', '<enter> - default answer';
-}
-
 # cleanup
 chdir( $cwd ) or die "Can''t chdir to '$cwd': $!";
 $dist->remove;