File Coverage

blib/lib/IO/Prompt/Timeout.pm

Criterion	Covered	Total	%
statement	37	47	78.7
branch	7	14	50.0
condition	7	17	41.1
subroutine	9	9	100.0
pod	2	2	100.0
total	62	89	69.6

package IO::Prompt::Timeout;
use 5.008001;
use strict;
use warnings;

use IO::Select;

use parent qw(Exporter);
our @EXPORT_OK = qw(prompt has_prompt_timed_out);
our %EXPORT_TAGS = (all => \@EXPORT_OK);

use Carp ();

our $VERSION = "0.04";

my $HAS_TIMED_OUT;
my $DEFAULT_TIMEOUT_SEC = 60;

sub prompt {
    my $message = shift;
    unless ($message) {
        Carp::croak(q["prompt" called without any argument!]);
    }

    # Clear timeout info.
    undef $HAS_TIMED_OUT;

    my %opt = _parse_args(@_);

    my $isa_tty = -t STDIN && (-t STDOUT || !(-f STDOUT || -c STDOUT)) ;

    my $default_answer = exists $opt{default_answer} ? $opt{default_answer} : q{};
    my $dispdef = $default_answer ? "[$default_answer]" : q{ };

    local $| = 1;
    local $\;
    print "$message $dispdef";

    my $answer;
    if ($ENV{PERL_IOPT_USE_DEFAULT} || (!$isa_tty && eof STDIN)) {
        print "$default_answer\n";
    } else {
        my $timeout = $opt{timeout} || $DEFAULT_TIMEOUT_SEC;
        my $is = IO::Select->new;
        $is->add(\*STDIN);
        if (my @readable = $is->can_read($timeout)) {
            my $stdin = shift @readable;
            $answer = <$stdin>;
        } else {
            $HAS_TIMED_OUT = 1;
        }

        if (defined $answer) {
            chomp $answer;
        } else {
            # User hit ctrl-D
            # Or timed out.
            print "\n";
        }
    }

    $answer = defined $answer ? $answer : q{};
    return $answer || $default_answer;
}

sub has_prompt_timed_out { $HAS_TIMED_OUT; }

sub _parse_args {
    my %args = @_;
    return (
        default_answer => $args{default} || q{},
        timeout        => $args{timeout},
    );
}

1;
__END__