I am putting a sub from a program that I wrote called Program Archiver.

This is a generic question answering subroutine

Here is the sub and some examples.

#Useage
#Plain yes/no
if (stdin_question() =~ /yes/) { #Do something }

#Y or N
if (stdin_question('y,n','(Y)es (N)o') =~ /y/) { #Do something }

#On or off
if (stdin_question("on,off","(on or off) :",1) =~ /on/) { #Do somethin
+g }

#Advanced useage
$ret = stdin_question("subdir,manual,none","(subdir, manual, none) :")
+;

#Test return value and do somthing





#---------------------------------------------------------------------
+-------------
#    STDIN_QUESTION
#
#    If no arguments assume yes and no answers.  returns a y or n
#
#    $options         Holds the list of valid options.
#    $text        Hold the text to be displayed.
#    $full_match    Tests for full match
#
#---------------------------------------------------------------------
+-------------
sub stdin_question {
    #Get arguments
    my ($options,$text,$match) = @_;    #Get passed in var

    #Varables
    my $input;
    my $flag = 0;
    my @valid_options;

    #Check for defintion of options
    if (!defined($options)) {
        $options = "yes,no";
    }

    #Check for defintion of text
    if (!defined($text)) {
        $text = "(yes or no) :";
    }

    #Check for defination of match
    if (!defined($match)) {
        $match = 0;
    }

    #Put options in an arry
    @valid_options = split/,/, $options;

    #While no match loop
    while ($flag ne 1) {
        #Print out std text
        print $text;

        #Read and chomp stdin
        $input = <stdin>;
        chomp $input;

        #Loop through arry for match
        foreach (@valid_options) {
            #Test forback match
            if (/$input/i) {
                #Test for full match to compare on length
                if ($match eq 1) {
                    if (length($_) eq length($input)) {
                        $flag = 1;
                    }
                } else {
                    $flag = 1;
                }
            }
        }
    }

    #Return answer
    return lc $input;
}
[download]