Merge tag 'upstream/0.004012'

Upstream version 0.004012

8 files changed, 205 insertions, 45 deletions

diff --git a/Changes b/Changes
index 901346a..34a1bd7 100644
--- a/Changes
+++ b/Changes
@@ -150,5 +150,19 @@ Revision history for IO-Prompter
 
     * Added 'normal', 'default', 'standard', etc. to colour translation
 
-    * Added <CTRL-F> at start of faked input to defer next fake and insert real input
-      (i.e. like <ESC> but doesn't throw away the line that was scheduled next)
+    * Added <ESC><ESC> at start of faked input to defer next fake and insert real input
+      (i.e. like <ESC>, but doesn't throw away the line that was scheduled next)
+
+
+0.004012  Wed Feb  4 09:46:17 2015
+
+    * Added -void option to silence void warnings
+
+    * Added ability to declare lexically scoped wrapper subs
+      (thanks Schwern!)
+
+    * Documented incompatibility with Moose
+      (thanks Torbjørn!)
+
+    * Handle terminal escape sequences (e.g. arrow keys) more gracefully
+      (Thanks, Lukasz!)
diff --git a/MANIFEST b/MANIFEST
index 58ba3c9..095e525 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -40,4 +40,6 @@ t/orlast.t
 t/styles.t
 t/lexical_options.t
 t/list_context.t
-META.yml                                 Module meta-data (added by MakeMaker)
+t/autoexport.t
+META.yml                                 Module YAML meta-data (added by MakeMaker)
+META.json                                Module JSON meta-data (added by MakeMaker)
diff --git a/META.json b/META.json
new file mode 100644
index 0000000..3a74c81
--- /dev/null
+++ b/META.json
@@ -0,0 +1,42 @@
+{
+   "abstract" : "Prompt for input, read it, clean it, return it.",
+   "author" : [
+      "Damian Conway <DCONWAY@CPAN.org>"
+   ],
+   "dynamic_config" : 1,
+   "generated_by" : "ExtUtils::MakeMaker version 7.02, CPAN::Meta::Converter version 2.142690",
+   "license" : [
+      "perl_5"
+   ],
+   "meta-spec" : {
+      "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
+      "version" : "2"
+   },
+   "name" : "IO-Prompter",
+   "no_index" : {
+      "directory" : [
+         "t",
+         "inc"
+      ]
+   },
+   "prereqs" : {
+      "build" : {
+         "requires" : {
+            "ExtUtils::MakeMaker" : "0"
+         }
+      },
+      "configure" : {
+         "requires" : {
+            "ExtUtils::MakeMaker" : "0"
+         }
+      },
+      "runtime" : {
+         "requires" : {
+            "Contextual::Return" : "0",
+            "Test::More" : "0"
+         }
+      }
+   },
+   "release_status" : "stable",
+   "version" : "0.004012"
+}
diff --git a/META.yml b/META.yml
index 023c7c3..a37a222 100644
--- a/META.yml
+++ b/META.yml
@@ -1,23 +1,23 @@
---- #YAML:1.0
-name:               IO-Prompter
-version:            0.004011
-abstract:           Prompt for input, read it, clean it, return it.
+---
+abstract: 'Prompt for input, read it, clean it, return it.'
 author:
-    - Damian Conway <DCONWAY@CPAN.org>
-license:            perl
-distribution_type:  module
-configure_requires:
-    ExtUtils::MakeMaker:  0
+  - 'Damian Conway <DCONWAY@CPAN.org>'
 build_requires:
-    ExtUtils::MakeMaker:  0
-requires:
-    Contextual::Return:  0
-    Test::More:          0
-no_index:
-    directory:
-        - t
-        - inc
-generated_by:       ExtUtils::MakeMaker version 6.57_05
+  ExtUtils::MakeMaker: '0'
+configure_requires:
+  ExtUtils::MakeMaker: '0'
+dynamic_config: 1
+generated_by: 'ExtUtils::MakeMaker version 7.02, CPAN::Meta::Converter version 2.142690'
+license: perl
 meta-spec:
-    url:      http://module-build.sourceforge.net/META-spec-v1.4.html
-    version:  1.4
+  url: http://module-build.sourceforge.net/META-spec-v1.4.html
+  version: '1.4'
+name: IO-Prompter
+no_index:
+  directory:
+    - t
+    - inc
+requires:
+  Contextual::Return: '0'
+  Test::More: '0'
+version: '0.004012'
diff --git a/README b/README
index 2beb040..f8db75b 100644
--- a/README
+++ b/README
@@ -1,4 +1,4 @@
-IO::Prompter version 0.004011
+IO::Prompter version 0.004012
 
 Prompt for, read, vet, chomp, and encapsulate input.
 Like so:
diff --git a/lib/IO/Prompter.pm b/lib/IO/Prompter.pm
index a96600f..96987fc 100644
--- a/lib/IO/Prompter.pm
+++ b/lib/IO/Prompter.pm
@@ -9,7 +9,7 @@ use Contextual::Return qw< PUREBOOL BOOL SCALAR METHOD VOID LIST RETOBJ >;
 use Scalar::Util qw< openhandle looks_like_number >;
 use Symbol       qw< qualify_to_ref >;
 
-our $VERSION = '0.004011';
+our $VERSION = '0.004012';
 
 my $fake_input;     # Flag that we're faking input from the source
 
@@ -74,8 +74,9 @@ my @YESNO_PROMPTS = (
 # Remember returned values for history completion...
 my %history_cache;
 
-# Track lexically-scoped default options...
-my @lexical_options = [];
+# Track lexically-scoped default options and wrapper subs...
+my @lexical_options  = [];
+my @lexical_wrappers = [];
 
 # Export the prompt() sub...
 sub import {
@@ -92,6 +93,22 @@ sub import {
         $^H{'IO::Prompter::scope_number'} = $#lexical_options;
     }
 
+    # Handle lexical wrappers...
+    elsif (ref $config_data eq 'HASH') {
+        push @lexical_options, [];
+        $lexical_wrappers[ $#lexical_options ] = $config_data;
+        $^H{'IO::Prompter::scope_number'} = $#lexical_options;
+        for my $subname (keys %{$config_data}) {
+            my @args = @{$config_data->{$subname}};
+            no strict 'refs';
+            no warnings 'redefine';
+            *{caller().'::'.$subname} = sub {
+                my $scope_number = (caller 0)[10]{'IO::Prompter::scope_number'};
+                return prompt(@{$lexical_wrappers[$scope_number]{$subname}//[]}, @_);
+            };
+        }
+    }
+
     # Handler faked input specifications...
     elsif (defined $config_data) {
         $fake_input = $config_data;
@@ -103,9 +120,6 @@ sub import {
 
 # Prompt for, read, vet, and return input...
 sub prompt {
-    _warn( void => 'Useless use of prompt() in void context' )
-        if VOID;
-
     # Reclaim full control of print statements while prompting...
     local $\ = '';
 
@@ -116,6 +130,9 @@ sub prompt {
     # Extract and sanitize configuration arguments...
     my $opt_ref = _decode_args(@{$lexical_options[$scope_num]}, @_);
 
+    _warn( void => 'Useless use of prompt() in void context' )
+        if VOID && !$opt_ref->{-void};
+
     # Set up yesno prompts if required...
     my @yesno_prompts
         = ($opt_ref->{-yesno}{count}//0) > 1 ? @YESNO_PROMPTS : ();
@@ -573,6 +590,9 @@ sub _decode_args {
                 when (/^-i/)              { $option{-integer} = 1; $redo = 1; }
                 when (/^-n/)              { $option{-number}  = 1; $redo = 1; }
 
+                # Specify void context is okay...
+                when (/^-void$/)          { $option{-void} = 1;               }
+
                 # Specify verbatim return value...
                 when (/^-verb(?:atim)?$/) { $option{-verbatim} = 1;           }
                 when (/^-v/)              { $option{-verbatim} = 1; $redo = 1;}
@@ -1669,7 +1689,7 @@ sub _std_printer_to {
         return sub {
             my $style = shift;
             my @loc = (@_);
-            s{\e}{}gxms for @loc;
+            s{\e}{^}gxms for @loc;
             print {$out_filehandle} _stylize($opt_ref->{$style}(@loc), @loc);
         };
     }
@@ -1677,7 +1697,7 @@ sub _std_printer_to {
         return sub {
             shift; # ...ignore style
             my @loc = (@_);
-            s{\e}{}gxms for @loc;
+            s{\e}{^}gxms for @loc;
             print {$out_filehandle} @loc;
         };
     }
@@ -1698,7 +1718,7 @@ IO::Prompter - Prompt for input, read it, clean it, return it.
 
 =head1 VERSION
 
-This document describes IO::Prompter version 0.004011
+This document describes IO::Prompter version 0.004012
 
 
 =head1 SYNOPSIS
@@ -1855,6 +1875,8 @@ or add a L<"no-op"|"Escaping otherwise magic options"> to them.
 
     -v      -verb[atim]        Return the input string (no context sensitivity)
 
+            -void              Don't complain in void context
+
   * -w      -wipe              Clear screen
             -wipefirst         Clear screen on first prompt() call only
 
@@ -1901,6 +1923,43 @@ scope, use:
     use IO::Prompter [];
 
 
+=head2 Prebound options
+
+You can also ask IO::Prompter to export modified versions of C<prompt()>
+with zero or more options prebound. For example, you can request an
+C<ask()> subroutine that acts exactly like C<prompt()> but has the C<-
+yn> option pre-specified, or a C<pause()> subroutine that is C<prompt()>
+with a "canned" prompt and the C<-echo>, C<-single>, and C<-void> options.
+
+To specify such subroutines, pass a single hash reference when
+loading the module:
+
+    use IO::Prompter {
+        ask     => [-yn],
+        pause   => [-prompt=>'(Press any key to continue)', -echo, -single, -void],
+    }
+
+Each key will be used as the name of a separate subroutine to be
+exported, and each value must be an array reference, containing the
+arguments that are to be automatically supplied.
+
+The resulting subroutines are simply lexically scoped wrappers around
+C<prompt()>, with the specified arguments prepended to the normal
+argument list, equivalent to something like:
+
+    my sub ask {
+        return prompt(-yn, @_);
+    }
+
+    my sub pause {
+        return prompt(-prompt=>'(Press any key to continue)', -echo, -single, -void, @_);
+    }
+
+Note that these subroutines are lexically scoped, so if you want to use
+them throughtout a source file, they should be declared in the outermost
+scope of your program.
+
+
 =head2 Options reference
 
 =head3 Specifying what to prompt
@@ -3215,18 +3274,11 @@ Here, we're using prompt simply to pause the application after the data is
 printed. It doesn't matter what the user types in; the typing itself is the
 message (and the message is "move along").
 
-In such cases, the "useless use..." warning can be suppressed either by
-explicitly turning off the warning:
-
-    say $data;
-    no warnings 'void';
-    prompt('END OF DATA. Press any key to exit', -echo, -single);
-    exit;
-
-or by removing the void context itself with:
+In such cases, the "useless use..." warning can be suppressed using the 
+C<< -void >> option:
 
     say $data;
-    scalar prompt('END OF DATA. Press any key to exit', -echo, -single);
+    prompt('END OF DATA. Press any key to exit', -echo, -single, -void);
     exit;
 
 
@@ -3458,7 +3510,17 @@ The module also works much better if Term::ReadKey is available
 
 =head1 INCOMPATIBILITIES
 
-None reported.
+This module does not play well with Moose (or more specifically, with
+Moose::Exporter) because both of them try to play sneaky games with
+Scalar::Util::blessed.
+
+The current solution is to make sure that you load Moose before
+loading IO::Prompter. Even just doing this:
+
+    use Moose ();
+    use IO::Prompter;
+
+is sufficient.
 
 
 =head1 BUGS AND LIMITATIONS
diff --git a/t/autoexport.t b/t/autoexport.t
new file mode 100644
index 0000000..aa44b9d
--- /dev/null
+++ b/t/autoexport.t
@@ -0,0 +1,27 @@
+use Test::More;
+
+use IO::Prompter { ask => [-yn1, -verbatim] };
+
+{
+    open my $in_fh, '<', \'y' or die;
+    my $response = ask(-in=>$in_fh);
+    is $response, 'y'   => 'Ask matched on single y';
+    ok !ref($response)  => 'Verbatim';
+}
+
+{
+    use IO::Prompter { ask => [-yn1] };
+    open my $in_fh, '<', \'y' or die;
+    my $response = ask(-in=>$in_fh);
+    is $response, 'y'   => 'Ask matched on single y';
+    ok ref($response)   => 'Not verbatim';
+}
+
+{
+    open my $in_fh, '<', \'y' or die;
+    my $response = ask(-in=>$in_fh);
+    is $response, 'y'   => 'Ask matched on single y';
+    ok !ref($response)  => 'Verbatim';
+}
+
+done_testing();
diff --git a/t/errors.t b/t/errors.t
index 254b9a1..d1e5b6d 100644
--- a/t/errors.t
+++ b/t/errors.t
@@ -1,4 +1,4 @@
-use 5.010;
+#use 5.010;
 use warnings;
 use Test::More 'no_plan';
 
@@ -28,6 +28,7 @@ like $@, qr/prompt\(\): Invalid value for -timeout \(expected number of seconds\
     fail 'void context warning' if !$warned;
 }
 
+
 {
     no warnings 'void';
     my $warned;
@@ -44,6 +45,18 @@ like $@, qr/prompt\(\): Invalid value for -timeout \(expected number of seconds\
 {
     my $warned;
     local $SIG{__WARN__} = sub {
+        $warned = 1;
+    };
+
+    my $input = 'text';
+    open my $fh, '<', \$input or die $!;
+    prompt "Enter line 1", -in=>$fh, -void;
+    ok !$warned => 'turned off void context warning with -void';
+}
+
+{
+    my $warned;
+    local $SIG{__WARN__} = sub {
         my ($warning) = @_;
         like $warning, qr/\Aprompt\(\): Unknown option -zen ignored/
             => 'Unknown option warning';