#!/usr/bin/perl
# Written by: Mike Plemmons
# March 1, 2013
# Contact: mikeplemmons@gmail.com
# I do not have a problem with people sharing this code
# but I would like some attribution if the script is used.
# I hope it is helpful.
#
# This script was written to become a drop-in
# replacement for Microsoft's choice.com
# choice.com does not work on Win 64bit
# This script should provide the same funcationality
# as the existing usage of choice.com
# some parts of the script, particularly the character
# posistion using indexes was borrowed from
# http://www.robvanderwoude.com/files/choice_perl.txt
use strict;
use warnings;
use Term::ReadKey;
use threads;
use threads::shared;
use Getopt::Long;
if ( $^O eq "MSWin32" ) {
# this is needed here because signals on Windows
# do not work properly
$ENV{PERL_SIGNALS} = "unsafe";
}
$SIG{INT}=\&ctrl_c_handler;
# in order to see the prompt text correctly
# we need to turn buffering off
$| = 1;
# setup defaults when the user does not provide any
# arguments - choices is used in a subroutine so make
# it global
my $choices = "yn";
my $default;
my $timeout;
my $message = "Enter your choice";
my $help = 0;
my $debug = 0;
my $uc_default;
# command line arguments
Getopt::Long::Configure("prefix_pattern=(--|-|\/)");
GetOptions('c:s' => \$choices, 'd:s' => \$default, 't:i' => \$timeout,
+ 'm:s' => \$message, 'h|?' => \$help, 'x' => \$debug);
# show the usage if the user requests it
# pass the script name to the usage sub so
# it can be shown during the output
if ( $help ) {
usage($0);
exit;
}
# if the user wants to see what they entered onto the command
# line they can use -x to print out what variables contain
# what values
if ( $debug ) {
print "
choices: $choices
default: $default
timeout: $timeout
message: $message
help: $help
\n";
exit 0;
}
# if a default option is chosen by the user then it MUST
# have an accompanying timeout. otherwise there is no
# point in having a default value
# the reverse is also true
# errors must exit with a return code of 255
if ( ( defined $default ) && ( ! defined $timeout )
||
( ! defined $default ) && ( defined $timeout )
) {
print "\n\tYou must use -d and -t together\n";
exit 255;
}
# make the default choice captial so it is obvious
# but only do this if a default value is provided
if ( defined $default ) {
$uc_default = uc($default);
$choices =~ s/$default/$uc_default/;
}
# the user output for choices needs to separate the characters
# by a comma
my $show_choices = $choices;
# regex to add a comma after each char
# the (.) captures each character and
# adds a comma after it
# $show_choices =~ s/(.)/$1,/g;
# $show_choices =~ s/,$//g; # remove the last comma
#
# these two can be combined into one regex
# thanks Athanasius from PMo
# read Look-Around Assertions under the
# Extended Patterns section on perlre
$show_choices =~ s/(.)(?!$)/$1,/g;
# if the default choice provided does not match the group
# of choices provided, error and exit
# errors must exit with a return code of 255
if ( ( defined $default ) && ( $choices !~ /$default/i ) ) {
print "Your choices ($show_choices) do not match the default ($def
+ault)\n";
exit 255;
} else {
# if a default value is provided then we must wrap the
# grabkey function in a timer so we can exit with the
# the proper default value if not entry is chosen by
# the user. this is wrapping is done with via threading
# because a default value must exist with a timeout this
# will work correctly
if ( defined $default ) {
# because we are using threads and one of them gets detached
# when a ctrl-c is used it will kill the threads but throw
# a "A thread exited while 2 threads were running." error
# since we do not want to see that error we redirect
# STDERR to a variable so that error is not seen on screen
# anymore. THIS IS NOT A GOOD WAY TO GO AS EVERY STDERR
# ERROR IS HIDDEN.
my $stderr;
close STDERR;
open(STDERR, ">", \$stderr);
# create a thread to run the grabkey sub
# this thread will watch the keyboard for the user
# input - detach from the thread to let it run on
# its own
my $grabkey_thread = threads->create(\&grabkey);
$grabkey_thread->detach();
# setup a timer so that if the user does not provide
# any input on the command line the script will exit
# after the timeout has been reached
# the exit return code will be the default choice
for ( my $i = 0; $i <= $timeout; $i++ ) {
sleep 1;
}
# to get here the timeout had to have occurred so
# exit the script with the index of the value from
# the choices provided to the user
# index starts at 1
# ex: choices abcd - default is c - index is 3
my $pos = index( uc( $choices ), uc( $default ) ) + 1;
exit $pos;
} else {
# no default value exists so no timeout is required
# this will call the function which will wait forever
# until the user supplies a value
grabkey();
}
}
sub grabkey {
# this sub will watch the keyboard for any user input
# and then compare it to valid values
# if the user value is wrong it will prompt again
# once a valid value is entered the script will exit
# with the return code of the user choice
my $key;
my $prompt;
if ( defined $timeout ) {
$prompt = "Sleep [$timeout] $message [$show_choices]: ";
} else {
$prompt = "$message [$show_choices]: ";
}
do {
print $prompt;
while (not defined ($key = ReadKey(-1))) {} # watch the keyboa
+rd in a loop
print "$key\n";
} until ( $key =~ m/[$choices]/i );
my $pos = index( uc( $choices ), uc( $key ) ) + 1;
exit $pos;
}
sub usage {
my $script = shift;
print "
Usage:
$script /c <choices> /d <default choice> /t <timeout> /m <message>
+ [-x|-?|-h]
Each option is optional but /d and /t must be used together.
Example:
$script /c abcd /d c /t 10 /m \"Please choose from the following\"
The prompt will look like the following
Sleep [10] Please choose from the following [a,b,C,d]
The script return code will be the index of the character chosen
Example:
Choices are: xyz User Chooses x %errorlevel% 1
Choices are: xyz User Chooses y %errorlevel% 2
Choices are: xyz User Chooses z %errorlevel% 3
-h and -? show this help
-x is a debug mode that will output the arguments you provided and
+ exit the script
";
}
# this will only be called if the Ctrl-C key command
# is pressed. a ctrl-c or ctrl-break must exit
# with a return code of 0
sub ctrl_c_handler {
exit 0;
}