Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer

onelander's scratchpad

by onelander (Sexton)
on Mar 02, 2013 at 04:22 UTC ( #1021379=scratchpad: print w/replies, xml ) Need Help??

#!/usr/bin/perl # Written by: Mike Plemmons # March 1, 2013 # Contact: # 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 # does not work on Win 64bit # This script should provide the same funcationality # as the existing usage of # some parts of the script, particularly the character # posistion using indexes was borrowed from # 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; }
Log In?

What's my password?
Create A New User
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others examining the Monastery: (5)
As of 2016-10-25 03:30 GMT
Find Nodes?
    Voting Booth?
    How many different varieties (color, size, etc) of socks do you have in your sock drawer?

    Results (313 votes). Check out past polls.