File Coverage

blib/lib/Bot/Cobalt/Frontend/Utils.pm

Criterion	Covered	Total	%
statement	49	58	84.4
branch	13	24	54.1
condition	8	21	38.1
subroutine	8	8	100.0
pod	2	2	100.0
total	80	113	70.8

package Bot::Cobalt::Frontend::Utils;
$Bot::Cobalt::Frontend::Utils::VERSION = '0.021003';
use v5.10;
use strictures 2;

use Carp;

use parent 'Exporter::Tiny';

our @EXPORT_OK = qw/
  ask_yesno
  ask_question
/;
our %EXPORT_TAGS;
{ my %s; push @{$EXPORT_TAGS{all}}, grep {!$s{$_}++} @EXPORT_OK }


sub ask_question {
  my %args = @_;

  my $question = delete $args{prompt} || croak "No prompt => specified";
  my $default  = delete $args{default};

  my $validate_sub;
  if (defined $args{validate}) {
    $validate_sub = ref $args{validate} eq 'CODE' ?
        delete $args{validate}
        : croak "validate => should be a coderef";
  }

  select(STDOUT); $|++;

  my $print_and_grab = sub {
    print "$question ", defined $default ? "[$default] " : "> ";
    my $ret = ;  chomp($ret);
    $ret = $default if defined $default and $ret eq '';
    $ret
  };

  my $input = $print_and_grab->();
  until (length $input) {
    print "No input specified.\n";
    $input = $print_and_grab->()
  }

  VALID: {
    if ($validate_sub) {
      my $invalid = $validate_sub->($input);
      last VALID unless defined $invalid;
      die "Invalid input; $invalid\n"
        if $args{die_if_invalid} or $args{die_unless_valid};
      until (not defined $invalid) {
        print "Invalid input; $invalid\n";
        $print_and_grab->();
        redo VALID
      }
    }
  }

  return $input
}

sub ask_yesno {
  my %args = @_;
  my $question = $args{prompt} || croak "No prompt => specified";

  my $default  = lc(
    substr($args{default}||'', 0, 1) || croak "No default => specified"
  );

  croak "default should be Y or N"
    unless $default =~ /^[yn]$/;

  my $yn = $default eq 'y' ? 'Y/n' : 'y/N' ;

  select(STDOUT); $|++;

  my $input;
  my $print_and_grab = sub {
    print "$question  [$yn] ";
    $input = ;  chomp($input);
    $input = $default if $input eq '';
    lc substr $input eq '' ? $default : $input, 0, 1
  };
  $print_and_grab->();
  until ($input && $input eq 'y' || $input eq 'n') {
    print "Invalid input; should be either Y or N\n";
    $print_and_grab->();
  }

  $input eq 'y' ? 1 : 0
}

1;
__END__