File Coverage

blib/lib/UI/Various/PoorTerm/Window.pm
Criterion Covered Total %
statement 66 66 100.0
branch 14 14 100.0
condition 3 3 100.0
subroutine 11 11 100.0
pod 1 1 100.0
total 95 95 100.0


line stmt bran cond sub pod time code
1             package UI::Various::PoorTerm::Window;
2              
3             # Author, Copyright and License: see end of file
4              
5             =head1 NAME
6              
7             UI::Various::PoorTerm::Window - 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::Window;
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 3     3   30 use v5.14;
  3         8  
31 3     3   13 use strictures;
  3         6  
  3         12  
32 3     3   412 no indirect 'fatal';
  3         5  
  3         15  
33 3     3   136 no multidimensional;
  3         13  
  3         11  
34 3     3   128 use warnings 'once';
  3         7  
  3         168  
35              
36             our $VERSION = '0.24';
37              
38 3     3   16 use UI::Various::core;
  3         5  
  3         14  
39 3     3   16 use UI::Various::Window;
  3         5  
  3         89  
40 3     3   359 use UI::Various::PoorTerm::container;
  3         6  
  3         2469  
41              
42             require Exporter;
43             our @ISA = qw(UI::Various::Window UI::Various::PoorTerm::container);
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;
58              
59             =head3 description:
60              
61             Show the complete window by printing its title and all its elements. Active
62             elements (basically everything not just simple C>)
63             are numbered to allow later interaction with them. I
64             be called from C>!>
65              
66             =cut
67              
68             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
69              
70             sub _show($)
71             {
72 22     22   4514 debug(3, __PACKAGE__, '::_show');
73 22         42 my ($self) = @_;
74 22         38 local $_;
75              
76 22         64 print $self->_wrap('========== ', $self->title), "\n";
77              
78             # 1st gather active children and get width of prefix:
79 22         108 $self->{_active} = [];
80 22         81 while ($_ = $self->child)
81             {
82 60 100       214 $_->can('_process') and push @{$self->{_active}}, $_;
  40         111  
83             }
84 22         29 $_ = @{$self->{_active}};
  22         43  
85 22         36 $_ = length($_);
86              
87             # print children:
88 22         48 my $pre_active = '<%' . $_ . 'd> ';
89 22         53 my $pre_passive = ' ' x ($_ + 3);
90 22         26 my $i = 1;
91 22         50 while ($_ = $self->child)
92             {
93 60 100       156 if ($_->can('_process'))
94 40         208 { $_->_show(sprintf($pre_active, $i++)); }
95             else
96 20         58 { $_->_show($pre_passive); }
97             }
98              
99             # print standard selection strings:
100 22 100       99 print $self->_wrap(sprintf($pre_active, 0), msg('leave_window') .
101             ($self->parent->children > 1 ?
102             msg('next_previous_window') : '')), "\n\n";
103 22         131 print $self->_wrap('----- ', msg('enter_number_to_choose_next_step')), ': ';
104             }
105              
106             #########################################################################
107              
108             =head2 B<_process> - handle action of UI element
109              
110             $ui_element->_process;
111              
112             =head3 description:
113              
114             Handle the action of the UI element. For a C's window this means
115             a loop of printing the window's elements and allowing to select one of the
116             active ones for processing until the window is exited or destroyed.
117              
118             =cut
119              
120             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
121              
122             sub _process($)
123             {
124 15     15   4081 debug(3, __PACKAGE__, '::_process');
125 15         33 my ($self) = @_;
126 15         25 local $_ = -1;
127              
128 15         41 my $toplevel = $self->parent->children;
129 15         45 while (1)
130             {
131 27 100       94 if (defined $self->{_self_destruct})
132 7         41 { $self->_self_destruct; return; }
  7         19  
133 20 100       50 $toplevel == $self->parent->children or return 0;
134 17         70 $self->_show;
135 17         77 $_ = ;
136 17         132 print $_;
137 17         133 s/\r?\n$//;
138 17 100       75 return $_ if m/^[-0+]$/;
139 12 100 100     56 unless ($_ =~ m/^\d+$/ and $_ <= @{$self->{_active}})
  11         49  
140 2         7 { error('invalid_selection'); $_ = -1; next; }
  2         5  
  2         3  
141 10         44 $self->{_active}->[$_-1]->_process;
142             }
143             }
144              
145             #########################################################################
146              
147             =head2 B - remove window from application
148              
149             C's concrete implementation of
150             L
151             from application> sets a flag for auto-destruction in C
152             - handle action of UI element>>.
153              
154             =cut
155              
156             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
157              
158             sub destroy($)
159             {
160 7     7 1 724 debug(2, __PACKAGE__, '::destroy');
161 7         16 my ($self) = @_;
162 7         22 $self->{_self_destruct} = 1;
163             }
164              
165             1;
166              
167             #########################################################################
168             #########################################################################
169              
170             =head1 SEE ALSO
171              
172             L, L
173              
174             =head1 LICENSE
175              
176             Copyright (C) Thomas Dorner.
177              
178             This library is free software; you can redistribute it and/or modify it
179             under the same terms as Perl itself. See LICENSE file for more details.
180              
181             =head1 AUTHOR
182              
183             Thomas Dorner Edorner (at) cpan (dot) orgE
184              
185             =cut