File Coverage

blib/lib/Object/Remote/Prompt.pm
Criterion Covered Total %
statement 10 31 32.2
branch 1 16 6.2
condition 0 3 0.0
subroutine 4 10 40.0
pod 0 4 0.0
total 15 64 23.4


line stmt bran cond sub pod time code
1             package Object::Remote::Prompt;
2              
3 11     11   5718 use strictures 1;
  11         159  
  11         592  
4 11     11   1481 use IO::Handle;
  11         24  
  11         580  
5 11     11   61 use Exporter;
  11         19  
  11         4694  
6              
7             our @EXPORT = qw(prompt prompt_pw);
8              
9             our ($prompt, $prompt_pw);
10              
11             sub _local_prompt {
12 0     0   0 _local_prompt_core(0, @_);
13             }
14              
15             sub _local_prompt_pw {
16 0     0   0 _local_prompt_core(1, @_);
17             }
18              
19             our %Prompt_Cache;
20              
21             sub _local_prompt_core {
22 0     0   0 my ($pw, $message, $default, $opts) = @_;
23              
24 0 0 0     0 if ($opts->{cache} and my $hit = $Prompt_Cache{$message}) {
25 0         0 return $hit;
26             }
27              
28 0         0 STDOUT->autoflush(1);
29              
30 0 0       0 system('stty -echo') if $pw;
31              
32 0         0 print STDOUT "${message}: ";
33 0         0 chomp(my $res = );
34              
35 0 0       0 print STDOUT "\n" if $pw;
36 0 0       0 system('stty echo') if $pw;
37              
38 0 0       0 $Prompt_Cache{$message} = $res if $opts->{cache};
39              
40 0         0 return $res;
41             }
42              
43             sub prompt {
44 0 0   0 0 0 die "User input wanted - $_[0] - but no prompt available"
45             unless $prompt;
46 0         0 goto &$prompt;
47             }
48              
49             sub prompt_pw {
50 0 0   0 0 0 die "User input wanted - $_[0] - but no password prompt available"
51             unless $prompt_pw;
52 0         0 goto &$prompt_pw;
53             }
54              
55             if (-t STDIN) {
56             $prompt = \&_local_prompt;
57             $prompt_pw = \&_local_prompt_pw;
58             }
59              
60             sub set_local_prompt_command {
61 0     0 0 0 ($prompt, $prompt_pw) = @_;
62 0         0 return;
63             }
64              
65             sub maybe_set_prompt_command_on {
66 19 50   19 0 458 return unless $prompt;
67 0           my ($conn) = @_;
68 0           $conn->remote_sub('Object::Remote::Prompt::set_local_prompt_command')
69             ->($prompt, $prompt_pw);
70             }
71              
72             1;