1 | # ------------------------------------------------------------------------------ |
---|
2 | # Copyright (C) 2006-2021 British Crown (Met Office) & Contributors. |
---|
3 | # |
---|
4 | # This file is part of FCM, tools for managing and building source code. |
---|
5 | # |
---|
6 | # FCM is free software: you can redistribute it and/or modify |
---|
7 | # it under the terms of the GNU General Public License as published by |
---|
8 | # the Free Software Foundation, either version 3 of the License, or |
---|
9 | # (at your option) any later version. |
---|
10 | # |
---|
11 | # FCM is distributed in the hope that it will be useful, |
---|
12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of |
---|
13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
---|
14 | # GNU General Public License for more details. |
---|
15 | # |
---|
16 | # You should have received a copy of the GNU General Public License |
---|
17 | # along with FCM. If not, see <http://www.gnu.org/licenses/>. |
---|
18 | # ------------------------------------------------------------------------------ |
---|
19 | use strict; |
---|
20 | use warnings; |
---|
21 | |
---|
22 | package FCM1::Interactive::InputGetter::CLI; |
---|
23 | use base qw{FCM1::Interactive::InputGetter}; |
---|
24 | |
---|
25 | my $DEF_MSG = q{ (or just press <return> for "%s")}; |
---|
26 | my %EXTRA_MSG_FOR = ( |
---|
27 | yn => qq{\nEnter "y" or "n"}, |
---|
28 | yna => qq{\nEnter "y", "n" or "a"}, |
---|
29 | ); |
---|
30 | my %CHECKER_FOR = ( |
---|
31 | yn => sub {$_[0] eq 'y' || $_[0] eq 'n'}, |
---|
32 | yna => sub {$_[0] eq 'y' || $_[0] eq 'n' || $_[0] eq 'a'}, |
---|
33 | ); |
---|
34 | |
---|
35 | sub invoke { |
---|
36 | my ($self) = @_; |
---|
37 | my $type = $self->get_type() ? lc($self->get_type()) : q{}; |
---|
38 | my $message |
---|
39 | = $self->get_message() |
---|
40 | . (exists($EXTRA_MSG_FOR{$type}) ? $EXTRA_MSG_FOR{$type} : q{}) |
---|
41 | . ($self->get_default() ? sprintf($DEF_MSG, $self->get_default()) : q{}) |
---|
42 | . q{: } |
---|
43 | ; |
---|
44 | while (1) { |
---|
45 | print($message); |
---|
46 | my $answer = readline(STDIN); |
---|
47 | chomp($answer); |
---|
48 | if (!$answer && $self->get_default()) { |
---|
49 | $answer = $self->get_default(); |
---|
50 | } |
---|
51 | if (!exists($CHECKER_FOR{$type}) || $CHECKER_FOR{$type}->($answer)) { |
---|
52 | return $answer; |
---|
53 | } |
---|
54 | } |
---|
55 | return; |
---|
56 | } |
---|
57 | |
---|
58 | 1; |
---|
59 | __END__ |
---|
60 | |
---|
61 | =head1 NAME |
---|
62 | |
---|
63 | FCM1::Interactive::InputGetter::CLI |
---|
64 | |
---|
65 | =head1 SYNOPSIS |
---|
66 | |
---|
67 | use FCM1::Interactive; |
---|
68 | $answer = FCM1::Interactive::get_input( |
---|
69 | title => 'My title', |
---|
70 | message => 'Would you like to ...?', |
---|
71 | type => 'yn', |
---|
72 | default => 'n', |
---|
73 | ); |
---|
74 | |
---|
75 | =head1 DESCRIPTION |
---|
76 | |
---|
77 | This is a solid implementation of |
---|
78 | L<FCM1::Interactive::InputGetter|FCM1::Interactive::InputGetter>. It gets a user |
---|
79 | reply from STDIN using a prompt on STDOUT. |
---|
80 | |
---|
81 | =head1 METHODS |
---|
82 | |
---|
83 | See L<FCM1::Interactive::InputGetter|FCM1::Interactive::InputGetter> for a list of |
---|
84 | methods. |
---|
85 | |
---|
86 | =head1 TO DO |
---|
87 | |
---|
88 | Use IO::Prompt. |
---|
89 | |
---|
90 | =head1 SEE ALSO |
---|
91 | |
---|
92 | L<FCM1::Interactive|FCM1::Interactive>, |
---|
93 | L<FCM1::Interactive::InputGetter|FCM1::Interactive::InputGetter>, |
---|
94 | L<FCM1::Interactive::InputGetter::GUI|FCM1::Interactive::InputGetter::GUI> |
---|
95 | |
---|
96 | =head1 COPYRIGHT |
---|
97 | |
---|
98 | Copyright (C) 2006-2021 British Crown (Met Office) & Contributors. |
---|
99 | |
---|
100 | =cut |
---|