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;