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