Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??

After running into the incompatibility of the choice.com program on Windows 64bit, I wondered if I could write a Perl replacement. I believe I have done it. I wanted to share what I created as this site has provided me so much help.

#!/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; }


In reply to Perl replacement for choice.com by onelander

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

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

    How do I use this? | Other CB clients
    Other Users?
    Others exploiting the Monastery: (12)
    As of 2014-10-24 18:47 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      For retirement, I am banking on:










      Results (134 votes), past polls