leocharre has asked for the wisdom of the Perl Monks concerning the following question:

I have this sub to prompt the user for a response.
I'd like to have something like this that times out, what's good way of doing that? 


sub yn {
        my $question = shift; 
        $question ||='Your answer? ';

        my $val = undef;

        until (defined $val){
                print "$question (y/n): ";
                $val = <STDIN>;
                chomp $val;

                # $val = 
                #   $val eq 'y' ? 1 : (
                #      $val eq 'n' ? 0 : undef 
                #   );

                if ($val eq 'y'){ 
                   $val = 1; 
                }

                elsif ($val eq 'n'){ 
                   $val = 0;
                }

                else { 
                   $val = undef; 
                }
        }
        return $val;
}

[download]

(I guess what I'm missing is some kind of a counter, because the thing hangs waiting for stdin forever.. Maybe I could force to read stdin every 1 second, and thus I can count time.. but that would possibly yank the user's input before they concede, which is brutal. hmm.. )

I want to use this in tests, so that if there's no human being I can go on as needed. Are there some special precautions I should take when retrieving user input in my tests? I know they're picky about stdout (Test::Simple), right?

I want to optionally conduct intrusive tests (for example connecting to a database during testing ), defaulting to no.

update
This look interesting too, will test if the script was called via the command line? 

# from http://pleac.sourceforge.net/pleac_perl/userinterfaces.html
sub I_am_interactive {
    return -t STDIN && -t STDOUT;
}

[download]
Is there a major CAVEAT? Like, only runs on POSIX (muahhaha)? Is this kind of check reliable?

Replies are listed 'Best First'.
Re: prompt and timeout in tests
by kyle (Abbot) on Jan 15, 2008 at 21:49 UTC

    Have a look at alarm. Timing out input is the example in the documentation.

    Update: Code: 

    printf "Answer: %d\n", yn();

sub yn {
    my $question = shift;
    $question ||='Your answer? ';

    my $val = undef;

    until (defined $val){
        print "$question (y/n): ";
        eval {
            local $SIG{ALRM} = sub { die "alarm\n" };
            alarm 3;
            $val = <STDIN>;
            chomp $val;
        };
        if ($@) {
            die $@ if $@ ne "alarm\n";
            warn "No answer for three seconds.\n";
            $val = 'n';
        }
        # $val =
        #   $val eq 'y' ? 1 : (
        #      $val eq 'n' ? 0 : undef
        #   );

        if ($val eq 'y'){
            $val = 1;
        }
        elsif ($val eq 'n'){
            $val = 0;
        }
        else {
            $val = undef;
        }
    }
    return $val;
}

    [download]

    I tried this a couple times. If I don't answer, it looks like this: 

    Your answer?  (y/n): No answer for three seconds.
Answer: 0

    [download]

    ...and that takes three seconds.

    With an answer, it looks like: 

    Your answer?  (y/n): y
Answer: 1

    [download]
[reply]
[d/l]
[select]
Re: prompt and timeout in tests
by chromatic (Archbishop) on Jan 15, 2008 at 22:49 UTC

    This is a bad idea; it makes non-interactive test runs impossible.

    If you really need to prompt, do it during the configuration process with either ExtUtils::MakeMaker's prompt() function or Module::Build's prompt() or y_n() methods. They both work across platforms and don't require you to figure out all of that magic.

[reply]
[d/l]
[select]

      You mean the testing for terminal invocation?
      Aww.. I was thinking it worked.. I tried it out with perl Makefile.PL then make test, and it knnNNoooOOwws that I'm not 'there'.
      Then I run the tests straight via perl t/$x.t and hello world!

      I'm going to take a harder look at ExtUtils::MakeMaker like you said!

[reply]
Re: prompt and timeout in tests
by Joost (Canon) on Jan 15, 2008 at 22:05 UTC
    Regarding the -t test; as far as I know it's (at least conceptually, and probably in implementation too) based on the POSIX mechanisms for determining if a stream is bound to a TTY. In other words, if there is an "interactive terminal" bounded to the stream.

    That means it should work on POSIX, may work on other systems that have a POSIXy concept of what a TTY is and what streams are, and may not work on other systems. I haven't tested it, but I wouldn't be surprised if it didn't work in windows.

    "What should it profit a man, if he should win a flame war, yet lose his cool?"
[reply]
      Oh heck yeah it works wonderful.. :-) It's really cute.
      Screw M$- I just don't want my code to break on a real operating system. If it has a mental breakdown and kills itself on a M$ machine, who can blame it. Poor little script..
[reply]
Re: prompt and timeout in tests
by webfiend (Vicar) on Jan 16, 2008 at 02:32 UTC

    Why do you think you need a timeout? It is considered normal, polite behavior for your program to wait for STDIN to finish at most prompts.

    Anyways, another solution to the "yes or no prompt defaulting to no" dilemma is Term::UI and Term::ReadLine (standard in Perl 5.10).

    use strict;
use warnings;

use Term::UI;
use Term::ReadLine;

my $term = Term::ReadLine->new('test');

# Use default replies if not at interactive prompt
$Term::UI::AUTOREPLY = (-t STDIN) ? 0 : 1;

my $choice = $term->ask_yn(
    prompt  => 'Your answer?',
    default => 'n',
);

print "You chose '$choice'\n";
code>

    [download]
[reply]
[d/l]
Re: prompt and timeout in tests
by jwkrahn (Abbot) on Jan 16, 2008 at 00:40 UTC
[reply]

Back to Seekers of Perl Wisdom