Source code for choice.pl

#! 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