File Coverage

blib/lib/Prompt/Timeout.pm
Criterion Covered Total %
statement 26 39 66.6
branch 10 22 45.4
condition 3 12 25.0
subroutine 5 5 100.0
pod 1 1 100.0
total 45 79 56.9


line stmt bran cond sub pod time code
1             # Prompt/Timeout.pm
2             #
3             # $Id: Timeout.pm 37 2011-06-30 06:53:16Z stro $
4             #
5             # Copyright (c) 2008-2011 Serguei Trouchelle. All rights reserved.
6             #
7             # This program is free software; you can redistribute it and/or modify it
8             # under the same terms as Perl itself.
9              
10             # History:
11             # 1.04_04 2011/07/06 Continue struggling with failing reports, part 3
12             # 1.04_03 2011/06/30 Continue struggling with failing reports, part 2
13             # 1.04_02 2011/06/30 Continue struggling with failing reports
14             # 1.04_01 2010/11/05 Added more prerequisites to find out what's wrong with some test reports
15             # Rewrite tests with Test::More
16             # 1.03 2010/11/01 Fixed problem with non-working "click", thanks to bottomsc[.]missouri.edu for reporting (RT#62535)
17             # Fixed potential problem with TAP output parsing
18             # 1.02 2009/08/31 Fixed problem with hanging in Unix environment, thanks to leocharre[.]cpan.org for reporting
19             # 1.01 2008/05/23 Documentation typo
20             # Removed Term::ReadKey::ReadMode because it doesn't work on some terminals
21             # 1.00 2008/05/22 Initial revision
22              
23             =head1 NAME
24              
25             Prompt::Timeout - prompt() with auto-selecting default value in case of inactivity
26              
27             =head1 SYNOPSIS
28              
29             use Prompt::Timeout;
30             my $res = prompt ( $question, $default, $timeout );
31              
32             =cut
33              
34             package Prompt::Timeout;
35              
36 3     3   54972 use strict;
  3         9  
  3         104  
37 3     3   16 use warnings;
  3         5  
  3         90  
38              
39 3     3   16 use Carp;
  3         8  
  3         242  
40 3     3   3060 use Term::ReadKey;
  3         15783  
  3         1649  
41             require 5.006;
42             require Exporter;
43              
44             our @EXPORT = qw(prompt);
45             our @ISA = qw(Exporter);
46              
47             $Prompt::Timeout::VERSION = '1.04_04';
48              
49             =head1 DESCRIPTION
50              
51             This module provides only one function, prompt(), and it's exported by default.
52              
53             =head2 prompt
54              
55             my $res = prompt ( $question, $default, $timeout );
56              
57             Prints a $question and waits for the input.
58             If no keys are pressed during $timeout seconds, $default is assumed.
59             When pressing just Enter key, $default is assumed.
60             If prompt() detects that it is not running interactively, $default will be used without prompting too.
61              
62             If you want to disable inactivity timer if any key is pressed during prompt(),
63             you can invoke it with another optional parameter:
64              
65             my $res = prompt ( $question, $default, $timeout, 1 );
66              
67             Once a key is pressed, inactivity timer is disabled.
68              
69             When $timeout value is omitted, it assumes 60 seconds.
70              
71             =cut
72              
73             sub prompt ($;$$$) {
74              
75 6     6 1 5101 my ($mess, $def, $timeout, $click) = @_;
76              
77 6 100       28 $timeout = 60 unless $timeout;
78            
79 6 50       23 Carp::confess("prompt function called without an argument")
80             unless defined $mess;
81              
82 6 50       159 Carp::confess("timeout argument should be integer")
83             unless $timeout =~ /^\d+$/;
84              
85 6   33     65 my $isa_tty = -t STDIN && (-t STDOUT || !(-f STDOUT || -c STDOUT)) ;
86              
87 6 100       31 my $dispdef = defined $def ? "[$def] " : " ";
88 6 100       20 $def = defined $def ? $def : "";
89              
90 6         30 local $|=1;
91 6         18 local $\;
92 6         445 print "$mess $dispdef:";
93              
94 6         19 my $ans = '';
95 6 50 33     76 if (!$isa_tty && eof STDIN) {
96 6         1257 print "$def\n";
97             } else {
98              
99 0         0 my $end = time + $timeout;
100              
101             #ReadMode 4; # Turn off controls keys
102 0         0 while (1) {
103 0         0 my $key = ReadKey(1); # 1 sec
104 0 0       0 if (defined $key) {
105 0 0       0 last if $key =~ /^[\r\n]$/x;
106 0         0 $ans .= $key;
107 0         0 print $key;
108 0         0 $end = time + $timeout;
109             } else {
110 0 0 0     0 unless ($click and $ans ne '') {
111 0 0       0 if ($end < time) {
112 0         0 $ans = $def;
113 0         0 print "$def\n";
114 0         0 last;
115             }
116             }
117             }
118             }
119             #ReadMode 0; # Reset tty mode before exiting
120             }
121 6 50 33     79 return (!defined $ans || $ans eq '') ? $def : $ans;
122             }
123              
124             =head1 AUTHOR
125              
126             Serguei Trouchelle EFE
127              
128             Prompt::Timeout uses partial code from ExtUtils::MakeMaker module.
129              
130             =head1 COPYRIGHT
131              
132             Copyright (c) 2008-2011 Serguei Trouchelle. All rights reserved.
133              
134             This program is free software; you can redistribute it and/or modify it
135             under the same terms as Perl itself.
136              
137             =cut
138              
139             1;