(view source code of choice.pl as plain text)
#! 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
page last modified: 2024-04-16; loaded in 0.0094 seconds