File Coverage

blib/lib/IO/Prompt/Timeout.pm
Criterion Covered Total %
statement 36 51 70.5
branch 9 18 50.0
condition 5 15 33.3
subroutine 8 9 88.8
pod 0 2 0.0
total 58 95 61.0


line stmt bran cond sub pod time code
1             package IO::Prompt::Timeout;
2 3     3   33905 use 5.008001;
  3         8  
  3         111  
3 3     3   12 use strict;
  3         3  
  3         74  
4 3     3   16 use warnings;
  3         5  
  3         85  
5              
6 3     3   1248 use parent qw(Exporter);
  3         776  
  3         13  
7             our @EXPORT_OK = qw(prompt has_timed_out);
8             our %EXPORT_TAGS = (all => \@EXPORT_OK);
9              
10 3     3   198 use Carp ();
  3         5  
  3         1085  
11              
12             our $VERSION = "0.02";
13              
14             my $HAS_TIMED_OUT;
15             my $DEFAULT_TIMEOUT_SEC = 60;
16              
17             sub prompt {
18 4 100   4 0 3653 if ($^O eq 'MSWin32') {
19 1         195 Carp::croak(q[Windows OS is not supported!]);
20             }
21 3         4 my $message = shift;
22 3 100       7 unless ($message) {
23 1         87 Carp::croak(q["prompt" called without any argument!]);
24             }
25              
26             # Clear timeout info.
27 2         3 undef $HAS_TIMED_OUT;
28              
29 2         5 my %opt = _parse_args(@_);
30              
31 2   33     15 my $isa_tty = -t STDIN && (-t STDOUT || !(-f STDOUT || -c STDOUT)) ;
32              
33 2 50       6 my $default_answer = exists $opt{default_answer} ? $opt{default_answer} : q{};
34 2 100       6 my $dispdef = $default_answer ? "[$default_answer]" : q{ };
35              
36 2         7 local $| = 1;
37 2         3 local $\;
38 2         15 print "$message $dispdef";
39              
40 2         2 my $answer;
41 2 50 33     23 if ($ENV{PERL_IOPT_USE_DEFAULT} || (!$isa_tty && eof STDIN)) {
      66        
42 2         26 print "$default_answer\n";
43             } else {
44 0         0 my $alarm_error = "__ALARM__\n";
45 0     0   0 local $SIG{ALRM} = sub { die $alarm_error; };
  0         0  
46 0   0     0 my $timeout = $opt{timeout} || $DEFAULT_TIMEOUT_SEC;
47 0         0 eval {
48 0         0 alarm $timeout;
49 0         0 $answer = ;
50 0         0 alarm 0;
51             };
52 0 0       0 if ($@) {
53 0 0       0 unless ($@ eq $alarm_error) {
54 0         0 Carp::croak("Unexpected error while waiting prompt input! ERROR:$@");
55             }
56 0         0 $HAS_TIMED_OUT = 1;
57             }
58              
59 0 0       0 if (defined $answer) {
60 0         0 chomp $answer;
61             } else {
62             # User hit ctrl-D
63             # Or timed out.
64 0         0 print "\n";
65             }
66             }
67              
68 2 50       5 $answer = defined $answer ? $answer : q{};
69 2   33     11 return $answer || $default_answer;
70             }
71              
72 1     1 0 10 sub has_timed_out { $HAS_TIMED_OUT; }
73              
74             sub _parse_args {
75 3     3   640 my %args = @_;
76             return (
77 3         14 default_answer => $args{default},
78             timeout => $args{timeout},
79             );
80             }
81              
82             1;
83             __END__