fixed old logging metadata name missed from previous update
[scpubgit/Object-Remote.git] / lib / Object / Remote / Prompt.pm
CommitLineData
1b315002 1package Object::Remote::Prompt;
2
3use strictures 1;
4use IO::Handle;
5use Exporter;
6
7our @EXPORT = qw(prompt prompt_pw);
8
9our ($prompt, $prompt_pw);
10
11sub _local_prompt {
12 _local_prompt_core(0, @_);
13}
14
15sub _local_prompt_pw {
16 _local_prompt_core(1, @_);
17}
18
19our %Prompt_Cache;
20
21sub _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
43sub prompt {
44 die "User input wanted - $_[0] - but no prompt available"
45 unless $prompt;
46 goto &$prompt;
47}
48
49sub prompt_pw {
50 die "User input wanted - $_[0] - but no password prompt available"
51 unless $prompt_pw;
52 goto &$prompt_pw;
53}
54
55if (-t STDIN) {
56 $prompt = \&_local_prompt;
57 $prompt_pw = \&_local_prompt_pw;
58}
59
60sub set_local_prompt_command {
61 ($prompt, $prompt_pw) = @_;
62 return;
63}
64
65sub 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
721;