Beefy Boxes and Bandwidth Generously Provided by pair Networks Frank
We don't bite newbies here... much

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 having an uproarious good time at the Monastery: (14)
As of 2014-04-18 14:52 GMT
Find Nodes?
    Voting Booth?

    April first is:

    Results (469 votes), past polls