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