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