#!/usr/bin/perl

# 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

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/(?<=.)(?=.)/,/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;
}

# 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;
    print uc( $default ) . "\n";
    exit $pos;
    
}
    
# 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;
    
    $prompt = "$message [$show_choices]?";
    
    do {
        print $prompt;
        while (not defined ($key = ReadKey(-1))) {} # watch the keyboa
+rd in a loop
        print "$key\n";
    } until ( ( ! defined $key ) || ( $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
    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;
}
[download]