This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix typos (spelling errors) in cpan/Term-UI/*.
[perl5.git] / cpan / Term-UI / lib / Term / UI.pm
CommitLineData
4f08f5ad
JB
1package Term::UI;
2
3use Carp;
4use Params::Check qw[check allow];
5use Term::ReadLine;
6use Locale::Maketext::Simple Style => 'gettext';
7use Term::UI::History;
8
9use strict;
10
11BEGIN {
12 use vars qw[$VERSION $AUTOREPLY $VERBOSE $INVALID];
13 $VERBOSE = 1;
46ad78ba 14 $VERSION = '0.20';
4f08f5ad
JB
15 $INVALID = loc('Invalid selection, please try again: ');
16}
17
18push @Term::ReadLine::Stub::ISA, __PACKAGE__
19 unless grep { $_ eq __PACKAGE__ } @Term::ReadLine::Stub::ISA;
20
21
22=pod
23
24=head1 NAME
25
26Term::UI - Term::ReadLine UI made easy
27
28=head1 SYNOPSIS
29
30 use Term::UI;
31 use Term::ReadLine;
32
33 my $term = Term::ReadLine->new('brand');
34
35 my $reply = $term->get_reply(
36 prompt => 'What is your favourite colour?',
37 choices => [qw|blue red green|],
38 default => blue,
39 );
40
41 my $bool = $term->ask_yn(
42 prompt => 'Do you like cookies?',
43 default => 'y',
44 );
45
46
47 my $string = q[some_command -option --no-foo --quux='this thing'];
48
49 my ($options,$munged_input) = $term->parse_options($string);
50
51
52 ### don't have Term::UI issue warnings -- default is '1'
53 $Term::UI::VERBOSE = 0;
54
55 ### always pick the default (good for non-interactive terms)
56 ### -- default is '0'
57 $Term::UI::AUTOREPLY = 1;
58
59 ### Retrieve the entire session as a printable string:
60 $hist = Term::UI::History->history_as_string;
61 $hist = $term->history_as_string;
62
63=head1 DESCRIPTION
64
65C<Term::UI> is a transparent way of eliminating the overhead of having
66to format a question and then validate the reply, informing the user
67if the answer was not proper and re-issuing the question.
68
69Simply give it the question you want to ask, optionally with choices
70the user can pick from and a default and C<Term::UI> will DWYM.
71
72For asking a yes or no question, there's even a shortcut.
73
74=head1 HOW IT WORKS
75
76C<Term::UI> places itself at the back of the C<Term::ReadLine>
77C<@ISA> array, so you can call its functions through your term object.
78
79C<Term::UI> uses C<Term::UI::History> to record all interactions
80with the commandline. You can retrieve this history, or alter
81the filehandle the interaction is printed to. See the
82C<Term::UI::History> manpage or the C<SYNOPSIS> for details.
83
84=head1 METHODS
85
86=head2 $reply = $term->get_reply( prompt => 'question?', [choices => \@list, default => $list[0], multi => BOOL, print_me => "extra text to print & record", allow => $ref] );
87
88C<get_reply> asks a user a question, and then returns the reply to the
89caller. If the answer is invalid (more on that below), the question will
90be reposed, until a satisfactory answer has been entered.
91
92You have the option of providing a list of choices the user can pick from
93using the C<choices> argument. If the answer is not in the list of choices
94presented, the question will be reposed.
95
96If you provide a C<default> answer, this will be returned when either
97C<$AUTOREPLY> is set to true, (see the C<GLOBAL VARIABLES> section further
98below), or when the user just hits C<enter>.
99
100You can indicate that the user is allowed to enter multiple answers by
101toggling the C<multi> flag. Note that a list of answers will then be
102returned to you, rather than a simple string.
103
104By specifying an C<allow> hander, you can yourself validate the answer
105a user gives. This can be any of the types that the Params::Check C<allow>
106function allows, so please refer to that manpage for details.
107
108Finally, you have the option of adding a C<print_me> argument, which is
109simply printed before the prompt. It's printed to the same file handle
110as the rest of the questions, so you can use this to keep track of a
111full session of Q&A with the user, and retrieve it later using the
112C<< Term::UI->history_as_string >> function.
113
114See the C<EXAMPLES> section for samples of how to use this function.
115
116=cut
117
118sub get_reply {
119 my $term = shift;
120 my %hash = @_;
121
122 my $tmpl = {
123 default => { default => undef, strict_type => 1 },
124 prompt => { default => '', strict_type => 1, required => 1 },
125 choices => { default => [], strict_type => 1 },
126 multi => { default => 0, allow => [0, 1] },
127 allow => { default => qr/.*/ },
128 print_me => { default => '', strict_type => 1 },
129 };
130
131 my $args = check( $tmpl, \%hash, $VERBOSE )
132 or ( carp( loc(q[Could not parse arguments]) ), return );
133
134
135 ### add this to the prompt to indicate the default
136 ### answer to the question if there is one.
137 my $prompt_add;
138
139 ### if you supplied several choices to pick from,
68073086 140 ### we'll print them separately before the prompt
4f08f5ad
JB
141 if( @{$args->{choices}} ) {
142 my $i;
143
144 for my $choice ( @{$args->{choices}} ) {
145 $i++; # the answer counter -- but humans start counting
146 # at 1 :D
147
148 ### so this choice is the default? add it to 'prompt_add'
149 ### so we can construct a "foo? [DIGIT]" type prompt
46ad78ba 150 $prompt_add = $i if (defined $args->{default} and $choice eq $args->{default});
4f08f5ad
JB
151
152 ### create a "DIGIT> choice" type line
153 $args->{print_me} .= sprintf "\n%3s> %-s", $i, $choice;
154 }
155
156 ### we listed some choices -- add another newline for
157 ### pretty printing
158 $args->{print_me} .= "\n" if $i;
159
160 ### allowable answers are now equal to the choices listed
161 $args->{allow} = $args->{choices};
162
163 ### no choices, but a default? set 'prompt_add' to the default
164 ### to construct a 'foo? [DEFAULT]' type prompt
165 } elsif ( defined $args->{default} ) {
166 $prompt_add = $args->{default};
167 }
168
169 ### we set up the defaults, prompts etc, dispatch to the readline call
170 return $term->_tt_readline( %$args, prompt_add => $prompt_add );
171
172}
173
174=head2 $bool = $term->ask_yn( prompt => "your question", [default => (y|1,n|0), print_me => "extra text to print & record"] )
175
176Asks a simple C<yes> or C<no> question to the user, returning a boolean
177indicating C<true> or C<false> to the caller.
178
179The C<default> answer will automatically returned, if the user hits
180C<enter> or if C<$AUTOREPLY> is set to true. See the C<GLOBAL VARIABLES>
181section further below.
182
183Also, you have the option of adding a C<print_me> argument, which is
184simply printed before the prompt. It's printed to the same file handle
185as the rest of the questions, so you can use this to keep track of a
186full session of Q&A with the user, and retrieve it later using the
187C<< Term::UI->history_as_string >> function.
188
189
190See the C<EXAMPLES> section for samples of how to use this function.
191
192=cut
193
194sub ask_yn {
195 my $term = shift;
196 my %hash = @_;
197
198 my $tmpl = {
199 default => { default => undef, allow => [qw|0 1 y n|],
200 strict_type => 1 },
201 prompt => { default => '', required => 1, strict_type => 1 },
202 print_me => { default => '', strict_type => 1 },
203 multi => { default => 0, no_override => 1 },
204 choices => { default => [qw|y n|], no_override => 1 },
205 allow => { default => [qr/^y(?:es)?$/i, qr/^n(?:o)?$/i],
206 no_override => 1
207 },
208 };
209
210 my $args = check( $tmpl, \%hash, $VERBOSE ) or return undef;
211
212 ### uppercase the default choice, if there is one, to be added
213 ### to the prompt in a 'foo? [Y/n]' type style.
214 my $prompt_add;
215 { my @list = @{$args->{choices}};
216 if( defined $args->{default} ) {
217
218 ### if you supplied the default as a boolean, rather than y/n
219 ### transform it to a y/n now
220 $args->{default} = $args->{default} =~ /\d/
221 ? { 0 => 'n', 1 => 'y' }->{ $args->{default} }
222 : $args->{default};
223
224 @list = map { lc $args->{default} eq lc $_
225 ? uc $args->{default}
226 : $_
227 } @list;
228 }
229
230 $prompt_add .= join("/", @list);
231 }
232
233 my $rv = $term->_tt_readline( %$args, prompt_add => $prompt_add );
234
235 return $rv =~ /^y/i ? 1 : 0;
236}
237
238
239
240sub _tt_readline {
241 my $term = shift;
242 my %hash = @_;
243
244 local $Params::Check::VERBOSE = 0; # why is this?
245 local $| = 1; # print ASAP
246
247
248 my ($default, $prompt, $choices, $multi, $allow, $prompt_add, $print_me);
249 my $tmpl = {
250 default => { default => undef, strict_type => 1,
251 store => \$default },
252 prompt => { default => '', strict_type => 1, required => 1,
253 store => \$prompt },
254 choices => { default => [], strict_type => 1,
255 store => \$choices },
256 multi => { default => 0, allow => [0, 1], store => \$multi },
257 allow => { default => qr/.*/, store => \$allow, },
258 prompt_add => { default => '', store => \$prompt_add },
259 print_me => { default => '', store => \$print_me },
260 };
261
262 check( $tmpl, \%hash, $VERBOSE ) or return;
263
264 ### prompts for Term::ReadLine can't be longer than one line, or
265 ### it can display wonky on some terminals.
266 history( $print_me ) if $print_me;
267
268
269 ### we might have to add a default value to the prompt, to
270 ### show the user what will be picked by default:
271 $prompt .= " [$prompt_add]: " if $prompt_add;
272
273
274 ### are we in autoreply mode?
275 if ($AUTOREPLY) {
276
277 ### you used autoreply, but didnt provide a default!
278 carp loc(
279 q[You have '%1' set to true, but did not provide a default!],
280 '$AUTOREPLY'
281 ) if( !defined $default && $VERBOSE);
282
283 ### print it out for visual feedback
284 history( join ' ', grep { defined } $prompt, $default );
285
286 ### and return the default
287 return $default;
288 }
289
290
291 ### so, no AUTOREPLY, let's see what the user will answer
292 LOOP: {
293
294 ### annoying bug in T::R::Perl that mucks up lines with a \n
295 ### in them; So split by \n, save the last line as the prompt
296 ### and just print the rest
297 { my @lines = split "\n", $prompt;
298 $prompt = pop @lines;
299
300 history( "$_\n" ) for @lines;
301 }
302
303 ### pose the question
304 my $answer = $term->readline($prompt);
305 $answer = $default unless length $answer;
306
307 $term->addhistory( $answer ) if length $answer;
308
309 ### add both prompt and answer to the history
310 history( "$prompt $answer", 0 );
311
312 ### if we're allowed to give multiple answers, split
313 ### the answer on whitespace
314 my @answers = $multi ? split(/\s+/, $answer) : $answer;
315
316 ### the return value list
317 my @rv;
318
319 if( @$choices ) {
320
321 for my $answer (@answers) {
322
323 ### a digit implies a multiple choice question,
324 ### a non-digit is an open answer
325 if( $answer =~ /\D/ ) {
326 push @rv, $answer if allow( $answer, $allow );
327 } else {
328
329 ### remember, the answer digits are +1 compared to
330 ### the choices, because humans want to start counting
331 ### at 1, not at 0
332 push @rv, $choices->[ $answer - 1 ]
333 if $answer > 0 && defined $choices->[ $answer - 1];
334 }
335 }
336
337 ### no fixed list of choices.. just check if the answers
338 ### (or otherwise the default!) pass the allow handler
339 } else {
340 push @rv, grep { allow( $_, $allow ) }
341 scalar @answers ? @answers : ($default);
342 }
343
344 ### if not all the answers made it to the return value list,
345 ### at least one of them was an invalid answer -- make the
346 ### user do it again
347 if( (@rv != @answers) or
348 (scalar(@$choices) and not scalar(@answers))
349 ) {
350 $prompt = $INVALID;
351 $prompt .= "[$prompt_add] " if $prompt_add;
352 redo LOOP;
353
354 ### otherwise just return the answer, or answers, depending
355 ### on the multi setting
356 } else {
357 return $multi ? @rv : $rv[0];
358 }
359 }
360}
361
362=head2 ($opts, $munged) = $term->parse_options( STRING );
363
364C<parse_options> will convert all options given from an input string
365to a hash reference. If called in list context it will also return
366the part of the input string that it found no options in.
367
368Consider this example:
369
370 my $str = q[command --no-foo --baz --bar=0 --quux=bleh ] .
371 q[--option="some'thing" -one-dash -single=blah' arg];
372
373 my ($options,$munged) = $term->parse_options($str);
374
375 ### $options would contain: ###
376 $options = {
377 'foo' => 0,
378 'bar' => 0,
379 'one-dash' => 1,
380 'baz' => 1,
381 'quux' => 'bleh',
382 'single' => 'blah\'',
383 'option' => 'some\'thing'
384 };
385
386 ### and this is the munged version of the input string,
387 ### ie what's left of the input minus the options
388 $munged = 'command arg';
389
390As you can see, you can either use a single or a double C<-> to
391indicate an option.
392If you prefix an option with C<no-> and do not give it a value, it
393will be set to 0.
394If it has no prefix and no value, it will be set to 1.
395Otherwise, it will be set to its value. Note also that it can deal
396fine with single/double quoting issues.
397
398=cut
399
400sub parse_options {
401 my $term = shift;
402 my $input = shift;
403
404 my $return = {};
405
406 ### there's probably a more elegant way to do this... ###
0e7718d1
RGS
407 while ( $input =~ s/(?:^|\s+)--?([-\w]+=("|').+?\2)(?=\Z|\s+)// or
408 $input =~ s/(?:^|\s+)--?([-\w]+=\S+)(?=\Z|\s+)// or
409 $input =~ s/(?:^|\s+)--?([-\w]+)(?=\Z|\s+)//
4f08f5ad
JB
410 ) {
411 my $match = $1;
412
413 if( $match =~ /^([-\w]+)=("|')(.+?)\2$/ ) {
414 $return->{$1} = $3;
415
416 } elsif( $match =~ /^([-\w]+)=(\S+)$/ ) {
417 $return->{$1} = $2;
418
419 } elsif( $match =~ /^no-?([-\w]+)$/i ) {
420 $return->{$1} = 0;
421
422 } elsif ( $match =~ /^([-\w]+)$/ ) {
423 $return->{$1} = 1;
424
425 } else {
426 carp(loc(q[I do not understand option "%1"\n], $match)) if $VERBOSE;
427 }
428 }
429
430 return wantarray ? ($return,$input) : $return;
431}
432
433=head2 $str = $term->history_as_string
434
435Convenience wrapper around C<< Term::UI::History->history_as_string >>.
436
437Consult the C<Term::UI::History> man page for details.
438
439=cut
440
441sub history_as_string { return Term::UI::History->history_as_string };
442
4431;
444
445=head1 GLOBAL VARIABLES
446
447The behaviour of Term::UI can be altered by changing the following
448global variables:
449
450=head2 $Term::UI::VERBOSE
451
452This controls whether Term::UI will issue warnings and explanations
453as to why certain things may have failed. If you set it to 0,
454Term::UI will not output any warnings.
455The default is 1;
456
457=head2 $Term::UI::AUTOREPLY
458
459This will make every question be answered by the default, and warn if
460there was no default provided. This is particularly useful if your
461program is run in non-interactive mode.
462The default is 0;
463
464=head2 $Term::UI::INVALID
465
466This holds the string that will be printed when the user makes an
467invalid choice.
468You can override this string from your program if you, for example,
469wish to do localization.
470The default is C<Invalid selection, please try again: >
471
472=head2 $Term::UI::History::HISTORY_FH
473
474This is the filehandle all the print statements from this module
475are being sent to. Please consult the C<Term::UI::History> manpage
476for details.
477
478This defaults to C<*STDOUT>.
479
480=head1 EXAMPLES
481
482=head2 Basic get_reply sample
483
484 ### ask a user (with an open question) for their favourite colour
485 $reply = $term->get_reply( prompt => 'Your favourite colour? );
486
487which would look like:
488
489 Your favourite colour?
490
491and C<$reply> would hold the text the user typed.
492
493=head2 get_reply with choices
494
495 ### now provide a list of choices, so the user has to pick one
496 $reply = $term->get_reply(
497 prompt => 'Your favourite colour?',
498 choices => [qw|red green blue|] );
499
500which would look like:
501
502 1> red
503 2> green
504 3> blue
505
506 Your favourite colour?
507
508C<$reply> will hold one of the choices presented. C<Term::UI> will repose
509the question if the user attempts to enter an answer that's not in the
510list of choices. The string presented is held in the C<$Term::UI::INVALID>
511variable (see the C<GLOBAL VARIABLES> section for details.
512
513=head2 get_reply with choices and default
514
515 ### provide a sensible default option -- everyone loves blue!
516 $reply = $term->get_reply(
517 prompt => 'Your favourite colour?',
518 choices => [qw|red green blue|],
519 default => 'blue' );
520
521which would look like:
522
523 1> red
524 2> green
525 3> blue
526
527 Your favourite colour? [3]:
528
529Note the default answer after the prompt. A user can now just hit C<enter>
530(or set C<$Term::UI::AUTOREPLY> -- see the C<GLOBAL VARIABLES> section) and
531the sensible answer 'blue' will be returned.
532
533=head2 get_reply using print_me & multi
534
535 ### allow the user to pick more than one colour and add an
536 ### introduction text
537 @reply = $term->get_reply(
538 print_me => 'Tell us what colours you like',
539 prompt => 'Your favourite colours?',
540 choices => [qw|red green blue|],
541 multi => 1 );
542
543which would look like:
544
545 Tell us what colours you like
546 1> red
547 2> green
548 3> blue
549
550 Your favourite colours?
551
552An answer of C<3 2 1> would fill C<@reply> with C<blue green red>
553
554=head2 get_reply & allow
555
556 ### pose an open question, but do a custom verification on
557 ### the answer, which will only exit the question loop, if
558 ### the answer matches the allow handler.
559 $reply = $term->get_reply(
560 prompt => "What is the magic number?",
561 allow => 42 );
562
563Unless the user now enters C<42>, the question will be reposed over
564and over again. You can use more sophisticated C<allow> handlers (even
565subroutines can be used). The C<allow> handler is implemented using
566C<Params::Check>'s C<allow> function. Check its manpage for details.
567
568=head2 an elaborate ask_yn sample
569
570 ### ask a user if he likes cookies. Default to a sensible 'yes'
571 ### and inform him first what cookies are.
572 $bool = $term->ask_yn( prompt => 'Do you like cookies?',
573 default => 'y',
574 print_me => 'Cookies are LOVELY!!!' );
575
576would print:
577
578 Cookies are LOVELY!!!
579 Do you like cookies? [Y/n]:
580
581If a user then simply hits C<enter>, agreeing with the default,
582C<$bool> would be set to C<true>. (Simply hitting 'y' would also
583return C<true>. Hitting 'n' would return C<false>)
584
585We could later retrieve this interaction by printing out the Q&A
586history as follows:
587
588 print $term->history_as_string;
589
590which would then print:
591
592 Cookies are LOVELY!!!
593 Do you like cookies? [Y/n]: y
594
595There's a chance we're doing this non-interactively, because a console
596is missing, the user indicated he just wanted the defaults, etc.
597
598In this case, simply setting C<$Term::UI::AUTOREPLY> to true, will
599return from every question with the default answer set for the question.
600Do note that if C<AUTOREPLY> is true, and no default is set, C<Term::UI>
601will warn about this and return C<undef>.
602
603=head1 See Also
604
605C<Params::Check>, C<Term::ReadLine>, C<Term::UI::History>
606
ce5e090c
RGS
607=head1 BUG REPORTS
608
609Please report bugs or other issues to E<lt>bug-term-ui@rt.cpan.org<gt>.
610
4f08f5ad
JB
611=head1 AUTHOR
612
ce5e090c 613This module by Jos Boumans E<lt>kane@cpan.orgE<gt>.
4f08f5ad
JB
614
615=head1 COPYRIGHT
616
ce5e090c
RGS
617This library is free software; you may redistribute and/or modify it
618under the same terms as Perl itself.
4f08f5ad 619
ce5e090c 620=cut