File Coverage

blib/lib/UI/Various/PoorTerm/Main.pm
Criterion Covered Total %
statement 44 44 100.0
branch 14 16 93.7
condition n/a
subroutine 9 9 100.0
pod 1 1 100.0
total 68 70 98.5


line stmt bran cond sub pod time code
1             package UI::Various::PoorTerm::Main;
2              
3             # Author, Copyright and License: see end of file
4              
5             =head1 NAME
6              
7             UI::Various::PoorTerm::Main - 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::Main;
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 15     15   158 use v5.14;
  15         40  
31 15     15   68 use strictures;
  15         25  
  15         68  
32 15     15   2215 no indirect 'fatal';
  15         26  
  15         75  
33 15     15   880 no multidimensional;
  15         26  
  15         74  
34 15     15   468 use warnings 'once';
  15         27  
  15         741  
35              
36             our $VERSION = '0.24';
37              
38 15     15   111 use UI::Various::core;
  15         31  
  15         69  
39 15     15   80 use UI::Various::Main;
  15         25  
  15         7618  
40              
41             require Exporter;
42             our @ISA = qw(UI::Various::Main);
43             our @EXPORT_OK = qw();
44              
45             #########################################################################
46             #########################################################################
47              
48             =head1 FUNCTIONS
49              
50             =cut
51              
52             #########################################################################
53              
54             =head2 B<_init> - initialisation
55              
56             UI::Various::PoorTerm::Main::_init($self);
57              
58             =head3 example:
59              
60             $_ = UI::Various::core::ui . '::Main::_init';
61             { no strict 'refs'; &$_($self); }
62              
63             =head3 parameters:
64              
65             $self reference to object of abstract parent class
66              
67             =head3 description:
68              
69             Set-up the last resort UI. (It's under L as it's
70             called before the object is re-blessed as C.)
71              
72             =cut
73              
74             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
75              
76             sub _init($)
77             {
78 15     15   1838916 debug(1, __PACKAGE__, '::_init');
79 15         52 my ($self) = @_;
80 15 100       100 ref($self) eq __PACKAGE__ or
81             fatal('_1_may_only_be_called_from_itself', __PACKAGE__);
82              
83 14         42 my ($rows, $columns) = (24, 80); # fallback for terminal size
84             # FIXME: only works on Linux, use non-core (!) Term::Size for others???
85             # Note that -a as option to stty is POSIX, --all is not:
86 14         56650 local $_ = '' . `stty -a 2>/dev/null`; # ''. avoids undef!
87 14 50       512 m/;\s*rows\s+([1-9][0-9]*);\s*columns\s+([1-9][0-9]*);/
88             and ($rows, $columns) = ($1, $2);
89             # can't use accessors as we're not yet correctly blessed:
90 14         141 $self->{max_height} = $rows;
91 14         454 $self->{max_width} = $columns;
92             }
93              
94             #########################################################################
95              
96             =head1 METHODS
97              
98             =cut
99              
100             #########################################################################
101              
102             =head2 B - main event loop of an application
103              
104             C's concrete implementation of
105             L
106             of an application>
107              
108             =cut
109              
110             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
111              
112             sub mainloop($)
113             {
114 5     5 1 5146 my ($self) = @_;
115 5         27 my $n = $self->children;
116 5         11 my $i = 0; # behave like Curses::UI and Tk: 1st comes 1st
117 5         20 debug(1, __PACKAGE__, '::mainloop: ', $i, ' / ', $n);
118              
119 5         9 local $_;
120 5         13 while ($n > 0)
121             {
122 16         47 $_ = $self->child($i)->_process;
123 16         38 $n = $self->children;
124             # uncoverable branch false count:4
125 16 100       51 if (not defined $_)
    100          
    100          
    50          
126 8         12 { $i = $n - 1; }
127             elsif ($_ eq '+')
128 1         2 { $i++; }
129             elsif ($_ eq '-')
130 1         2 { $i--; }
131             elsif ($_ eq '0')
132 6         9 { $i = $n - 1; }
133 16 100       46 if ($i >= $n)
    100          
134 1         3 { $i = 0; }
135             elsif ($i < 0)
136 6         24 { $i = $n - 1; }
137             }
138             }
139              
140             1;
141              
142             #########################################################################
143             #########################################################################
144              
145             =head1 SEE ALSO
146              
147             L, L
148              
149             =head1 LICENSE
150              
151             Copyright (C) Thomas Dorner.
152              
153             This library is free software; you can redistribute it and/or modify it
154             under the same terms as Perl itself. See LICENSE file for more details.
155              
156             =head1 AUTHOR
157              
158             Thomas Dorner Edorner (at) cpan (dot) orgE
159              
160             =cut