File Coverage

blib/lib/IO/Prompt/Tiny.pm
Criterion Covered Total %
statement 32 37 86.4
branch 10 20 50.0
condition 5 15 33.3
subroutine 7 7 100.0
pod 1 1 100.0
total 55 80 68.7


line stmt bran cond sub pod time code
1 1     1   66225 use 5.006;
  1         3  
  1         38  
2 1     1   5 use strict;
  1         1  
  1         32  
3 1     1   6 use warnings;
  1         2  
  1         56  
4              
5             package IO::Prompt::Tiny;
6             # ABSTRACT: Prompt for user input with a default option
7             our $VERSION = '0.002'; # VERSION
8              
9 1     1   5 use Exporter ();
  1         2  
  1         20  
10 1     1   5 use Carp ();
  1         1  
  1         346  
11             our @ISA = qw/Exporter/;
12             our @EXPORT_OK = qw/prompt/;
13              
14             # Copied from ExtUtils::MakeMaker (by many authors)
15             sub prompt {
16 4     4 1 10772 my($mess, $def) = @_;
17 4 50       14 Carp::croak("prompt function called without an argument")
18             unless defined $mess;
19              
20 4 50       14 my $dispdef = defined $def ? "[$def] " : " ";
21 4 50       8 $def = defined $def ? $def : "";
22              
23 4         14 local $|=1;
24 4         10 local $\;
25 4         127 print "$mess $dispdef";
26              
27 4         9 my $ans;
28 4 100 100     21 if ($ENV{PERL_MM_USE_DEFAULT} || ! _is_interactive()) {
29 2         20 print "$def\n";
30             }
31             else {
32 2         28 $ans = <STDIN>;
33 2 100       6 if( defined $ans ) {
34 1         3 chomp $ans;
35             }
36             else { # user hit ctrl-D
37 1         10 print "\n";
38             }
39             }
40              
41 4 100 66     39 return (!defined $ans || $ans eq '') ? $def : $ans;
42             }
43              
44             # Copied (without comments) from IO::Interactive::Tiny by Daniel Muey,
45             # based on IO::Interactive by Damian Conway and brian d foy
46             sub _is_interactive {
47 1     1   5 my ($out_handle) = (@_, select);
48 1 50       11 return 0 if not -t $out_handle;
49 0 0 0       if ( tied(*ARGV) or defined(fileno(ARGV)) ) {
50 0 0 0       return -t *STDIN if defined $ARGV && $ARGV eq '-';
51 0 0 0       return @ARGV>0 && $ARGV[0] eq '-' && -t *STDIN if eof *ARGV;
52 0           return -t *ARGV;
53             }
54             else {
55 0           return -t *STDIN;
56             }
57             }
58            
59             1;
60              
61              
62             # vim: ts=2 sts=2 sw=2 et:
63              
64             __END__
65              
66             =pod
67              
68             =encoding utf-8
69              
70             =head1 NAME
71              
72             IO::Prompt::Tiny - Prompt for user input with a default option
73              
74             =head1 VERSION
75              
76             version 0.002
77              
78             =head1 SYNOPSIS
79              
80             use IO::Prompt::Tiny qw/prompt/;
81              
82             my $answer = prompt("Yes or no? (y/n)", "n");
83              
84             =head1 DESCRIPTION
85              
86             This is an extremely simple prompting module, based on the extremely simple
87             prompt offered by L<ExtUtils::MakeMaker>.In many cases, that's all you need and
88             this module gives it to you without all the overhead of ExtUtils::MakeMaker
89             just to prompt for input.
90              
91             It doesn't do any validation, coloring, menus, timeouts, or any of the wild,
92             crazy, cool stuff that other prompting modules do. It just prompts with
93             a default. That's it!
94              
95             =head1 USAGE
96              
97             The following function may be explicitly imported. No functions are imported by
98             default.
99              
100             =head2 prompt
101              
102             my $value = prompt($message);
103             my $value = prompt($message, $default);
104              
105             The prompt() function displays the message as a prompt for input and returns
106             the (chomped) response from the user, or the default if the response was
107             empty.
108              
109             If the program is not running interactively or if the PERL_MM_USE_DEFAULT
110             environment variable is set to true, the default will be used without
111             prompting.
112              
113             If no default is provided, an empty string will be used instead.
114              
115             Unlike ExtUtils::MakeMaker::prompt(), this prompt() does not use
116             prototypes, so this will work as expected:
117              
118             my @args = ($prompt, $default);
119             prompt(@args);
120              
121             =head1 ENVIRONMENT
122              
123             =head2 PERL_MM_USE_DEFAULT
124              
125             If set to a true value, IO::Prompt::Tiny will always return the default
126             without waiting for user input, just like ExtUtils::MakeMaker does.
127              
128             =head1 ACKNOWLEDGMENTS
129              
130             The guts of this module are based on L<ExtUtils::MakeMaker> and
131             L<IO::Interactive::Tiny> (which is based on L<IO::Interactive>).
132             Thank you to the authors of those modules.
133              
134             =head1 SEE ALSO
135              
136             =over 4
137              
138             =item *
139              
140             L<IO::Prompt>
141              
142             =item *
143              
144             L<IO::Prompt::Simple>
145              
146             =item *
147              
148             L<Prompt::Timeout>
149              
150             =item *
151              
152             L<Term::Prompt>
153              
154             =back
155              
156             =for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan
157              
158             =head1 SUPPORT
159              
160             =head2 Bugs / Feature Requests
161              
162             Please report any bugs or feature requests through the issue tracker
163             at L<https://github.com/dagolden/io-prompt-tiny/issues>.
164             You will be notified automatically of any progress on your issue.
165              
166             =head2 Source Code
167              
168             This is open source software. The code repository is available for
169             public review and contribution under the terms of the license.
170              
171             L<https://github.com/dagolden/io-prompt-tiny>
172              
173             git clone git://github.com/dagolden/io-prompt-tiny.git
174              
175             =head1 AUTHOR
176              
177             David Golden <dagolden@cpan.org>
178              
179             =head1 COPYRIGHT AND LICENSE
180              
181             This software is Copyright (c) 2012 by David Golden.
182              
183             This is free software, licensed under:
184              
185             The Apache License, Version 2.0, January 2004
186              
187             =cut