File Coverage

blib/lib/App/Cmd/Plugin/Prompt.pm

Criterion	Covered	Total	%
statement	12	45	26.6
branch	0	24	0.0
condition	0	29	0.0
subroutine	4	11	36.3
pod	3	3	100.0
total	19	112	16.9

use strict;
use warnings;
package App::Cmd::Plugin::Prompt;
{
  $App::Cmd::Plugin::Prompt::VERSION = '1.005';
}
# ABSTRACT: plug prompting routines into your commands
use App::Cmd::Setup -plugin => {
  exports => [ qw(prompt_str prompt_yn prompt_any_key) ],
};

use Term::ReadKey;


sub prompt_str {
  my ($plugin, $cmd, $message, $opt) = @_;
  if ($opt->{default} && $opt->{valid} && ! $opt->{no_valid_default}) {
    Carp::croak(
      $opt->{invalid_default_error} || "'default' must pass 'valid' parameter"
    ) unless $opt->{valid}->($opt->{default});
  }
  $opt->{input}  ||= sub { scalar  };
  $opt->{valid}  ||= sub { 1 };
  $opt->{output} ||= sub {
    if (defined $_[1]) {
      printf "%s [%s]: ", @_;
    } else {
      printf "%s: ", $_[0];
    }
  };

  my $response;
  while (!defined($response) || !$opt->{valid}->($response)) {
    $opt->{output}->(
      $message,
      ($opt->{choices} || $opt->{default} || undef),
    );
    $response = $opt->{input}->();
    chomp($response);
    if ($opt->{default} && ! length($response)) {
      $response = $opt->{default};
    }
  }
  return $response;
}


sub prompt_yn {
  my ($plugin, $cmd, $message, $opt) = @_;

  Carp::croak("default must be y or n or 0 or 1")
    if defined $opt->{default}
    and $opt->{default} !~ /\A[yn01]\z/;

  my $choices = (not defined $opt->{default}) ? 'y/n'
              : $opt->{default} eq 'y'        ? 'Y/n'
              : $opt->{default} eq 'n'        ? 'y/N'
              : $opt->{default}               ? 'Y/n'
              :                                 'y/N';

  my $default = ($opt->{default}||'') =~ /\A\d\z/
              ? ($opt->{default} ? 'y' : 'n')
              : $opt->{default};

  my $response = $plugin->prompt_str(
    $cmd,
    $message,
    {
      choices => $choices,
      valid   => sub { lc($_[0]) eq 'y' || lc($_[0]) eq 'n' },
      default => $default,
    },
  );

  return lc($response) eq 'y';
}


sub prompt_any_key {
  my ($plugin, $cmd, $prompt) = @_;

  $prompt ||= "press any key to continue";
  print $prompt;
  Term::ReadKey::ReadMode 'cbreak';
  Term::ReadKey::ReadKey(0);
  Term::ReadKey::ReadMode 'normal';
  print "\n";
}


1;

__END__