File Coverage

blib/lib/UI/Various/PoorTerm/Radio.pm
Criterion Covered Total %
statement 54 54 100.0
branch 10 10 100.0
condition 3 3 100.0
subroutine 10 10 100.0
pod n/a
total 77 77 100.0


line stmt bran cond sub pod time code
1             package UI::Various::PoorTerm::Radio;
2              
3             # Author, Copyright and License: see end of file
4              
5             =head1 NAME
6              
7             UI::Various::PoorTerm::Radio - 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::Radio;
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 last
19             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   19 use v5.14;
  2         6  
31 2     2   8 use strictures;
  2         2  
  2         10  
32 2     2   279 no indirect 'fatal';
  2         3  
  2         7  
33 2     2   112 no multidimensional;
  2         3  
  2         8  
34 2     2   88 use warnings 'once';
  2         4  
  2         102  
35              
36             our $VERSION = '0.24';
37              
38 2     2   11 use UI::Various::core;
  2         8  
  2         11  
39 2     2   10 use UI::Various::Radio;
  2         4  
  2         69  
40 2     2   334 use UI::Various::PoorTerm::base;
  2         5  
  2         1230  
41              
42             require Exporter;
43             our @ISA = qw(UI::Various::Radio 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 5     5   6248 my ($self, $prefix) = @_;
79 5         15 my $blank = ' ' x length($prefix);
80 5         15 my $var = $self->var;
81 5 100       12 defined $var or $var = '$ ^ }!\\"{]}[%]'; # magic invalid string
82 5         6 foreach my $i (0..$#{$self->{_button_keys}})
  5         19  
83             {
84 29 100       97 local $_ = ($i == 0 ? $prefix : $blank) . '(';
85             # Note that the accessors automatically dereference the SCALARs here:
86 29 100       88 $_ .= ($var eq $self->{_button_keys}[$i] ? 'o' : ' ') . ') ';
87 29         92 print $self->_wrap($_, $self->{_button_values}[$i]), "\n";
88             }
89             }
90              
91             #########################################################################
92              
93             =head2 B<_process> - handle action of UI element
94              
95             $ui_element->_process;
96              
97             =head3 description:
98              
99             Handle the action of the UI element (aka select one of the radio buttons).
100              
101             =cut
102              
103             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
104              
105             sub _process($)
106             {
107 3     3   5869 my ($self) = @_;
108              
109 3         6 my $max = @{$self->{_button_keys}};
  3         8  
110 3         9 my $prefix = '<%' . length($max) . 'd> ';
111 3         4 my $prompt = '';
112 3         6 foreach my $i (0..$#{$self->{_button_keys}})
  3         9  
113             {
114             $prompt .= $self->_wrap(sprintf($prefix, $i + 1),
115 16         58 $self->{_button_values}[$i]);
116 16         31 $prompt .= "\n";
117             }
118 3         13 $prompt .= $self->_wrap('',
119             msg('enter_selection') .
120             ' (' . sprintf(msg('_1_to_cancel'), 0) . '): ');
121              
122 3         11 local $_ = -1;
123 3         13 while ($_ < 0)
124             {
125 5         94 print $prompt;
126 5         21 $_ = ;
127 5         45 print $_;
128 5         37 s/\r?\n$//;
129 5 100 100     34 unless (m/^\d+$/ and $_ <= $max)
130 2         9 { error('invalid_selection'); $_ = -1; next; }
  2         5  
  2         5  
131 3 100       14 0 < $_ and ${$self->{var}} = $self->{_button_keys}[$_ - 1];
  2         10  
132             }
133             }
134              
135             1;
136              
137             #########################################################################
138             #########################################################################
139              
140             =head1 SEE ALSO
141              
142             L, L
143              
144             =head1 LICENSE
145              
146             Copyright (C) Thomas Dorner.
147              
148             This library is free software; you can redistribute it and/or modify it
149             under the same terms as Perl itself. See LICENSE file for more details.
150              
151             =head1 AUTHOR
152              
153             Thomas Dorner Edorner (at) cpan (dot) orgE
154              
155             =cut