[1980] | 1 | # ------------------------------------------------------------------------------ |
---|
| 2 | # (C) Crown copyright Met Office. All rights reserved. |
---|
| 3 | # For further details please refer to the file COPYRIGHT.txt |
---|
| 4 | # which you should have received as part of this distribution. |
---|
| 5 | # ------------------------------------------------------------------------------ |
---|
| 6 | use strict; |
---|
| 7 | use warnings; |
---|
| 8 | |
---|
| 9 | package Fcm::Interactive::InputGetter::CLI; |
---|
| 10 | use base qw{Fcm::Interactive::InputGetter}; |
---|
| 11 | |
---|
| 12 | my $DEF_MSG = q{ (or just press <return> for "%s")}; |
---|
| 13 | my %EXTRA_MSG_FOR = ( |
---|
| 14 | yn => qq{\nEnter "y" or "n"}, |
---|
| 15 | yna => qq{\nEnter "y", "n" or "a"}, |
---|
| 16 | ); |
---|
| 17 | my %CHECKER_FOR = ( |
---|
| 18 | yn => sub {$_[0] eq 'y' || $_[0] eq 'n'}, |
---|
| 19 | yna => sub {$_[0] eq 'y' || $_[0] eq 'n' || $_[0] eq 'a'}, |
---|
| 20 | ); |
---|
| 21 | |
---|
| 22 | sub invoke { |
---|
| 23 | my ($self) = @_; |
---|
| 24 | my $type = $self->get_type() ? lc($self->get_type()) : q{}; |
---|
| 25 | my $message |
---|
| 26 | = $self->get_message() |
---|
| 27 | . (exists($EXTRA_MSG_FOR{$type}) ? $EXTRA_MSG_FOR{$type} : q{}) |
---|
| 28 | . ($self->get_default() ? sprintf($DEF_MSG, $self->get_default()) : q{}) |
---|
| 29 | . q{: } |
---|
| 30 | ; |
---|
| 31 | while (1) { |
---|
| 32 | print($message); |
---|
| 33 | my $answer = readline(STDIN); |
---|
| 34 | chomp($answer); |
---|
| 35 | if (!$answer && $self->get_default()) { |
---|
| 36 | $answer = $self->get_default(); |
---|
| 37 | } |
---|
| 38 | if (!exists($CHECKER_FOR{$type}) || $CHECKER_FOR{$type}->($answer)) { |
---|
| 39 | return $answer; |
---|
| 40 | } |
---|
| 41 | } |
---|
| 42 | return; |
---|
| 43 | } |
---|
| 44 | |
---|
| 45 | 1; |
---|
| 46 | __END__ |
---|
| 47 | |
---|
| 48 | =head1 NAME |
---|
| 49 | |
---|
| 50 | Fcm::Interactive::InputGetter::CLI |
---|
| 51 | |
---|
| 52 | =head1 SYNOPSIS |
---|
| 53 | |
---|
| 54 | use Fcm::Interactive; |
---|
| 55 | $answer = Fcm::Interactive::get_input( |
---|
| 56 | title => 'My title', |
---|
| 57 | message => 'Would you like to ...?', |
---|
| 58 | type => 'yn', |
---|
| 59 | default => 'n', |
---|
| 60 | ); |
---|
| 61 | |
---|
| 62 | =head1 DESCRIPTION |
---|
| 63 | |
---|
| 64 | This is a solid implementation of |
---|
| 65 | L<Fcm::Interactive::InputGetter|Fcm::Interactive::InputGetter>. It gets a user |
---|
| 66 | reply from STDIN using a prompt on STDOUT. |
---|
| 67 | |
---|
| 68 | =head1 METHODS |
---|
| 69 | |
---|
| 70 | See L<Fcm::Interactive::InputGetter|Fcm::Interactive::InputGetter> for a list of |
---|
| 71 | methods. |
---|
| 72 | |
---|
| 73 | =head1 TO DO |
---|
| 74 | |
---|
| 75 | Use IO::Prompt. |
---|
| 76 | |
---|
| 77 | =head1 SEE ALSO |
---|
| 78 | |
---|
| 79 | L<Fcm::Interactive|Fcm::Interactive>, |
---|
| 80 | L<Fcm::Interactive::InputGetter|Fcm::Interactive::InputGetter>, |
---|
| 81 | L<Fcm::Interactive::InputGetter::GUI|Fcm::Interactive::InputGetter::GUI> |
---|
| 82 | |
---|
| 83 | =head1 COPYRIGHT |
---|
| 84 | |
---|
| 85 | E<169> Crown copyright Met Office. All rights reserved. |
---|
| 86 | |
---|
| 87 | =cut |
---|