← Back to branch summary

~ubuntu-branches/ubuntu/trusty/libui-dialog-perl/trusty

« back to all changes in this revision

Viewing changes to lib/UI/Dialog/Backend/ASCII.pm

  • Committer: Bazaar Package Importer
  • Author(s): Alejandro Garrido Mota
  • Date: 2006-09-11 13:22:41 UTC
  • Revision ID: james.westby@ubuntu.com-20060911132241-wv52paqsgjf2aax9
Tags: upstream-1.08
Import upstream version 1.08

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/UI/Dialog/Backend/ASCII.pm
 
1
package UI::Dialog::Backend::ASCII;
 
2
###############################################################################
 
3
#  Copyright (C) 2004  Kevin C. Krinke <kckrinke@opendoorsoftware.com>
 
4
#
 
5
#  This library is free software; you can redistribute it and/or
 
6
#  modify it under the terms of the GNU Lesser General Public
 
7
#  License as published by the Free Software Foundation; either
 
8
#  version 2.1 of the License, or (at your option) any later version.
 
9
#
 
10
#  This library is distributed in the hope that it will be useful,
 
11
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
 
12
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 
13
#  Lesser General Public License for more details.
 
14
#
 
15
#  You should have received a copy of the GNU Lesser General Public
 
16
#  License along with this library; if not, write to the Free Software
 
17
#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307 USA
 
18
###############################################################################
 
19
use 5.006;
 
20
use strict;
 
21
use Carp;
 
22
use UI::Dialog::Backend;
 
23
use Time::HiRes qw( sleep );
 
24
 
 
25
BEGIN {
 
26
    use vars qw( $VERSION @ISA );
 
27
    @ISA = qw( UI::Dialog::Backend );
 
28
    $VERSION = '1.08';
 
29
}
 
30
 
 
31
$| = 1;                                                 # turn on autoflush
 
32
 
 
33
#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
 
34
#: Constructor Method
 
35
#:
 
36
 
 
37
sub new {
 
38
    my $proto = shift();
 
39
    my $class = ref($proto) || $proto;
 
40
    my $cfg = ((ref($_[0]) eq "HASH") ? $_[0] : (@_) ? { @_ } : {});
 
41
    my $self = {};
 
42
    bless($self, $class);
 
43
    $self->{'_state'} = {};
 
44
    $self->{'_opts'} = {};
 
45
 
 
46
        #: Dynamic path discovery...
 
47
        my $CFG_PATH = $cfg->{'PATH'};
 
48
        if ($CFG_PATH) {
 
49
                if (ref($CFG_PATH) eq "ARRAY") { $self->{'PATHS'} = $CFG_PATH; }
 
50
                elsif ($CFG_PATH =~ m!:!) { $self->{'PATHS'} = [ split(/:/,$CFG_PATH) ]; }
 
51
                elsif (-d $CFG_PATH) { $self->{'PATHS'} = [ $CFG_PATH ]; }
 
52
        } elsif ($ENV{'PATH'}) { $self->{'PATHS'} = [ split(/:/,$ENV{'PATH'}) ]; }
 
53
        else { $self->{'PATHS'} = ''; }
 
54
 
 
55
    $self->{'_opts'}->{'callbacks'} = $cfg->{'callbacks'} || undef();
 
56
    $self->{'_opts'}->{'timeout'} = $cfg->{'timeout'} || 0;
 
57
    $self->{'_opts'}->{'wait'} = $cfg->{'wait'} || 0;
 
58
    $self->{'_opts'}->{'debug'} = $cfg->{'debug'} || undef();
 
59
    $self->{'_opts'}->{'title'} = $cfg->{'title'} || undef();
 
60
    $self->{'_opts'}->{'backtitle'} = $cfg->{'backtitle'} || undef();
 
61
    $self->{'_opts'}->{'usestderr'} = $cfg->{'usestderr'} || 0;
 
62
    $self->{'_opts'}->{'extra-button'} = $cfg->{'extra-button'} || 0;
 
63
    $self->{'_opts'}->{'extra-label'} = $cfg->{'extra-label'} || undef();
 
64
    $self->{'_opts'}->{'help-button'} = $cfg->{'help-button'} || 0;
 
65
    $self->{'_opts'}->{'help-label'} = $cfg->{'help-label'} || undef();
 
66
    $self->{'_opts'}->{'nocancel'} = $cfg->{'nocancel'} || 0;
 
67
    $self->{'_opts'}->{'maxinput'} = $cfg->{'maxinput'} || 0;
 
68
    $self->{'_opts'}->{'defaultno'} = $cfg->{'defaultno'} || 0;
 
69
    $self->{'_opts'}->{'autoclear'} = $cfg->{'autoclear'} || 0;
 
70
    $self->{'_opts'}->{'clearbefore'} = $cfg->{'clearbefore'} || 0;
 
71
    $self->{'_opts'}->{'clearafter'} = $cfg->{'clearafter'} || 0;
 
72
    $self->{'_opts'}->{'beepbin'} = $cfg->{'beepbin'} || $self->_find_bin('beep') || '/usr/bin/beep';
 
73
    $self->{'_opts'}->{'beepbefore'} = $cfg->{'beepbefore'} || 0;
 
74
    $self->{'_opts'}->{'beepafter'} = $cfg->{'beepafter'} || 0;
 
75
    $self->{'_opts'}->{'pager'} = ( $cfg->{'pager'}           ||
 
76
                                                                        $self->_find_bin('pager') ||
 
77
                                                                        $self->_find_bin('less')  ||
 
78
                                                                        $self->_find_bin('more')  );
 
79
    $self->{'_opts'}->{'stty'} = $cfg->{'stty'} || $self->_find_bin('stty');
 
80
 
 
81
    $self->{'_state'} = {'rv'=>0};
 
82
 
 
83
    return($self);
 
84
}
 
85
 
 
86
#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
 
87
#: Iherited Overrides
 
88
#:
 
89
 
 
90
sub _organize_text {
 
91
    my $self = shift();
 
92
    my $text = shift() || return();
 
93
    my @array;
 
94
    if (ref($text) eq "ARRAY") { push(@array,@{$text}); }
 
95
    elsif ($text =~ /\\n/) { @array = split(/\\n/,$text); }
 
96
    else { @array = split(/\n/,$text); }
 
97
    $text = undef();
 
98
    $text = join("\n",@array);
 
99
    return($self->_strip_text($text));
 
100
}
 
101
sub _merge_attrs {
 
102
    my $self = shift();
 
103
    my $args = (@_ % 2) ? { @_, '_odd' } : { @_ };
 
104
    my $defs = $self->{'_opts'};
 
105
    foreach my $def (keys(%$defs)) {
 
106
                $args->{$def} = $defs->{$def} unless $args->{$def};
 
107
    }
 
108
    # alias 'filename' and 'file' to path
 
109
    $args->{'path'} = (($args->{'filename'}) ? $args->{'filename'} :
 
110
                                           ($args->{'file'}) ? $args->{'file'} :
 
111
                                           ($args->{'path'}) ? $args->{'path'} : "");
 
112
    $args->{'clear'} = $args->{'clearbefore'} || $args->{'clearafter'} || $args->{'autoclear'} || 0;
 
113
    $args->{'beep'} = $args->{'beepbefore'} || $args->{'beepafter'} || $args->{'autobeep'} || 0;
 
114
    return($args);
 
115
}
 
116
 
 
117
#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
 
118
#: Private Methods
 
119
#:
 
120
 
 
121
#: this is the dynamic 'Colon Command Help'
 
122
sub _WRITE_HELP_TEXT {
 
123
    my $self = shift();
 
124
    my ($head,$foot);
 
125
    my $body = "
 
126
Colon Commands: [':?' (This help message)], [':pg <N>' (Go to page 'N')],
 
127
 [':n'|':next' (Go to the next page)], [':p'|':prev' (Go to the previous page)],
 
128
 [':esc'|':escape' (Send the [Esc] signal)].
 
129
";
 
130
        #    $head .= ("~" x 79);
 
131
    if ($self->{'_opts'}->{'extra-button'} || $self->{'_opts'}->{'extra-label'}) {
 
132
                $foot .= "[':e'|':extra' (Send the [Extra] signal)]\n";
 
133
    }
 
134
    if (!$self->{'_opts'}->{'nocancel'}) {
 
135
                $foot .= "[':c'|':cancel' (Send the [Cancel] signal)]\n";
 
136
    }
 
137
    if ($self->{'_opts'}->{'help-button'} || $self->{'_opts'}->{'help-label'}) {
 
138
                $foot .= "[':h'|':help' (Send the [Help] signal)]\n";
 
139
    }
 
140
        #    $foot .= ("~" x 79)."\n";
 
141
        #    $self->msgbox(title=>'Colon Command Help',text=>$head.$body.$foot);
 
142
    $self->msgbox(title=>'Colon Command Help',text=>$body.$foot);
 
143
}
 
144
 
 
145
#: this returns the labels (or ' ') for the "extra", "help" and
 
146
#: "cancel" buttons.
 
147
sub _BUTTONS {
 
148
    my $self = shift();
 
149
    my $cfg = $self->_merge_attrs(@_);
 
150
    my ($help,$cancel,$extra) = (' ',' ',' ');
 
151
    $extra = "Extra" if $cfg->{'extra-button'};
 
152
    $extra = $cfg->{'extra-label'} if $cfg->{'extra-label'};
 
153
    $extra = "':e'=[".$extra."]" if $extra and $extra ne ' ';
 
154
    $help = "Help" if $cfg->{'help-button'};
 
155
    $help = $self->{'help-label'} if $cfg->{'help-label'};
 
156
    $help = "':h'=[".$help."]" if $help and $help ne ' ';
 
157
    $cancel = "Cancel" unless $cfg->{'nocancel'};
 
158
    $cancel = $cfg->{'cancellabel'} if $cfg->{'cancellabel'};
 
159
    $cancel = "':c'=[".$cancel."]" if $cancel and $cancel ne ' ';
 
160
    return($help,$cancel,$extra);
 
161
}
 
162
 
 
163
 
 
164
#: this writes a standard ascii interface to STDOUT. This is intended for use
 
165
#: with any non-list native ascii mode widgets.
 
166
sub _WRITE_TEXT {
 
167
    my $self = shift();
 
168
    my $cfg = $self->_merge_attrs(@_);
 
169
    my $text = $self->_organize_text($cfg->{'text'}) || " ";
 
170
    my $backtitle = $cfg->{'backtitle'} || " ";
 
171
    my $title = $cfg->{'title'} || " ";
 
172
    format ASCIIPGTXT =
 
173
+-----------------------------------------------------------------------------+
 
174
| @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< |
 
175
$backtitle
 
176
+-----------------------------------------------------------------------------+
 
177
|                                                                             |
 
178
| +-------------------------------------------------------------------------+ |
 
179
| | @|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| | |
 
180
$title
 
181
| +-------------------------------------------------------------------------+ |
 
182
| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | |
 
183
$text
 
184
| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | |
 
185
$text
 
186
| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | |
 
187
$text
 
188
| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | |
 
189
$text
 
190
| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | |
 
191
$text
 
192
| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | |
 
193
$text
 
194
| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | |
 
195
$text
 
196
| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | |
 
197
$text
 
198
| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | |
 
199
$text
 
200
| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | |
 
201
$text
 
202
| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | |
 
203
$text
 
204
| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | |
 
205
$text
 
206
| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | |
 
207
$text
 
208
| +-------------------------------------------------------------------------+ |
 
209
|                                                                             |
 
210
+-----------------------------------------------------------------------------+
 
211
.
 
212
    no strict 'subs';
 
213
    my $_fh = select();
 
214
    select(STDERR) unless not $cfg->{'usestderr'};
 
215
    my $LFMT = $~;
 
216
    $~ = ASCIIPGTXT;
 
217
    write();
 
218
    $~= $LFMT;
 
219
    select($_fh) unless not $cfg->{'usestderr'};
 
220
    use strict 'subs';
 
221
}
 
222
 
 
223
#: very much like _WRITE_TEXT() except that this is specifically for
 
224
#: the menu() widget only.
 
225
sub _WRITE_MENU {
 
226
    my $self = shift();
 
227
    my $cfg = $self->_merge_attrs(@_);
 
228
    my $text = $self->_organize_text($cfg->{'text'}) || " ";
 
229
    my $backtitle = $cfg->{'backtitle'} || " ";
 
230
    my $title = $cfg->{'title'} || " ";
 
231
    my $menu = $cfg->{'menu'} || [];
 
232
    my ($help,$cancel,$extra) = $self->_BUTTONS(@_);
 
233
    format ASCIIPGMNU =
 
234
+-----------------------------------------------------------------------------+
 
235
| @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< |
 
236
$backtitle
 
237
+-----------------------------------------------------------------------------+
 
238
|                                                                             |
 
239
| +-------------------------------------------------------------------------+ |
 
240
| | @|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| | |
 
241
$title
 
242
| +-------------------------------------------------------------------------+ |
 
243
| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | |
 
244
$text
 
245
| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | |
 
246
$text
 
247
| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | |
 
248
$text
 
249
| +-------------------------------------------------------------------------+ |
 
250
|  @<<<< @<<<<<<<<<<<<<<<    @<<<< @<<<<<<<<<<<<<<<    @<<<< @<<<<<<<<<<<<<<  |
 
251
($menu->[0]||' '),($menu->[1]||' '),($menu->[2]||' '),($menu->[3]||' '),($menu->[4]||' '),($menu->[5]||' ')
 
252
|  @<<<< @<<<<<<<<<<<<<<<    @<<<< @<<<<<<<<<<<<<<<    @<<<< @<<<<<<<<<<<<<<  |
 
253
($menu->[6]||' '),($menu->[7]||' '),($menu->[8]||' '),($menu->[9]||' '),($menu->[10]||' '),($menu->[11]||' ')
 
254
|  @<<<< @<<<<<<<<<<<<<<<    @<<<< @<<<<<<<<<<<<<<<    @<<<< @<<<<<<<<<<<<<<  |
 
255
($menu->[12]||' '),($menu->[13]||' '),($menu->[14]||' '),($menu->[15]||' '),($menu->[16]||' '),($menu->[17]||' ')
 
256
|  @<<<< @<<<<<<<<<<<<<<<    @<<<< @<<<<<<<<<<<<<<<    @<<<< @<<<<<<<<<<<<<<  |
 
257
($menu->[18]||' '),($menu->[19]||' '),($menu->[20]||' '),($menu->[21]||' '),($menu->[22]||' '),($menu->[23]||' ')
 
258
|  @<<<< @<<<<<<<<<<<<<<<    @<<<< @<<<<<<<<<<<<<<<    @<<<< @<<<<<<<<<<<<<<  |
 
259
($menu->[24]||' '),($menu->[25]||' '),($menu->[26]||' '),($menu->[27]||' '),($menu->[28]||' '),($menu->[29]||' ')
 
260
|  @<<<< @<<<<<<<<<<<<<<<    @<<<< @<<<<<<<<<<<<<<<    @<<<< @<<<<<<<<<<<<<<  |
 
261
($menu->[30]||' '),($menu->[31]||' '),($menu->[32]||' '),($menu->[33]||' '),($menu->[34]||' '),($menu->[35]||' ')
 
262
|  @<<<< @<<<<<<<<<<<<<<<    @<<<< @<<<<<<<<<<<<<<<    @<<<< @<<<<<<<<<<<<<<  |
 
263
($menu->[36]||' '),($menu->[37]||' '),($menu->[38]||' '),($menu->[39]||' '),($menu->[42]||' '),($menu->[43]||' ')
 
264
|  @<<<< @<<<<<<<<<<<<<<<    @<<<< @<<<<<<<<<<<<<<<    @<<<< @<<<<<<<<<<<<<<  |
 
265
($menu->[42]||' '),($menu->[43]||' '),($menu->[44]||' '),($menu->[45]||' '),($menu->[46]||' '),($menu->[47]||' ')
 
266
|  @<<<< @<<<<<<<<<<<<<<<    @<<<< @<<<<<<<<<<<<<<<    @<<<< @<<<<<<<<<<<<<<  |
 
267
($menu->[48]||' '),($menu->[49]||' '),($menu->[50]||' '),($menu->[51]||' '),($menu->[52]||' '),($menu->[53]||' ')
 
268
|      @||||||||||||||||||||  @|||||||||||||||||||  @|||||||||||||||||||      |
 
269
$extra,$cancel,$help
 
270
|                        ':?' = [Colon Command Help]                          |
 
271
+-----------------------------------------------------------------------------+
 
272
.
 
273
    no strict 'subs';
 
274
    my $_fh = select();
 
275
    select(STDERR) unless not $cfg->{'usestderr'};
 
276
    my $LFMT = $~;
 
277
    $~ = ASCIIPGMNU;
 
278
    write();
 
279
    $~= $LFMT;
 
280
    select($_fh) unless not $cfg->{'usestderr'};
 
281
    use strict 'subs';
 
282
}
 
283
 
 
284
#: very much like _WRITE_MENU() except that this is specifically for
 
285
#: the radiolist() and checklist() widgets only.
 
286
sub _WRITE_LIST {
 
287
    my $self = shift();
 
288
    my $cfg = $self->_merge_attrs(@_);
 
289
    my $text = $self->_organize_text($cfg->{'text'}) || " ";
 
290
    my $backtitle = $cfg->{'backtitle'} || " ";
 
291
    my $title = $cfg->{'title'} || " ";
 
292
    my $menu = [];
 
293
    push(@{$menu},@{$cfg->{'menu'}});
 
294
    my ($help,$cancel,$extra) = $self->_BUTTONS(@_);
 
295
    my $m = @{$menu};
 
296
 
 
297
    if ($cfg->{'wm'}) {
 
298
                for (my $i = 2; $i < $m; $i += 3) {
 
299
                        if ($menu->[$i] && $menu->[$i] =~ /on/i) { $menu->[$i] = '->'; }
 
300
                        else { $menu->[$i] = ' '; }
 
301
                }
 
302
    } else {
 
303
                my $mark;
 
304
                for (my $i = 2; $i < $m; $i += 3) {
 
305
                        if (!$mark && $menu->[$i] && $menu->[$i] =~ /on/i) { $menu->[$i] = '->'; $mark = 1; }
 
306
                        else { $menu->[$i] = ' '; }
 
307
                }
 
308
    }
 
309
 
 
310
    format ASCIIPGLST =
 
311
+-----------------------------------------------------------------------------+
 
312
| @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< |
 
313
$backtitle
 
314
+-----------------------------------------------------------------------------+
 
315
|                                                                             |
 
316
| +-------------------------------------------------------------------------+ |
 
317
| | @|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| | |
 
318
$title
 
319
| +-------------------------------------------------------------------------+ |
 
320
| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | |
 
321
$text
 
322
| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | |
 
323
$text
 
324
| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | |
 
325
$text
 
326
| +-------------------------------------------------------------------------+ |
 
327
|@<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<< |
 
328
($menu->[2]||' '),($menu->[0]||' '),($menu->[1]||' '), ($menu->[5]||' '),($menu->[3]||' '),($menu->[4]||' '), ($menu->[8]||' '),($menu->[6]||' '),($menu->[7]||' ')
 
329
|@<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<< |
 
330
($menu->[11]||' '),($menu->[9]||' '),($menu->[10]||' '), ($menu->[14]||' '),($menu->[12]||' '),($menu->[13]||' '), ($menu->[17]||' '),($menu->[15]||' '),($menu->[16]||' ')
 
331
|@<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<< |
 
332
($menu->[20]||' '),($menu->[18]||' '),($menu->[19]||' '), ($menu->[23]||' '),($menu->[21]||' '),($menu->[22]||' '), ($menu->[26]||' '),($menu->[24]||' '),($menu->[25]||' ')
 
333
|@<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<< |
 
334
($menu->[29]||' '),($menu->[27]||' '),($menu->[28]||' '), ($menu->[32]||' '),($menu->[30]||' '),($menu->[31]||' '), ($menu->[35]||' '),($menu->[33]||' '),($menu->[34]||' ')
 
335
|@<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<< |
 
336
($menu->[38]||' '),($menu->[36]||' '),($menu->[37]||' '), ($menu->[41]||' '),($menu->[39]||' '),($menu->[40]||' '), ($menu->[44]||' '),($menu->[42]||' '),($menu->[43]||' ')
 
337
|@<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<< |
 
338
($menu->[47]||' '),($menu->[45]||' '),($menu->[46]||' '), ($menu->[50]||' '),($menu->[48]||' '),($menu->[49]||' '), ($menu->[53]||' '),($menu->[51]||' '),($menu->[52]||' ')
 
339
|@<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<< |
 
340
($menu->[56]||' '),($menu->[54]||' '),($menu->[55]||' '), ($menu->[59]||' '),($menu->[57]||' '),($menu->[58]||' '), ($menu->[62]||' '),($menu->[60]||' '),($menu->[61]||' ')
 
341
|@<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<< |
 
342
($menu->[65]||' '),($menu->[63]||' '),($menu->[64]||' '), ($menu->[68]||' '),($menu->[66]||' '),($menu->[67]||' '), ($menu->[71]||' '),($menu->[69]||' '),($menu->[70]||' ')
 
343
|@<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<< |
 
344
($menu->[74]||' '),($menu->[72]||' '),($menu->[73]||' '), ($menu->[77]||' '),($menu->[75]||' '),($menu->[76]||' '), ($menu->[80]||' '),($menu->[78]||' '),($menu->[79]||' ')
 
345
|@<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<< |
 
346
($menu->[83]||' '),($menu->[81]||' '),($menu->[82]||' '), ($menu->[86]||' '),($menu->[84]||' '),($menu->[85]||' '), ($menu->[89]||' '),($menu->[87]||' '),($menu->[88]||' ')
 
347
|      @||||||||||||||||||||  @|||||||||||||||||||  @|||||||||||||||||||      |
 
348
$extra,$cancel,$help
 
349
|                        ':?' = [Colon Command Help]                          |
 
350
+-----------------------------------------------------------------------------+
 
351
.
 
352
    no strict 'subs';
 
353
    my $_fh = select();
 
354
    select(STDERR) unless not $cfg->{'usestderr'};
 
355
    my $LFMT = $~;
 
356
    $~ = ASCIIPGLST;
 
357
    write();
 
358
    $~= $LFMT;
 
359
    select($_fh) unless not $cfg->{'usestderr'};
 
360
    use strict 'subs';
 
361
}
 
362
 
 
363
sub _PRINT {
 
364
    my $self = shift();
 
365
    my $stderr = shift();
 
366
    if ($stderr) {
 
367
                print STDERR @_;
 
368
    } else {
 
369
                print STDOUT @_;
 
370
    }
 
371
}
 
372
 
 
373
#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
 
374
#: Public Methods
 
375
#:
 
376
 
 
377
#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
378
#: Ask a binary question (Yes/No)
 
379
sub yesno {
 
380
    my $self = shift();
 
381
    my $caller = (caller(1))[3] || 'main';
 
382
    $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
 
383
    if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }
 
384
    my $args = $self->_pre($caller,@_);
 
385
    my ($YN,$RESP) = ('Yes|no','YES_OR_NO');
 
386
    $YN = "yes|No" if $self->{'defaultno'};
 
387
    while ($RESP !~ /^(y|yes|n|no)$/i) {
 
388
                $self->_clear($args->{'clear'});
 
389
                $self->_WRITE_TEXT(@_,text=>$args->{'text'});
 
390
                $self->_PRINT($args->{'usestderr'},"(".$YN."): ");
 
391
                chomp($RESP = <STDIN>);
 
392
                if (!$RESP && $args->{'defaultno'}) { $RESP = "no"; }
 
393
                elsif (!$RESP && !$args->{'defaultno'}) { $RESP = "yes"; }
 
394
                if ($RESP =~ /^(y|yes)$/i) {
 
395
                        $self->ra("YES");
 
396
                        $self->rs("YES");
 
397
                        $self->rv('null');
 
398
                } else {
 
399
                        $self->ra("NO");
 
400
                        $self->rs("NO");
 
401
                        $self->rv(1);
 
402
                }
 
403
    }
 
404
    $self->_post($args);
 
405
    return(1) if $self->state() eq "OK";
 
406
    return(0);
 
407
}
 
408
 
 
409
#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
410
#: Text entry
 
411
sub inputbox {
 
412
    my $self = shift();
 
413
    my $caller = (caller(1))[3] || 'main';
 
414
    $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
 
415
    if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }
 
416
    my $args = $self->_pre($caller,@_);
 
417
    my $length = $args->{'maxinput'} + 1;
 
418
    my $text = $args->{'text'};
 
419
    my $string;
 
420
    chomp($text);
 
421
    while ($length > $args->{'maxinput'}) {
 
422
                $self->_clear($args->{'clear'});
 
423
                $self->_WRITE_TEXT(@_,'text'=>$args->{'text'});
 
424
                $self->_PRINT($args->{'usestderr'},"input: ");
 
425
                chomp($string = <STDIN>);
 
426
                if ($args->{'maxinput'}) {
 
427
                        $length = length($string);
 
428
                } else {
 
429
                        $length = 0;
 
430
                }
 
431
                if ($length > $args->{'maxinput'}) {
 
432
                        $self->_PRINT($args->{'usestderr'},"error: too many charaters input,".
 
433
                                                  " the maximum is: ".$args->{'maxinput'}."\n");
 
434
                }
 
435
    }
 
436
    $self->rv('null');
 
437
    $self->ra($string);
 
438
    $self->rs($string);
 
439
    $self->_post($args);
 
440
    return($string);
 
441
}
 
442
 
 
443
#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
444
#: Password entry
 
445
sub password {
 
446
    my $self = shift();
 
447
    my $caller = (caller(1))[3] || 'main';
 
448
    $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
 
449
    if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }
 
450
    my $args = $self->_pre($caller,@_);
 
451
    croak("The UI::Dialog::Backend::ASCII password widget depends on the stty ".
 
452
                  "binary. This was not found or is not executable.")
 
453
     unless -x $args->{'stty'};
 
454
    my ($length,$key) = ($args->{'maxinput'} + 1,'');
 
455
    my $string;
 
456
    my $text = $args->{'text'};
 
457
    chomp($text);
 
458
    my $ENV_PATH = $ENV{'PATH'};
 
459
    $ENV{'PATH'} = "";
 
460
    while ($length > $args->{'maxinput'}) {
 
461
                $self->_clear($args->{'clear'});
 
462
                $self->_WRITE_TEXT(@_,'text'=>$args->{'text'});
 
463
                $self->_PRINT($args->{'usestderr'},"input: ");
 
464
                if ($self->_is_bsd()) { system "$args->{'stty'} cbreak </dev/tty >/dev/tty 2>&1"; }
 
465
                else { system $args->{'stty'}, '-icanon', 'eol', "\001"; }
 
466
                while ($key = getc(STDIN)) {
 
467
                        last if $key =~ /\n/;
 
468
                        if ($key =~ /^\x1b$/) {
 
469
                                #this could be the DELETE key (not BS or ^H)
 
470
                                # ^[[3~ or \x1b\x5b\x33\x7e (aka: ESC + [ + 3 + ~)
 
471
                                my $key2 = getc(STDIN);
 
472
                                if ($key2 =~ /^\x5b$/) {
 
473
                                        my $key3 = getc(STDIN);
 
474
                                        if ($key3 =~ /^\x33$/) {
 
475
                                                my $key4 = getc(STDIN);
 
476
                                                if ($key4 =~ /^\x7e$/) {
 
477
                                                        chop($string);
 
478
                                                        # go back five spaces and print five spaces (erase ^[[3~)
 
479
                                                        # go back five spaces again (backtrack),
 
480
                                                        # go back one space, print a space and go back (erase *)
 
481
                                                        if ($args->{'usestderr'}) {
 
482
                                                                print STDERR "\b\b\b\b\b"."     "."\b\b\b\b\b"."\b \b";
 
483
                                                        } else {
 
484
                                                                print STDOUT "\b\b\b\b\b"."     "."\b\b\b\b\b"."\b \b";
 
485
                                                        }
 
486
                                                } else {
 
487
                                                        $key = $key.$key2.$key3.$key4;
 
488
                                                }
 
489
                                        } else {
 
490
                                                $key = $key.$key2.$key3;
 
491
                                        }
 
492
                                } else {
 
493
                                        $key = $key.$key2;
 
494
                                }
 
495
                        } elsif ($key =~ /^(?:\x08|\x7f)$/) {
 
496
                                # this is either a BS or ^H
 
497
                                chop($string);
 
498
                                # go back two spaces and print two spaces (erase ^H)
 
499
                                # go back two spaces again (backtrack),
 
500
                                # go back one space, print a space and go back (erase *)
 
501
                                if ($args->{'usestderr'}) {
 
502
                                        print STDERR "\b\b"."  "."\b\b"."\b \b";
 
503
                                } else {
 
504
                                        print STDOUT "\b\b"."  "."\b\b"."\b \b";
 
505
                                }
 
506
                        } else {
 
507
                                if ($args->{'usestderr'}) {
 
508
                                        print STDERR "\b*";
 
509
                                } else {
 
510
                                        print STDOUT "\b*";
 
511
                                }
 
512
                                $string .= $key;
 
513
                        }
 
514
                }
 
515
                if ($self->_is_bsd()) { system "$args->{'stty'} -cbreak </dev/tty >/dev/tty 2>&1"; }
 
516
                else { system $args->{'stty'}, 'icanon', 'eol', '^@'; }
 
517
                if ($args->{'maxinput'}) { $length = length($string); }
 
518
                else { $length = 0; }
 
519
                if ($length > $args->{'maxinput'}) {
 
520
                        $self->_PRINT($args->{'usestderr'},"error: too many charaters input,".
 
521
                                                  " the maximum is: ".$args->{'maxinput'}."\n");
 
522
                }
 
523
    }
 
524
    $ENV{'PATH'} = $ENV_PATH;
 
525
    $self->rv('null');
 
526
    $self->ra($string);
 
527
    $self->rs($string);
 
528
    $self->_post($args);
 
529
    return($string);
 
530
}
 
531
 
 
532
#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
533
#: Information box
 
534
sub infobox {
 
535
    my $self = shift();
 
536
    my $caller = (caller(1))[3] || 'main';
 
537
    $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
 
538
    if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }
 
539
    my $args = $self->_pre($caller,@_);
 
540
    $self->_WRITE_TEXT(@_,'text'=>$args->{'text'});
 
541
    $self->_PRINT($args->{'usestderr'});
 
542
    my $s = int(($args->{'wait'}) ? $args->{'wait'} :
 
543
                                ($args->{'timeout'}) ? ($args->{'timeout'} / 1000.0) : 1.0);
 
544
    sleep($s);
 
545
    $self->rv('null');
 
546
    $self->ra('null');
 
547
    $self->rs('null');
 
548
    $self->_post($args);
 
549
    return(1);
 
550
}
 
551
 
 
552
#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
553
#: Message box
 
554
sub msgbox {
 
555
    my $self = shift();
 
556
    my $caller = (caller(1))[3] || 'main';
 
557
    $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
 
558
    if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }
 
559
    my $args = $self->_pre($caller,@_);
 
560
    $self->_WRITE_TEXT(@_,'text'=>$args->{'text'});
 
561
    $self->_PRINT($args->{'usestderr'},(" " x 25)."[ Press Enter to Continue ]");
 
562
    my $junk = <STDIN>;
 
563
    $self->rv('null');
 
564
    $self->ra('null');
 
565
    $self->rs('null');
 
566
    $self->_post($args);
 
567
    return(1);
 
568
}
 
569
 
 
570
 
 
571
#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
572
#: Text box
 
573
sub textbox {
 
574
    my $self = shift();
 
575
    my $caller = (caller(1))[3] || 'main';
 
576
    $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
 
577
    if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }
 
578
    my $args = $self->_pre($caller,@_);
 
579
    my $rv = 0;
 
580
    if (-r $args->{'path'}) {
 
581
                my $ENV_PATH = $ENV{'PATH'};
 
582
                $ENV{'PATH'} = "";
 
583
                if ($ENV{'PAGER'} && -x $ENV{'PAGER'}) {
 
584
                        system($ENV{'PAGER'}." ".$args->{'path'});
 
585
                        $rv = $? >> 8;
 
586
                } elsif (-x $args->{'pager'}) {
 
587
                        system($args->{'pager'}." ".$args->{'path'});
 
588
                        $rv = $? >> 8;
 
589
                } else {
 
590
                        open(ATBFILE,"<".$args->{'path'});
 
591
                        local $/;
 
592
                        my $data = <ATBFILE>;
 
593
                        close(ATBFILE);
 
594
                        $self->_PRINT($args->{'usestderr'},$data);
 
595
                }
 
596
                $ENV{'PATH'} = $ENV_PATH;
 
597
    } else {
 
598
                return($self->msgbox('title'=>'error','text'=>$args->{'path'}.' is not a readable text file.'));
 
599
    }
 
600
    $self->rv($rv||'null');
 
601
    $self->ra('null');
 
602
    $self->rs('null');
 
603
    $self->_post($args);
 
604
    return($rv);
 
605
}
 
606
 
 
607
#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
608
#: A simple menu
 
609
sub menu {
 
610
    my $self = shift();
 
611
    my $caller = (caller(1))[3] || 'main';
 
612
    $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
 
613
    if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }
 
614
    my $args = $self->_pre($caller,@_);
 
615
    $args->{'menu'} = $args->{'list'} if ref($args->{'list'}) eq "ARRAY";
 
616
    my $string;
 
617
    my $rs = '';
 
618
    my $m;
 
619
    $m = @{$args->{'menu'}} if ref($args->{'menu'}) eq "ARRAY";
 
620
    my ($valid,$menu,$realm) = ([],[],[]);
 
621
    push(@{$menu},@{$args->{'menu'}}) if ref($args->{'menu'}) eq "ARRAY";
 
622
 
 
623
    for (my $i = 0; $i < $m; $i += 2) { push(@{$valid},$menu->[$i]); }
 
624
 
 
625
    if (@{$menu} >= 60) {
 
626
                my $c = 0;
 
627
                while (@{$menu}) {
 
628
                        $realm->[$c] = [];
 
629
                        for (my $i = 0; $i < 60; $i++) {
 
630
                                push(@{$realm->[$c]},shift(@{$menu}));
 
631
                        }
 
632
                        $c++;
 
633
                }
 
634
    } else {
 
635
                $realm->[0] = [];
 
636
                push(@{$realm->[0]},@{$menu});
 
637
    }
 
638
    my $pg = 1;
 
639
    while (!$rs) {
 
640
                $self->_WRITE_MENU(@_,'text'=>$args->{'text'},
 
641
                                                   'menu'=>$realm->[($pg - 1||0)]);
 
642
                $self->_PRINT($args->{'usestderr'},"(".$pg."/".@{$realm}."): ");
 
643
                chomp($rs = <STDIN>);
 
644
                if ($rs =~ /^:\?$/i) {
 
645
                        $self->_clear($args->{'clear'});
 
646
                        $self->_WRITE_HELP_TEXT();
 
647
                        undef($rs);
 
648
                        next;
 
649
                } elsif ($rs =~ /^:(esc|escape)$/i) {
 
650
                        $self->_clear($args->{'clear'});
 
651
                        undef($rs);
 
652
                        $self->rv(255);
 
653
                        return(0);
 
654
                } elsif (($args->{'extra-button'} || $args->{'extra-label'}) && $rs =~ /^:(e|extra)$/i) {
 
655
                        $self->rv(3);
 
656
                        return('EXTRA');
 
657
                } elsif ($args->{'help-button'} && $rs =~ /^:(h|help)$/i) {
 
658
                        $self->_clear($args->{'clear'});
 
659
                        undef($rs);
 
660
                        $self->rv(2);
 
661
                        return($self->state());
 
662
                } elsif (!$args->{'nocancel'} && $rs =~ /^:(c|cancel)$/i) {
 
663
                        $self->_clear($args->{'clear'});
 
664
                        undef($rs);
 
665
                        $self->rv(1);
 
666
                        return($self->state());
 
667
                } elsif ($rs =~ /^:pg\s*(\d+)$/i) {
 
668
                        my $p = $1;
 
669
                        if ($p <= @{$realm} && $p > 0) { $pg = $p; }
 
670
                        undef($rs);
 
671
                } elsif ($rs =~ /^:(n|next)$/i) {
 
672
                        if ($pg < @{$realm}) { $pg++; }
 
673
                        else { $pg = 1; }
 
674
                        undef($rs);
 
675
                } elsif ($rs =~ /^:(p|prev)$/i) {
 
676
                        if ($pg > 1) { $pg--; }
 
677
                        else { $pg = @{$realm}; }
 
678
                        undef($rs);
 
679
                } else {
 
680
                        if (@_ = grep { /^\Q$rs\E$/i } @{$valid}) { $rs = $_[0]; }
 
681
                        else { undef($rs); }
 
682
                }
 
683
                $self->_clear($args->{'clear'});
 
684
    }
 
685
 
 
686
    $self->rv('null');
 
687
    $self->ra($rs);
 
688
    $self->rs($rs);
 
689
    $self->_post($args);
 
690
    return($rs);
 
691
}
 
692
 
 
693
#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
694
#: A multi-selectable list
 
695
sub checklist {
 
696
    my $self = shift();
 
697
    my $caller = (caller(1))[3] || 'main';
 
698
    $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
 
699
    if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }
 
700
    my $args = $self->_pre($caller,@_);
 
701
    my $menulist = ($args->{'menu'} || $args->{'list'});
 
702
    my $menufix = [];
 
703
    if (ref($menulist) eq "ARRAY") {
 
704
                #: flatten our multidimensional array
 
705
                foreach my $item (@$menulist) {
 
706
                        if (ref($item) eq "ARRAY") {
 
707
                                pop(@{$item}) if @$item == 3;
 
708
                                push(@$menufix,@{$item});
 
709
                        } else {
 
710
                                push(@$menufix,$item);
 
711
                        }
 
712
                }
 
713
    }
 
714
    $args->{'menu'} = $menufix;
 
715
 
 
716
    my $ra = [];
 
717
    my $rs = '';
 
718
    my $m;
 
719
    $m = @{$args->{'menu'}} if ref($args->{'menu'}) eq "ARRAY";
 
720
    my ($valid,$menu,$realm) = ([],[],[]);
 
721
    push(@{$menu},@{$args->{'menu'}}) if ref($args->{'menu'}) eq "ARRAY";
 
722
 
 
723
    for (my $i = 0; $i < $m; $i += 3) { push(@{$valid},$menu->[$i]); }
 
724
 
 
725
    if (@{$menu} >= 90) {
 
726
                my $c = 0;
 
727
                while (@{$menu}) {
 
728
                        $realm->[$c] = [];
 
729
                        for (my $i = 0; $i < 90; $i++) {
 
730
                                push(@{$realm->[$c]},shift(@{$menu}));
 
731
                        }
 
732
                        $c++;
 
733
                }
 
734
    } else {
 
735
                $realm->[0] = [];
 
736
                push(@{$realm->[0]},@{$menu});
 
737
    }
 
738
    my $go = "GO";
 
739
    my $pg = 1;
 
740
    while ($go) {
 
741
                $self->_WRITE_LIST(@_,'wm'=>'check','text'=>$args->{'text'},'menu'=>$realm->[($pg - 1||0)]);
 
742
                $self->_PRINT($args->{'usestderr'},"(".$pg."/".@{$realm}."): ");
 
743
                chomp($rs = <STDIN>);
 
744
                if ($rs =~ /^:\?$/i) {
 
745
                        $self->_clear($args->{'clear'});
 
746
                        $self->_WRITE_HELP_TEXT();
 
747
                        undef($rs);
 
748
                        next;
 
749
                } elsif ($rs =~ /^:(esc|escape)$/i) {
 
750
                        $self->_clear($args->{'clear'});
 
751
                        undef($rs);
 
752
                        $self->rv(255);
 
753
                        return($self->state());
 
754
                } elsif (($args->{'extra-button'} || $args->{'extra-label'}) && $rs =~ /^:(e|extra)$/i) {
 
755
                        $self->_clear($args->{'clear'});
 
756
                        $self->rv(3);
 
757
                        return($self->state());
 
758
                } elsif (($args->{'help-button'} || $args->{'help-label'}) && $rs =~ /^:(h|help)$/i) {
 
759
                        $self->_clear($args->{'clear'});
 
760
                        undef($rs);
 
761
                        $self->rv(2);
 
762
                        return($self->rv());
 
763
                } elsif (!$args->{'nocancel'} && $rs =~ /^:(c|cancel)$/i) {
 
764
                        $self->_clear($args->{'clear'});
 
765
                        undef($rs);
 
766
                        $self->rv(1);
 
767
                        return($self->state());
 
768
                } elsif ($rs =~ /^:pg\s*(\d+)$/i) {
 
769
                        my $p = $1;
 
770
                        if ($p <= @{$realm} && $p > 0) { $pg = $p; }
 
771
                } elsif ($rs =~ /^:(n|next)$/i) {
 
772
                        if ($pg < @{$realm}) { $pg++; }
 
773
                        else { $pg = 1; }
 
774
                } elsif ($rs =~ /^:(p|prev)$/i) {
 
775
                        if ($pg > 1) { $pg--; }
 
776
                        else { $pg = @{$realm}; }
 
777
                } else {
 
778
                        my @opts = split(/\,\s|\,|\s/,$rs);
 
779
                        my @good;
 
780
                        foreach my $opt (@opts) {
 
781
                                if (@_ = grep { /^\Q$opt\E$/i } @{$valid}) { push(@good,$_[0]); }
 
782
                        }
 
783
                        if (@opts == @good) {
 
784
                                undef($go);
 
785
                                $ra = [];
 
786
                                push(@{$ra},@good);
 
787
                        }
 
788
                }
 
789
                $self->_clear($args->{'clear'});
 
790
                undef($rs);
 
791
    }
 
792
 
 
793
    $self->rv('null');
 
794
    $self->ra($ra);
 
795
    $self->rs(join("\n",@$ra));
 
796
    $self->_post($args);
 
797
    return(@{$ra});
 
798
}
 
799
 
 
800
#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
801
#: A radio button based list. very much like the menu widget.
 
802
sub radiolist {
 
803
    my $self = shift();
 
804
    my $caller = (caller(1))[3] || 'main';
 
805
    $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
 
806
    if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }
 
807
    my $args = $self->_pre($caller,@_);
 
808
    my $menulist = ($args->{'menu'} || $args->{'list'});
 
809
    my $menufix = [];
 
810
    if (ref($menulist) eq "ARRAY") {
 
811
                #: flatten our multidimensional array
 
812
                foreach my $item (@$menulist) {
 
813
                        if (ref($item) eq "ARRAY") {
 
814
                                pop(@{$item}) if @$item == 3;
 
815
                                push(@$menufix,@{$item});
 
816
                        } else {
 
817
                                push(@$menufix,$item);
 
818
                        }
 
819
                }
 
820
    }
 
821
    $args->{'menu'} = $menufix;
 
822
    my $rs = '';
 
823
    my $m;
 
824
    $m = @{$args->{'menu'}} if ref($args->{'menu'}) eq "ARRAY";
 
825
    my ($valid,$menu,$realm) = ([],[],[]);
 
826
    push(@{$menu},@{$args->{'menu'}}) if ref($args->{'menu'}) eq "ARRAY";
 
827
 
 
828
    for (my $i = 0; $i < $m; $i += 3) { push(@{$valid},$menu->[$i]); }
 
829
 
 
830
    if (@{$menu} >= 90) {
 
831
                my $c = 0;
 
832
                while (@{$menu}) {
 
833
                        $realm->[$c] = [];
 
834
                        for (my $i = 0; $i < 90; $i++) {
 
835
                                push(@{$realm->[$c]},shift(@{$menu}));
 
836
                        }
 
837
                        $c++;
 
838
                }
 
839
    } else {
 
840
                $realm->[0] = [];
 
841
                push(@{$realm->[0]},@{$menu});
 
842
    }
 
843
    my $pg = 1;
 
844
    while (!$rs) {
 
845
                $self->_WRITE_LIST(@_,'text'=>$args->{'text'},'menu'=>$realm->[($pg - 1||0)]);
 
846
                $self->_PRINT($args->{'usestderr'},"(".$pg."/".@{$realm}."): ");
 
847
                chomp($rs = <STDIN>);
 
848
                if ($rs =~ /^:\?$/i) {
 
849
                        $self->_clear($args->{'clear'});
 
850
                        $self->_WRITE_HELP_TEXT();
 
851
                        undef($rs);
 
852
                        next;
 
853
                } elsif ($rs =~ /^:(esc|escape)$/i) {
 
854
                        $self->_clear($args->{'clear'});
 
855
                        undef($rs);
 
856
                        $self->rv(255);
 
857
                        return($self->rv());
 
858
                } elsif (($args->{'extra-button'} || $args->{'extra-label'}) && $rs =~ /^:(e|extra)$/i) {
 
859
                        $self->rv(3);
 
860
                        return($self->state());
 
861
                } elsif (($args->{'help-button'} || $args->{'help-label'}) && $rs =~ /^:(h|help)$/i) {
 
862
                        $self->_clear($args->{'clear'});
 
863
                        undef($rs);
 
864
                        $self->rv(2);
 
865
                        return($self->state());
 
866
                } elsif (!$args->{'nocancel'} && $rs =~ /^:(c|cancel)$/i) {
 
867
                        $self->_clear($args->{'clear'});
 
868
                        undef($rs);
 
869
                        $self->rv(1);
 
870
                        return($self->state());
 
871
                } elsif ($rs =~ /^:pg\s*(\d+)$/i) {
 
872
                        my $p = $1;
 
873
                        if ($p <= @{$realm} && $p > 0) { $pg = $p; }
 
874
                        undef($rs);
 
875
                } elsif ($rs =~ /^:(n|next)$/i) {
 
876
                        if ($pg < @{$realm}) { $pg++; }
 
877
                        else { $pg = 1; }
 
878
                        undef($rs);
 
879
                } elsif ($rs =~ /^:(p|prev)$/i) {
 
880
                        if ($pg > 1) { $pg--; }
 
881
                        else { $pg = @{$realm}; }
 
882
                        undef($rs);
 
883
                } else {
 
884
                        if (@_ = grep { /^\Q$rs\E$/i } @{$valid}) { $rs = $_[0]; }
 
885
                        else { undef($rs); }
 
886
                }
 
887
                $self->_clear($args->{'clear'});
 
888
    }
 
889
 
 
890
    $self->rv('null');
 
891
    $self->ra($rs);
 
892
    $self->rs($rs);
 
893
    $self->_post($args);
 
894
    return($rs);
 
895
}
 
896
 
 
897
 
 
898
#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
899
#: Simple ASCII progress indicator :)
 
900
sub spinner {
 
901
        my $self = shift();
 
902
        if (!$self->{'__SPIN'} || $self->{'__SPIN'} == 1) { $self->{'__SPIN'} = 2; return("\b|"); }
 
903
        elsif ($self->{'__SPIN'} == 2) { $self->{'__SPIN'} = 3; return("\b/"); }
 
904
        elsif ($self->{'__SPIN'} == 3) { $self->{'__SPIN'} = 4; return("\b-"); }
 
905
        elsif ($self->{'__SPIN'} == 4) { $self->{'__SPIN'} = 1; return("\b\\"); }
 
906
}
 
907
 
 
908
#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
909
#: Simple ASCII meter bar
 
910
# the idea of a "true" dialog like gauge widget with ASCII is not that bad and
 
911
# as such, I've named these methods differently so as to keep the namespace
 
912
# open for gauge_*() widgets.
 
913
sub draw_gauge {
 
914
    my $self = shift();
 
915
    my $args = $self->_merge_attrs(@_);
 
916
    my $length = $args->{'length'} || $args->{'width'} || 74;
 
917
    my $bar = ($args->{'bar'} || "-") x $length;
 
918
    my $current = $args->{'current'} || 0;
 
919
    my $total = $args->{'total'} || 0;
 
920
    my $percent = (($current && $total) ? int($current / ($total / 100)) :
 
921
                                   ($args->{'percent'} || '0'));
 
922
    $percent = int(($percent <= 100 && $percent >= 0) ? $percent : 0 );
 
923
    my $perc = int((($length / 100) * $percent));
 
924
    substr($bar,($perc||0),1,($args->{'mark'}||"|"));
 
925
    my $text = (($percent =~ /^\d$/) ? "  " :
 
926
                                ($percent =~ /^\d\d$/) ? " " : "").$percent."% ".$bar;
 
927
    $self->_PRINT($args->{'usestderr'},(($args->{'noCR'} && not $args->{'CR'}) ? "" : "\x0D").$text);
 
928
    return($percent||1);
 
929
}
 
930
sub end_gauge {
 
931
    my $self = shift();
 
932
    my $args = $self->_merge_attrs(@_);
 
933
    $self->_PRINT($args->{'usestderr'},"\n");
 
934
}
 
935
 
 
936
1;