fixed old logging metadata name missed from previous update
[scpubgit/Object-Remote.git] / lib / Object / Remote / Prompt.pm
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;