1package Term::Prompt;
2
3use 5.006001;
4use strict;
5use warnings;
6
7require Exporter;
8
9our @ISA = qw (Exporter);
10our @EXPORT_OK = qw (rangeit legalit typeit menuit exprit yesit coderefit termwrap);
11our @EXPORT = qw (prompt);
12our $VERSION = '1.04';
13
14our $DEBUG = 0;
15our $MULTILINE_INDENT = "\t";
16
17use Carp;
18use Text::Wrap;
19use Term::ReadKey qw (GetTerminalSize
20                      ReadMode);
21
22my %menu = (
23	    order => 'down',
24	    return_base => 0,
25	    display_base => 1,
26	    accept_multiple_selections => 0,
27	    accept_empty_selection => 0,
28	    title => '',
29	    prompt => '>',
30	    separator => '[^0-9]+',
31	    ignore_whitespace => 0,
32	    ignore_empties => 0
33	   );
34
35# Preloaded methods go here.
36
37sub prompt ($$$$;@) {
38
39    my($mopt, $prompt, $prompt_options, $default, @things) =
40      ('','','',undef,());
41    my($repl, $match_options, $case, $low, $high, $before, $regexp, $coderef) =
42      ('','','','','','','','');
43    my $prompt_full = '';
44
45    # Figure out just what we are doing here
46    $mopt = $_[0];
47    print "mopt is: $mopt\n" if $DEBUG;
48
49    # check the size of the match option, it should just have one char.
50    if (length($mopt) == 1
51	or $mopt =~ /\-n/i
52	or $mopt =~ /\+-n/i) {
53	my $dummy = 'mopt is ok';
54    } else {
55	croak "Illegal call of prompt; $mopt is more than one character; stopped";
56    }
57
58    my $type = 0;
59    my $menu = 0;
60    my $legal = 0;
61    my $range = 0;
62    my $expr = 0;
63    my $code = 0;
64    my $yn = 0;
65    my $uc = 0;
66    my $passwd = 0;
67
68    if ($mopt ne lc($mopt)) {
69	$uc = 1;
70	$mopt = lc($mopt);
71    }
72
73    if ($mopt eq 'x' || $mopt eq 'a' || ($mopt =~ /n$/) || $mopt eq 'f') {
74	# More efficient this way - Allen
75	($mopt, $prompt, $prompt_options, $default) = @_;
76	$type = 1;
77    } elsif ($mopt eq 'm') {
78	($mopt, $prompt, $prompt_options, $default) = @_;
79	$menu = 1;
80    } elsif ($mopt eq 'c' || $mopt eq 'i') {
81	($mopt, $prompt, $prompt_options, $default, @things) = @_;
82	$legal = 1;
83    } elsif ($mopt eq 'r') {
84	($mopt, $prompt, $prompt_options, $default, $low, $high) = @_;
85	$range = 1;
86    } elsif ($mopt eq 'e') {
87	($mopt, $prompt, $prompt_options, $default, $regexp) = @_;
88	$expr = 1;
89    } elsif ($mopt eq 's') {
90	($mopt, $prompt, $prompt_options, $default, $coderef) = @_;
91	ref($coderef) eq 'CODE' || die('No valid code reference supplied');
92	$code = 1;
93    } elsif ($mopt eq 'y') {
94	($mopt, $prompt, $prompt_options, $default) = @_;
95	$yn = 1;
96	unless (defined($prompt_options) && length($prompt_options)) {
97	    if ($uc) {
98		$prompt_options = 'Enter y or n';
99	    } else {
100		$prompt_options = 'y or n';
101	    }
102	}
103
104	if (defined($default)) {
105	    unless ($default =~ m/^[ynYN]/) {
106		if ($default) {
107		    $default = 'y';
108		} else {
109		    $default = 'n';
110		}
111	    }
112	} else {
113	    $default = 'n';
114	}
115    } elsif ($mopt eq 'p') {
116	($mopt, $prompt, $prompt_options, $default) = @_;
117	$passwd = 1;
118    } else {
119	croak "prompt type $mopt not recognized";
120    }
121
122    my $ok = 0;
123
124    $mopt = lc($mopt);
125
126    while (1) {
127
128	if (!$menu) {
129
130	    # print out the prompt string in all its gore
131	    $prompt_full = "$prompt ";
132
133	} else {
134
135	    ## We're working on a menu
136	    @menu{sort keys %{$prompt}} = @{$prompt}{sort keys %{$prompt}};
137
138	    $prompt_full = "$menu{'prompt'} ";
139
140	    my @menu_items = @{$menu{'items'}};
141	    my $number_menu_items = scalar(@menu_items);
142
143	    $menu{'low'} = $menu{'display_base'};
144	    $menu{'high'} = $number_menu_items+$menu{'display_base'}-1;
145
146	    my $digits_in_menu_item = (int(log($menu{'high'})/log(10)) + 1);
147
148	    my $entry_length = 0;
149	    my $item_length = 0;
150	    for (@menu_items) {
151		$entry_length = length($_)
152		  if length($_) > $entry_length;
153	    }
154	    $item_length = $entry_length;
155	    $entry_length += ( $digits_in_menu_item ## Max number of digits in a selection
156			       +
157			       3 ## two for ') ', at least one for a column separator
158			     );
159
160	    my $gw = get_width();
161
162	    my $num_cols = (defined($menu{'cols'})
163			    ? $menu{'cols'}
164			    : int($gw/$entry_length));
165	    $num_cols ||= 1; # Could be zero if longest entry in a
166	    # list is wider than the screen
167	    my $num_rows = (defined($menu{'rows'})
168			    ? $menu{'rows'}
169			    : int($number_menu_items/$num_cols)+1) ;
170
171	    my $data_fmt = "%${digits_in_menu_item}d) %-${item_length}.${item_length}s";
172	    my $column_end_fmt = ("%s ");
173	    my $line_end_fmt   = ("%s\n");
174	    my @menu_out = ();
175	    my $row = 0;
176	    my $col = 0;
177	    my $idx = 0;
178
179	    if ($menu{order} =~ /ACROSS/i) {
180	      ACROSS_LOOP:
181		for ($row = 0; $row < $num_rows; $row++) {
182		    for ($col = 0; $col < $num_cols; $col++) {
183			$menu_out[$row][$col] = sprintf($data_fmt,$idx+$menu{'display_base'},$menu_items[$idx++]);
184			last ACROSS_LOOP
185			  if $idx eq scalar(@menu_items);
186		    }
187		}
188	    } else {
189	      DOWN_LOOP:
190		for ($col = 0; $col < $num_cols; $col++) {
191		    for ($row = 0; $row < $num_rows; $row++) {
192			$menu_out[$row][$col] = sprintf($data_fmt,$idx+$menu{'display_base'},$menu_items[$idx++]);
193			last DOWN_LOOP
194			  if $idx eq scalar(@menu_items);
195		    }
196		}
197	    }
198
199	    if (length($menu{'title'})) {
200		print $menu{'title'},"\n",'-' x length($menu{'title'}),"\n";
201	    }
202
203	    for ($row = 0;$row < $num_rows;$row++) {
204		for ($col = 0;$col < $num_cols-1;$col++) {
205		    printf($column_end_fmt,$menu_out[$row][$col])
206		      if defined($menu_out[$row][$col]);
207		}
208		if (defined($menu_out[$row][$num_cols-1])) {
209		    printf($line_end_fmt,$menu_out[$row][$num_cols-1])
210		} else {
211		    print "\n";
212		}
213	    }
214
215	    if ($number_menu_items != ($num_rows)*($num_cols)) {
216		print "\n";
217	    }
218
219	    unless (defined($prompt_options) && length($prompt_options)) {
220		$prompt_options = "$menu{'low'} - $menu{'high'}";
221		if ($menu{'accept_multiple_selections'}) {
222		    $prompt_options .= ', separate multiple entries with spaces';
223		}
224	    }
225	}
226
227	unless ($before || $uc || ($prompt_options eq '')) {
228	    $prompt_full .= "($prompt_options) ";
229	}
230
231	if (defined($default) and $default ne '') {
232	    $prompt_full .= "[default $default] ";
233	}
234
235	print termwrap($prompt_full);
236	my $old_divide = undef;
237
238	if (defined($/)) {
239	    $old_divide = $/;
240	}
241
242	$/ = "\n";
243
244	ReadMode('noecho') if($passwd);
245	$repl = scalar(readline(*STDIN));
246	ReadMode('restore') if($passwd);
247
248	if (defined($old_divide)) {
249	    $/ = $old_divide;
250	} else {
251	    undef($/);
252	}
253
254	chomp($repl);		# nuke the <CR>
255
256	$repl =~ s/^\s*//;	# ignore leading white space
257	$repl =~ s/\s*$//;	# ignore trailing white space
258
259	$repl = $default if $repl eq '';
260
261	if (!$menu && ($repl eq '') && (! $uc)) {
262	    # so that a simple return can be an end of a series of prompts - Allen
263	    print "Invalid option\n";
264	    next;
265	}
266
267	print termwrap("Reply: '$repl'\n") if $DEBUG;
268
269	# Now here is where things get real interesting
270	my @menu_repl = ();
271	if ($uc && ($repl eq '')) {
272	    $ok = 1;
273	} elsif ($type || $passwd) {
274	    $ok = typeit($mopt, $repl, $DEBUG, $uc);
275	} elsif ($menu) {
276	    $ok = menuit(\@menu_repl, $repl, $DEBUG, $uc);
277	} elsif ($legal) {
278	    ($ok,$repl) = legalit($mopt, $repl, $uc, @things);
279	} elsif ($range) {
280	    $ok = rangeit($repl, $low, $high, $uc);
281	} elsif ($expr) {
282	    $ok = exprit($repl, $regexp, $prompt_options, $uc, $DEBUG);
283	} elsif ($code) {
284	    $ok = coderefit($repl, $coderef, $prompt_options, $uc, $DEBUG);
285	} elsif ($yn) {
286	    ($ok,$repl) = yesit($repl, $uc, $DEBUG);
287	} else {
288	    croak "No subroutine known for prompt type $mopt.";
289	}
290
291	if ($ok) {
292	    if ($menu) {
293		if ($menu{'accept_multiple_selections'}) {
294		    return (wantarray ? @menu_repl : \@menu_repl);
295		} else {
296		    return $menu_repl[0];
297		}
298	    } else {
299		return $repl;
300	    }
301	} elsif (defined($prompt_options) && length($prompt_options)) {
302	    if ($uc) {
303		print termwrap("$prompt_options\n");
304	    } else {
305		if (!$menu) {
306		    print termwrap("Options are: $prompt_options\n");
307		}
308		$before = 1;
309	    }
310	}
311    }
312}
313
314sub rangeit ($$$$ ) {
315    # this routine makes sure that the reply is within a given range
316
317    my($repl, $low, $high, $uc) = @_;
318
319    if ( $low <= $repl && $repl <= $high ) {
320	return 1;
321    } elsif (!$uc) {
322	print 'Invalid range value.  ';
323    }
324    return 0;
325}
326
327sub legalit ($$$@) {
328    # this routine checks to see if a repl is one of a set of 'things'
329    # it checks case based on c = case check, i = ignore case
330
331    my($mopt, $repl, $uc, @things) = @_;
332    my(@match) = ();
333
334    if (grep {$_ eq $repl} (@things)) {
335	return 1, $repl;	# save time
336    }
337
338    my $quote_repl = quotemeta($repl);
339
340    if ($mopt eq 'i') {
341	@match = grep {$_ =~ m/^$quote_repl/i} (@things);
342    } else {
343	@match = grep {$_ =~ m/^$quote_repl/} (@things);
344    }
345
346    if (scalar(@match) == 1) {
347	return 1, $match[0];
348    } else {
349	if (! $uc) {
350	    print 'Invalid.  ';
351	}
352	return 0, '';
353    }
354}
355
356sub typeit ($$$$ ) {
357    # this routine does checks based on the following:
358    # x = no checks, a = alpha only, n = numeric only
359    my ($mopt, $repl, $dbg, $uc) = @_;
360    print "inside of typeit\n" if $dbg;
361
362    if ( $mopt eq 'x' or $mopt eq 'p' ) {
363	return 1;
364    } elsif ( $mopt eq 'a' ) {
365	if ( $repl =~ /^[a-zA-Z]*$/ ) {
366	    return 1;
367	} elsif (! $uc) {
368	    print 'Invalid type value.  ';
369	}
370    } elsif ( $mopt eq 'n' ) {
371	if ( $repl =~/^[0-9]*$/ ) {
372	    return 1;
373	} elsif (! $uc) {
374	    print 'Invalid numeric value. Must be a positive integer or 0. ';
375	}
376    } elsif ( $mopt eq '-n' ) {
377	if ( $repl =~/^-[0-9]*$/ ) {
378	    return 1;
379	} elsif (! $uc) {
380	    print 'Invalid numeric value. Must be a negative integer or 0. ';
381	}
382    } elsif ( $mopt eq '+-n' ) {
383	if ( $repl =~/^-?[0-9]*$/ ) {
384	    return 1;
385	} elsif (! $uc) {
386	    print 'Invalid numeric value. Must be an integer. ';
387	}
388    } elsif ( $mopt eq 'f' ) {
389	if ( $repl =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d)?([Ee]([+-]?\d+))?$/) {
390	    return 1;
391	} elsif (! $uc) {
392	    print 'Invalid floating point value.  ';
393	}
394    } else {
395	croak "typeit called with unknown prompt type $mopt; stopped";
396    }
397
398    return 0;
399}
400
401sub menuit (\@$$$ ) {
402    my ($ra_repl, $repl, $dbg, $uc) = @_;
403    print "inside of menuit\n" if $dbg;
404
405    my @msgs = ();
406
407    ## Parse for multiple values. Strip all whitespace if requested or
408    ## just strip leading and trailing whitespace to avoid a being
409    ## interpreted as separating empty choices.
410
411    if($menu{'ignore_whitespace'}) {
412	$repl =~ s/\s+//g;
413    } else {
414	$repl =~ s/^(?:\s+)//;
415	$repl =~ s/(?:\s+)$//;
416    }
417
418    my @repls = split(/$menu{'separator'}/,$repl);
419    if($menu{ignore_empties}) {
420	@repls = grep{length($_)} @repls;
421    }
422
423    ## Validations
424    if ( scalar(@repls) > 1
425	 &&
426	 !$menu{'accept_multiple_selections'} ) {
427	push @msgs, 'Multiple choices not allowed.';
428    } elsif (!scalar(@repls)
429	     &&
430	     !$menu{'accept_empty_selection'}) {
431	push @msgs, 'You must make a selection.';
432    } else {
433	for (@repls) {
434	    if ( !rangeit($_,$menu{'low'},$menu{'high'},1)) {
435		push @msgs, "$_ is an invalid choice.";
436	    }
437	}
438    }
439
440    ## Print errors or return values
441    if (scalar(@msgs)) {
442	print "\n",join("\n",@msgs),"\n\n";
443	return 0;
444    } else {
445	@{$ra_repl} = map {$_ - $menu{'display_base'} + $menu{'return_base'}} @repls;
446	return 1;
447    }
448
449}
450
451sub exprit ($$$$$ ) {
452    # This routine does checks based on whether something
453    # matches a supplied regexp - Allen
454    my($repl, $regexp, $prompt_options, $uc, $dbg) = @_;
455    print "inside of exprit\n" if $dbg;
456
457    if ( $repl =~ /^$regexp$/ ) {
458	return 1;
459    } elsif ((!$uc) ||
460	     (!defined($prompt_options)) || (!length($prompt_options))) {
461	print termwrap("Reply needs to match regular expression /^$regexp$/.\n");
462    }
463    return 0;
464}
465
466sub coderefit ($$$$$ ) {
467    # Execute supplied code reference with reply as argument and examine
468    # sub-routine's return value
469    my($repl, $coderef, $prompt_options, $uc, $dbg) = @_;
470    print "inside of coderefit\n" if $dbg;
471
472    if ( &$coderef($repl) ) {
473	return 1;
474    } elsif ((!$uc) ||
475	     (!defined($prompt_options)) || (!length($prompt_options))) {
476	print termwrap("Reply is invalid.\n");
477    }
478    return 0;
479}
480
481sub yesit ($$$ ) {
482    # basic yes or no - Allen
483    my ($repl, $uc, $dbg) = @_;
484    print "inside of yesit\n" if $dbg;
485
486    if ($repl =~ m/^[0nN]/) {
487	return 1,0;
488    } elsif ($repl =~ m/^[1yY]/) {
489	return 1,1;
490    } elsif (! $uc) {
491	print 'Invalid yes or no response. ';
492    }
493    return 0,0;
494}
495
496sub termwrap ($;@) {
497    my($message) = '';
498    if ($#_ > 0) {
499	if (defined($,)) {
500	    $message = join($,,@_);
501	} else {
502	    $message = join(' ',@_);
503	}
504    } else {
505	$message = $_[0];
506    }
507
508    my $width = get_width();
509
510    if (defined($width) && $width) {
511	$Text::Wrap::Columns = $width;
512    }
513
514    if ($message =~ m/\n\Z/) {
515	$message = wrap('', $MULTILINE_INDENT, $message);
516	$message =~ s/\n*\Z/\n/;
517	return $message;
518    } else {
519	$message = wrap('', $MULTILINE_INDENT, $message);
520	$message =~ s/\n*\Z//;
521	return $message;
522    }
523}
524
525sub get_width {
526
527    ## The 'use strict' added above caused the calls
528    ## GetTerminalSize(STDOUT) and GetTerminalSize(STDERR) to fail in
529    ## compilation. The fix as to REMOVE the parens. It seems as if
530    ## this call works the same way as 'print' - if you need to
531    ## specify the filehandle, you don't use parens (and don't put a
532    ## comma after the filehandle, although that is irrelevant here.)
533
534    ## SO DON'T PUT THEM BACK! :-)
535
536    my($width) = eval {
537	local($SIG{__DIE__});
538	(GetTerminalSize(select))[0];
539    } || eval {
540	if (-T STDOUT) {
541	    local($SIG{__DIE__});
542	    return (GetTerminalSize STDOUT )[0];
543	} else {
544	    return 0;
545	}
546    } || eval {
547	if (-T STDERR) {
548	    local($SIG{__DIE__});
549	    return (GetTerminalSize STDERR )[0];
550	} else {
551	    return 0;
552	}
553    } || eval {
554	local($SIG{__DIE__});
555	(GetTerminalSize STDOUT )[0];
556    } || eval {
557	local($SIG{__DIE__});
558	(GetTerminalSize STDERR )[0];
559    };
560    return $width;
561}
562
5631;
564
565# Autoload methods go after =cut, and are processed by the autosplit program.
566
567__END__
568
569=head1 NAME
570
571Term::Prompt - Perl extension for prompting a user for information
572
573=head1 SYNOPSIS
574
575    use Term::Prompt;
576    $value = prompt(...);
577
578    use Term::Prompt qw(termwrap);
579    print termwrap(...);
580
581    $Term::Prompt::MULTILINE_INDENT = '';
582
583=head1 PREREQUISITES
584
585You must have Text::Wrap and Term::ReadKey available on your system.
586
587=head1 DESCRIPTION
588
589This main function of this module is to accept interactive input. You
590specify the type of inputs allowed, a prompt, help text and defaults
591and it will deal with the user interface, (and the user!), by
592displaying the prompt, showing the default, and checking to be sure
593that the response is one of the legal choices.  Additional 'types'
594that could be added would be a phone type, a social security type, a
595generic numeric pattern type...
596
597=head1 FUNCTIONS
598
599=head2 prompt
600
601This is the main function of the module. Its first argument determines
602its usage and is one of the following single characters:
603
604 x: do not care
605 a: alpha-only
606 n: numeric-only
607 i: ignore case
608 c: case sensitive
609 r: ranged by the low and high values
610 f: floating-point
611 y: yes/no
612 e: regular expression
613 s: sub (actually, a code ref, but 'c' was taken)
614 p: password (keystrokes not echoed)
615 m: menu
616
617=over 4
618
619=item x: do not care
620
621 $result = prompt('x', 'text prompt', 'help prompt', 'default' );
622
623$result is whatever the user types.
624
625=item a: alpha-only
626
627 $result = prompt('a', 'text prompt', 'help prompt', 'default' );
628
629$result is a single 'word' consisting of [A-Za-z] only. The response
630is rejected until it conforms.
631
632=item n: numeric-only
633
634 $result = prompt('n', 'text prompt', 'help prompt', 'default' );
635
636The result will be a positive integer or 0.
637
638 $result = prompt('-n', 'text prompt', 'help prompt', 'default' );
639
640The result will be a negative integer or 0.
641
642 $result = prompt('+-n', 'text prompt', 'help prompt', 'default' );
643
644The result will be a any integer or 0.
645
646=item i: ignore case
647
648 $result = prompt('i', 'text prompt', 'help prompt', 'default',
649	              'legal_options-ignore-case-list');
650
651=item c: case sensitive
652
653 $result = prompt('c', 'text prompt', 'help prompt', 'default',
654	              'legal_options-case-sensitive-list');
655
656=item r: ranged by the low and high values
657
658 $result = prompt('r', 'text prompt', 'help prompt', 'default',
659                  'low', 'high');
660
661=item f: floating-point
662
663 $result = prompt('f', 'text prompt', 'help prompt', 'default');
664
665The result will be a floating-point number.
666
667=item y: yes/no
668
669 $result = prompt('y', 'text prompt', 'help prompt', 'default')
670
671The result will be 1 for y, 0 for n. A default not starting with y, Y,
672n or N will be treated as y for positive, n for negative.
673
674=item e: regular expression
675
676 $result = prompt('e', 'text prompt', 'help prompt', 'default',
677                  'regular expression');
678
679The regular expression has and implicit ^ and $ surrounding it; just
680put in .* before or after if you need to free it up before or after.
681
682=item s: sub
683
684 $result = prompt('s', 'text prompt', 'help prompt', 'default',
685                  sub { warn 'Your input was ' . shift; 1 });
686 $result = prompt('s', 'text prompt', 'help prompt', 'default',
687                  \&my_custom_validation_handler);
688
689User reply is passed to given code reference as first and only
690argument.  If code returns true, input is accepted.
691
692=item p: password
693
694 $result = prompt('p', 'text prompt', 'help prompt', 'default' );
695
696$result is whatever the user types, but the characters are not echoed
697to the screen.
698
699=item m: menu
700
701 @results = prompt(
702			'm',
703			{
704			prompt           => 'text prompt',
705			title            => 'My Silly Menu',
706            items            => [ qw (foo bar baz biff spork boof akak) ],
707			order            => 'across',
708			rows             => 1,
709			cols             => 1,
710			display_base     => 1,
711			return_base      => 0,
712			accept_multiple_selections => 0,
713			accept_empty_selection     => 0,
714            ignore_whitespace => 0,
715            separator         => '[^0-9]+'
716			},
717		    'help prompt',
718			'default');
719
720This will create a menu with numbered items to select. You replace the
721normal I<prompt> argument with a hash reference containing this
722information:
723
724=over 4
725
726=item prompt
727
728The prompt string.
729
730=item title
731
732Text printed above the menu.
733
734=item items
735
736An array reference to the list of text items to display. They will be
737numbered ascending in the order presented.
738
739=item order
740
741If set to 'across', the item numbers run across the menu:
742
743 1) foo    2) bar    3) baz
744 4) biff   5) spork  6) boof
745 7) akak
746
747If set to 'down', the item numbers run down the menu:
748
749 1) foo    4) biff   7) akak
750 2) bar    5) spork
751 3) baz    6) boof
752
753'down' is the default.
754
755=item rows,cols
756
757Forces the number of rows and columns. Otherwise, the number of rows
758and columns is determined from the number of items and the maximum
759length of an item with its number.
760
761Usually, you would set rows = 1 or cols = 1 to force a non-wrapped
762layout. Setting both in tandem is untested. Cavet programmer.
763
764=item display_base,return_base
765
766Internally, the items are indexed the 'Perl' way, from 0 to scalar
767-1. The display_base is the number added to the index on the menu
768display. The return_base is the number added to the index before the
769reply is returned to the programmer.
770
771The defaults are 1 and 0, respectively.
772
773=item accept_multiple_selections
774
775When set to logical true (1 will suffice), more than one menu item may
776be selected. The return from I<prompt()> will be an array or array
777ref, depending on how it is called.
778
779The default is 0. The return value is a single scalar containing the
780selection.
781
782=item accept_empty_selection
783
784When set to logical true (1 will suffice), if no items are selected,
785the menu will not be repeated and the 'empty' selection will be
786returned. The value of an 'empty' selection is an empty array or a
787reference to same, if I<accept_multiple_selections> is in effect, or
788I<undef> if not.
789
790=item separator
791
792A regular expression that defines what characters are allowed between
793multiple responses. The default is to allow all non-numeric characters
794to be separators. That can cause problems when a user mistakenly
795enters the lead letter of the menu item instead of the item
796number. You are better off replacing the default with something more
797reasonable, such as:
798
799 [,]    ## Commas
800 [,/]   ## Commas or slashes
801 [,/\s] ## Commas or slashes or whitespace
802
803=item ignore_whitespace
804
805When set, allows spaces between menu responses to be ignored, so that
806
807 1, 5, 6
808
809is collapsed to
810
811 1,5,6
812
813before parsing. B<NOTE:> Do not set this option if you are including
814whitespace as a legal separator.
815
816=item ignore_empties
817
818When set, consecutive separators will not result in an empty
819entry. For example, without setting this option:
820
821 1,,8,9
822
823will result in a return of
824
825 (1,'',8,9)
826
827When set, the return will be:
828
829 (1,8,9)
830
831which is probably what you want.
832
833=back
834
835=back
836
837=head2 Other Functions and Variables
838
839=over 4
840
841=item termwrap
842
843Part of Term::Prompt is the optionally exported function termwrap,
844which is used to wrap lines to the width of the currently selected
845filehandle (or to STDOUT or STDERR if the width of the current
846filehandle cannot be determined).  It uses the GetTerminalSize
847function from Term::ReadKey then Text::Wrap.
848
849=item MULTILINE_INDENT
850
851This package variable holds the string to be used to indent lines of a
852multiline prompt, after the first line. The default is "\t", which is
853how the module worked before the variable was exposed. If you do not
854want ANY indentation:
855
856 $Term::Prompt::MULTILINE_INDENT = '';
857
858=back
859
860=head2 Text and Help Prompts
861
862What, you might ask, is the difference between a 'text prompt' and a
863'help prompt'?  Think about the case where the 'legal_options' look
864something like: '1-1000'.  Now consider what happens when you tell
865someone that '0' is not between 1-1000 and that the possible choices
866are: :) 1 2 3 4 5 .....  This is what the 'help prompt' is for.
867
868It will work off of unique parts of 'legal_options'.
869
870Changed by Allen - if you capitalize the type of prompt, it will be
871treated as a true 'help prompt'; that is, it will be printed ONLY if
872the menu has to be redisplayed due to and entry error. Otherwise, it
873will be treated as a list of options and displayed only the first time
874the menu is displayed.
875
876Capitalizing the type of prompt will also mean that a return may be
877accepted as a response, even if there is no default; whether it
878actually is will depend on the type of prompt. Menus, for example, do
879not do this.
880
881=head1 AUTHOR
882
883Original Author: Mark Henderson (henderson@mcs.anl.gov or
884systems@mcs.anl.gov). Derived from im_prompt2.pl, from anlpasswd (see
885ftp://info.mcs.anl.gov/pub/systems/), with permission.
886
887Contributors:
888
889E. Allen Smith (easmith@beatrice.rutgers.edu): Revisions for Perl 5,
890additions of alternative help text presentation, floating point type,
891regular expression type, yes/no type, line wrapping and regular
892expression functionality added by E. Allen Smith.
893
894Matthew O. Persico (persicom@cpan.org): Addition of menu functionality
895and $Term::Prompt::MULTILINE_INDENT.
896
897Tuomas Jormola (tjormola@cc.hut.fi): Addition of code refs.
898
899Current maintainer: Matthew O. Persico (persicom@cpan.org)
900
901=head1 SEE ALSO
902
903L<perl>, L<Term::ReadKey>, and L<Text::Wrap>.
904
905=head1 COPYRIGHT AND LICENSE
906
907Copyright (C) 2004 by Matthew O. Persico
908
909This library is free software; you can redistribute it and/or modify
910it under the same terms as Perl itself, either Perl version 5.6.1 or,
911at your option, any later version of Perl 5 you may have available.
912