File Coverage

blib/lib/UI/Various/PoorTerm/Optionmenu.pm
Criterion Covered Total %
statement 48 48 100.0
branch 6 6 100.0
condition 3 3 100.0
subroutine 10 10 100.0
pod n/a
total 67 67 100.0


line stmt bran cond sub pod time code
1             package UI::Various::PoorTerm::Optionmenu;
2              
3             # Author, Copyright and License: see end of file
4              
5             =head1 NAME
6              
7             UI::Various::PoorTerm::Optionmenu - concrete implementation of L
8              
9             =head1 SYNOPSIS
10              
11             # This module should never be used directly!
12             # It is used indirectly via the following:
13             use UI::Various::Optionmenu;
14              
15             =head1 ABSTRACT
16              
17             This module is the specific minimal fallback implementation of
18             L. It manages and hides everything specific to the
19             last resort UI.
20              
21             =head1 DESCRIPTION
22              
23             The documentation of this module is only intended for developers of the
24             package itself.
25              
26             =cut
27              
28             #########################################################################
29              
30 2     2   21 use v5.14;
  2         5  
31 2     2   9 use strictures;
  2         3  
  2         10  
32 2     2   292 no indirect 'fatal';
  2         3  
  2         10  
33 2     2   108 no multidimensional;
  2         5  
  2         7  
34 2     2   124 use warnings 'once';
  2         3  
  2         116  
35              
36             our $VERSION = '0.24';
37              
38 2     2   18 use UI::Various::core;
  2         4  
  2         11  
39 2     2   12 use UI::Various::Optionmenu;
  2         4  
  2         65  
40 2     2   385 use UI::Various::PoorTerm::base;
  2         5  
  2         1310  
41              
42             require Exporter;
43             our @ISA = qw(UI::Various::Optionmenu UI::Various::PoorTerm::base);
44             our @EXPORT_OK = qw();
45              
46             #########################################################################
47             #########################################################################
48              
49             =head1 METHODS
50              
51             =cut
52              
53             #########################################################################
54              
55             =head2 B<_show> - print UI element
56              
57             $ui_element->_show($prefix);
58              
59             =head3 example:
60              
61             $_->_show('(1) ');
62              
63             =head3 parameters:
64              
65             $prefix text in front of first line
66              
67             =head3 description:
68              
69             Show (print) the UI element. I
70             UI::Various::PoorTerm container elements!>
71              
72             =cut
73              
74             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
75              
76             sub _show($$)
77             {
78 4     4   5538 my ($self, $prefix) = @_;
79 4 100       27 local $_ = defined $self->{_selected_menu} ? $self->{_selected_menu} : '---';
80 4         67 print $self->_wrap($prefix . '[ ', $_), " ]\n";
81             }
82              
83             #########################################################################
84              
85             =head2 B<_process> - handle action of UI element
86              
87             $ui_element->_process;
88              
89             =head3 description:
90              
91             Handle the action of the UI element (aka select an entry of the menu of
92             options).
93              
94             =cut
95              
96             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
97              
98             sub _process($)
99             {
100 3     3   6170 my ($self) = @_;
101              
102 3         8 my $max = @{$self->{options}};
  3         13  
103 3         14 my $prefix = '<%' . length($max) . 'd> ';
104 3         11 my $prompt = '';
105 3         8 foreach my $i (0..$#{$self->{options}})
  3         16  
106             {
107             $prompt .= $self->_wrap(sprintf($prefix, $i + 1),
108 12         71 $self->{options}[$i][0]);
109 12         27 $prompt .= "\n";
110             }
111 3         23 $prompt .= $self->_wrap('',
112             msg('enter_selection') .
113             ' (' . sprintf(msg('_1_to_cancel'), 0) . '): ');
114 3         7 while (1)
115             {
116 5         241 print $prompt;
117 5         34 local $_ = ;
118 5         45 print $_;
119 5         62 s/\r?\n$//;
120 5 100 100     45 if (m/^\d+$/ and $_ <= $max)
121             {
122 3         17 $self->{_selected_menu} = $self->{options}[$_ - 1][0];
123 3         12 $self->{_selected} = $self->{options}[$_ - 1][1];
124 3         8 $_ = $self->{on_select};
125 3 100       18 defined $_ and &$_($self->{_selected});
126 3         14 return;
127             }
128 2         9 error('invalid_selection');
129             }
130             }
131              
132             1;
133              
134             #########################################################################
135             #########################################################################
136              
137             =head1 SEE ALSO
138              
139             L, L
140              
141             =head1 LICENSE
142              
143             Copyright (C) Thomas Dorner.
144              
145             This library is free software; you can redistribute it and/or modify it
146             under the same terms as Perl itself. See LICENSE file for more details.
147              
148             =head1 AUTHOR
149              
150             Thomas Dorner Edorner (at) cpan (dot) orgE
151              
152             =cut