#! perl $syntax = "\nChoice.pl, Version 1.00\n"; $syntax = $syntax."Perl port of MS-DOS' CHOICE command\n\n"; # $syntax = $syntax."Usage: CHOICE [/C[:]choices] [/N] [/S] [/T[:]c,nn] [text]\n\n"; $syntax = $syntax."Usage: CHOICE [/C[:]choices] [/N] [/S] [text]\n\n"; $syntax = $syntax."Where: /C[:]choices Specifies allowable keys. Default is YN\n"; $syntax = $syntax." /N Do not display choices and ? at end of prompt string.\n"; $syntax = $syntax." /S Treat choice keys as case sensitive.\n"; # $syntax = $syntax." /T[:]c,nn Default choice to c after nn seconds\n"; $syntax = $syntax." text Prompt string to display\n\n"; $syntax = $syntax."ERRORLEVEL is set to offset of key user presses in choices.\n\n"; $syntax = $syntax."Note: Unlike its MS-DOS counterpart, this Perl port requires pressing the\n"; $syntax = $syntax." \"Enter\" key after the key of choice.\n"; $syntax = $syntax." The MS-DOS counterpart's time-out switch isn't implemented in this Perl\n"; $syntax = $syntax." port.\n\n"; $syntax = $syntax."Written by Rob van der Woude\nhttp://www.robvanderwoude.com\n"; # Set default values $case = 0; $choices = "YN"; $default = ""; $dispch = 1; $help = 0; $text = ""; $timeout = ""; # Parse command line arguments if ( @ARGV[0] ) { foreach ( @ARGV ) { SELECT: { if ( $_ =~ m/^\/C:?(\w+)$/i ) { $choices = $1; last SELECT; } if ( uc( $_ ) eq "/N" ) { $dispch = 0; last SELECT; } if ( uc( $_ ) eq "/S" ) { $case = 1; last SELECT; } if ( $_ =~ m/^\/T:?(\w+),(\d+)$/i ) { $default = $1; $timeout = $2; last SELECT; } if ( $_ =~ m/^[^\/]+$/ ) { $text = "$text $_"; last SELECT; } $help = 1; } } } if ( $help == 1 ) { die $syntax; } if ( substr( $text, 0, 1 ) == " " ) { $text = substr( $text, 1 ); } $prompt = $text; if ( $dispch == 1 ) { $prompt = $prompt."? [$choices] "; } if ( $case == 1 ) { do { print $prompt; $key = getc( STDIN ); print "\n"; } until ( $key =~ m/[$choices]/ ); $pos = 1 - $[ + index( $choices, $key ); } else { do { print $prompt; $key = getc( STDIN ); print "\n"; } until ( $key =~ m/[$choices]/i ); $pos = 1 - $[ + index( uc( $choices ), uc( $key ) ); } exit $pos