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 14     14   157 use v5.14;
  14         44  
31 14     14   68 use strictures;
  14         31  
  14         72  
32 14     14   2275 no indirect 'fatal';
  14         25  
  14         57  
33 14     14   966 no multidimensional;
  14         76  
  14         85  
34 14     14   535 use warnings 'once';
  14         32  
  14         737  
35              
36             our $VERSION = '0.22';
37              
38 14     14   86 use UI::Various::core;
  14         24  
  14         80  
39 14     14   79 use UI::Various::Main;
  14         24  
  14         7441  
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 14     14   1801667 debug(1, __PACKAGE__, '::_init');
79 14         35 my ($self) = @_;
80 14 100       82 ref($self) eq __PACKAGE__ or
81             fatal('_1_may_only_be_called_from_itself', __PACKAGE__);
82              
83 13         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 13         57402 local $_ = '' . `stty -a 2>/dev/null`; # ''. avoids undef!
87 13 50       499 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 13         136 $self->{max_height} = $rows;
91 13         480 $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 5103 my ($self) = @_;
115 5         24 my $n = $self->children;
116 5         7 my $i = 0; # behave like Curses::UI and Tk: 1st comes 1st
117 5         18 debug(1, __PACKAGE__, '::mainloop: ', $i, ' / ', $n);
118              
119 5         7 local $_;
120 5         15 while ($n > 0)
121             {
122 16         41 $_ = $self->child($i)->_process;
123 16         39 $n = $self->children;
124             # uncoverable branch false count:4
125 16 100       54 if (not defined $_)
    100          
    100          
    50          
126 8         12 { $i = $n - 1; }
127             elsif ($_ eq '+')
128 1         2 { $i++; }
129             elsif ($_ eq '-')
130 1         3 { $i--; }
131             elsif ($_ eq '0')
132 6         11 { $i = $n - 1; }
133 16 100       46 if ($i >= $n)
    100          
134 1         3 { $i = 0; }
135             elsif ($i < 0)
136 6         19 { $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