File Coverage

blib/lib/UI/Dialog/Backend/CDialog.pm
Criterion Covered Total %
statement 60 736 8.1
branch 7 230 3.0
condition 19 321 5.9
subroutine 11 42 26.1
pod 24 27 88.8
total 121 1356 8.9


line stmt bran cond sub pod time code
1             package UI::Dialog::Backend::CDialog;
2             ###############################################################################
3             # Copyright (C) 2015 Kevin C. Krinke
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 2     2   26515 use 5.006;
  2         7  
20 2     2   11 use strict;
  2         2  
  2         42  
21 2     2   10 use Config;
  2         3  
  2         79  
22 2     2   1514 use FileHandle;
  2         24386  
  2         12  
23 2     2   867 use Carp;
  2         4  
  2         117  
24 2     2   11 use Cwd qw( abs_path );
  2         3  
  2         89  
25 2     2   1750 use Time::HiRes qw( sleep );
  2         3022  
  2         8  
26 2     2   1624 use UI::Dialog::Backend;
  2         6  
  2         97  
27              
28             BEGIN {
29 2     2   17 use vars qw( $VERSION @ISA );
  2         6  
  2         132  
30 2     2   22 @ISA = qw( UI::Dialog::Backend );
31 2         17150 $VERSION = '1.12';
32             }
33              
34             #::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
35             #: Constructor Method
36             #:
37              
38             sub new {
39 1     1 1 758 my $proto = shift();
40 1   33     27 my $class = ref($proto) || $proto;
41 1 50       9 my $cfg = ((ref($_[0]) eq "HASH") ? $_[0] : (@_) ? { @_ } : {});
    50          
42 1         2 my $self = {};
43 1         3 bless($self, $class);
44 1         9 $self->{'_state'} = {};
45 1         2 $self->{'_opts'} = {};
46              
47             #: Dynamic path discovery...
48 1         15 my $path_sep = $Config::Config{path_sep};
49 1         4 my $CFG_PATH = $cfg->{'PATH'};
50 1 50       6 if ($CFG_PATH) {
    50          
51 0 0       0 if (ref($CFG_PATH) eq "ARRAY") {
    0          
    0          
52 0         0 $self->{'PATHS'} = $CFG_PATH;
53             }
54             elsif ($CFG_PATH =~ m!$path_sep!) {
55 0         0 $self->{'PATHS'} = [ split(/$path_sep/,$CFG_PATH) ];
56             }
57             elsif (-d $CFG_PATH) {
58 0         0 $self->{'PATHS'} = [ $CFG_PATH ];
59             }
60             }
61             elsif ($ENV{'PATH'}) {
62 1         17 $self->{'PATHS'} = [ split(/$path_sep/,$ENV{'PATH'}) ];
63             }
64             else {
65 0         0 $self->{'PATHS'} = '';
66             }
67              
68 1   50     9 $self->{'_opts'}->{'literal'} = $cfg->{'literal'} || 0;
69 1   50     9 $self->{'_opts'}->{'callbacks'} = $cfg->{'callbacks'} || undef();
70 1   50     6 $self->{'_opts'}->{'timeout'} = $cfg->{'timeout'} || 0;
71 1   50     7 $self->{'_opts'}->{'wait'} = $cfg->{'wait'} || 0;
72 1   50     20 $self->{'_opts'}->{'debug'} = $cfg->{'debug'} || undef();
73 1   50     7 $self->{'_opts'}->{'title'} = $cfg->{'title'} || undef();
74 1   50     6 $self->{'_opts'}->{'backtitle'} = $cfg->{'backtitle'} || undef();
75 1   50     6 $self->{'_opts'}->{'width'} = $cfg->{'width'} || 65;
76 1   50     6 $self->{'_opts'}->{'height'} = $cfg->{'height'} || 10;
77 1   50     6 $self->{'_opts'}->{'percentage'} = $cfg->{'percentage'} || 1;
78 1 50 33     7 $self->{'_opts'}->{'colours'} = ($cfg->{'colours'} || $cfg->{'colors'}) ? 1 : 0;
79 1   33     19 $self->{'_opts'}->{'bin'} ||= $self->_find_bin('dialog');
80 1 50 0     7 $self->{'_opts'}->{'bin'} ||= $self->_find_bin('dialog.exe') if $^O =~ /win32/i;
81 1   50     8 $self->{'_opts'}->{'autoclear'} = $cfg->{'autoclear'} || 0;
82 1   50     12 $self->{'_opts'}->{'clearbefore'} = $cfg->{'clearbefore'} || 0;
83 1   50     11 $self->{'_opts'}->{'clearafter'} = $cfg->{'clearafter'} || 0;
84 1   50     11 $self->{'_opts'}->{'beepbin'} = $cfg->{'beepbin'} || $self->_find_bin('beep') || '/usr/bin/beep';
85 1   50     7 $self->{'_opts'}->{'beepbefore'} = $cfg->{'beepbefore'} || 0;
86 1   50     6 $self->{'_opts'}->{'beepafter'} = $cfg->{'beepafter'} || 0;
87 1 50       16 unless (-x $self->{'_opts'}->{'bin'}) {
88 1         208 croak("the dialog binary could not be found at: ".$self->{'_opts'}->{'bin'});
89             }
90 0   0       $self->{'_opts'}->{'DIALOGRC'} = $cfg->{'DIALOGRC'} || undef();
91 0           my $beginref = $cfg->{'begin'};
92 0 0         $self->{'_opts'}->{'begin'} = (ref($beginref) eq "ARRAY") ? $beginref : undef();
93 0   0       $self->{'_opts'}->{'cancel-label'} = $cfg->{'cancel-label'} || undef();
94 0   0       $self->{'_opts'}->{'defaultno'} = $cfg->{'defaultno'} || 0;
95 0   0       $self->{'_opts'}->{'default-item'} = $cfg->{'default-item'} || undef();
96 0   0       $self->{'_opts'}->{'exit-label'} = $cfg->{'exit-label'} || undef();
97 0   0       $self->{'_opts'}->{'extra-button'} = $cfg->{'extra-button'} || 0;
98 0   0       $self->{'_opts'}->{'extra-label'} = $cfg->{'extra-label'} || undef();
99 0   0       $self->{'_opts'}->{'help-button'} = $cfg->{'help-button'} || 0;
100 0   0       $self->{'_opts'}->{'help-label'} = $cfg->{'help-label'} || undef();
101 0   0       $self->{'_opts'}->{'max-input'} = $cfg->{'max-input'} || 0;
102 0   0       $self->{'_opts'}->{'no-cancel'} = $cfg->{'no-cancel'} || $cfg->{'nocancel'} || 0;
103 0   0       $self->{'_opts'}->{'no-collapse'} = $cfg->{'no-collapse'} || 0;
104 0   0       $self->{'_opts'}->{'no-shadow'} = $cfg->{'no-shadow'} || 0;
105 0   0       $self->{'_opts'}->{'ok-label'} = $cfg->{'ok-label'} || undef();
106 0   0       $self->{'_opts'}->{'shadow'} = $cfg->{'shadow'} || 0;
107 0   0       $self->{'_opts'}->{'tab-correct'} = $cfg->{'tab-correct'} || 0;
108 0   0       $self->{'_opts'}->{'tab-len'} = $cfg->{'tab-len'} || 0;
109 0   0       $self->{'_opts'}->{'listheight'} = $cfg->{'listheight'} || $cfg->{'menuheight'} || 5;
110 0   0       $self->{'_opts'}->{'formheight'} = $cfg->{'formheight'} || $cfg->{'listheight'} || 5;
111 0   0       $self->{'_opts'}->{'yes-label'} = $cfg->{'yes-label'} || undef();
112 0   0       $self->{'_opts'}->{'no-label'} = $cfg->{'no-label'} || undef();
113              
114 0   0       $self->{'_opts'}->{'trust-input'} = $cfg->{'trust-input'} || 0;
115              
116 0           $self->_determine_dialog_variant();
117              
118 0 0         $self->{'test_mode'} = $cfg->{'test_mode'} if exists $cfg->{'test_mode'};
119 0           $self->{'test_mode_result'} = '';
120              
121 0           return($self);
122             }
123              
124             #::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
125             #: Private Methods
126             #:
127             sub _determine_dialog_variant {
128 0     0     my $self = $_[0];
129 0           my $str = `$self->{'_opts'}->{'bin'} --help 2>&1`;
130 0 0         if ($str =~ /version\s0\.[34]/m) {
    0          
131             # this version does not support colours, so far just FreeBSD 4.8 has this
132             # ancient binary. Bugreport from Jeroen Bulten indicates that he's
133             # got a version 0.3 (patched to 0.4) installed. ugh...
134 0           $self->{'_variant'} = "dialog";
135             # the separate-output option seems to be the culprit of FreeBSD failure.
136 0           $self->{'_opts'}->{'force-no-separate-output'} = 1;
137             }
138             elsif ($str =~ /cdialog\s\(ComeOn\sDialog\!\)\sversion\s(\d+\.\d+.+)/) {
139             # We consider cdialog to be a colour supporting dialog variant all others
140             # are non-colourized and support only the base functionality :(
141 0           my $ver = $1;
142 0 0         if ($ver =~ /-200[3-9]/) {
143 0           $self->{'_variant'} = "cdialog";
144             # these versions support colours :)
145 0           $self->{'_opts'}->{'colours'} = 1;
146             }
147             else {
148 0           $self->{'_variant'} = "dialog";
149             }
150             }
151             else {
152 0           $self->{'_variant'} = "dialog";
153             }
154 0           undef($str);
155             }
156              
157             my $SIG_CODE = {};
158             sub _del_gauge {
159 0     0     my $CODE = $SIG_CODE->{$$};
160 0 0         unless (not ref($CODE)) {
161 0           delete($CODE->{'_GAUGE'});
162 0           $CODE->rv('1');
163 0           $CODE->rs('null');
164 0           $CODE->ra('null');
165 0           $SIG_CODE->{$$} = "";
166             }
167             }
168              
169             sub append_format_base {
170 0     0 0   my ($self,$args,$fmt) = @_;
171 0 0 0       $ENV{'DIALOGRC'} ||= ($args->{'DIALOGRC'} && -r $args->{'DIALOGRC'}) ? $args->{'DIALOGRC'} : "";
      0        
172 0           $ENV{'DIALOG_CANCEL'} = '1';
173 0           $ENV{'DIALOG_ERROR'} = '254';
174 0           $ENV{'DIALOG_ESC'} = '255';
175 0           $ENV{'DIALOG_EXTRA'} = '3';
176 0           $ENV{'DIALOG_HELP'} = '2';
177 0           $ENV{'DIALOG_OK'} = '0';
178 0           $fmt = $self->append_format_check($args,$fmt,'backtitle','--backtitle {{backtitle}}');
179 0           $fmt = $self->append_format_check($args,$fmt,"defaultno","--defaultno");
180 0           $fmt = $self->append_format_check($args,$fmt,"extra-button","--extra-button");
181 0           $fmt = $self->append_format_check($args,$fmt,"help-button","--help-button");
182 0           $fmt = $self->append_format_check($args,$fmt,"no-cancel","--no-cancel");
183 0           $fmt = $self->append_format_check($args,$fmt,"no-collapse","--no-collapse");
184 0           $fmt = $self->append_format_check($args,$fmt,"no-shadow","--no-shadow");
185 0           $fmt = $self->append_format_check($args,$fmt,"shadow","--shadow");
186 0           $fmt = $self->append_format_check($args,$fmt,"tab-correct","--tab-correct");
187 0           $fmt = $self->append_format_check($args,$fmt,"cancel-label","--cancel-label {{cancel-label}}");
188 0           $fmt = $self->append_format_check($args,$fmt,"default-item","--default-item {{default-item}}");
189 0           $fmt = $self->append_format_check($args,$fmt,"exit-label","--exit-label {{exit-label}}");
190 0           $fmt = $self->append_format_check($args,$fmt,"extra-label","--extra-label {{extra-label}}");
191 0           $fmt = $self->append_format_check($args,$fmt,"help-label","--help-label {{help-label}}");
192 0           $fmt = $self->append_format_check($args,$fmt,"max-input","--max-input {{max-input}}");
193 0           $fmt = $self->append_format_check($args,$fmt,"ok-label","--ok-label {{ok-label}}");
194 0           $fmt = $self->append_format_check($args,$fmt,"tab-len","--tab-len {{tab-len}}");
195 0           $fmt = $self->append_format_check($args,$fmt,"yes-label","--yes-label {{yes-label}}");
196 0           $fmt = $self->append_format_check($args,$fmt,"no-label","--no-label {{no-label}}");
197              
198 0 0         if ($self->{'_opts'}->{'force-no-separate-output'}) {
199 0           delete $args->{'separate-output'};
200             } else {
201 0           $fmt = $self->append_format_check($args,$fmt,"separate-output","--separate-output")
202             }
203 0 0         if ($self->is_cdialog()) {
204 0           $fmt = $self->append_format($fmt,'--colors');
205 0           $fmt = $self->append_format($fmt,'--cr-wrap');
206 0 0         if (exists $args->{'begin'}) {
207 0           my $begin = $args->{'begin'};
208 0 0         if (ref($begin) eq "ARRAY") {
209 0           $fmt = $self->append_format($fmt,'--begin '.$begin->[0].' '.$begin->[1]);
210             }
211             }
212             }
213 0           return $fmt;
214             }
215              
216             #::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
217             #: Override Inherited Methods
218             #:
219             sub command_state {
220 0     0 1   my $self = $_[0];
221 0           my $cmnd = $_[1];
222 0 0         if ($self->is_unit_test_mode()) {
223 0           $self->{'test_mode_result'} = $cmnd;
224 0           return 0;
225             }
226 0           $self->_debug("".$cmnd);
227 0 0         my $null_dev = $^O =~ /win32/i ? 'NUL:' : '/dev/null';
228 0           system($cmnd . " 2> $null_dev");
229 0           return($? >> 8);
230             }
231             sub command_string {
232 0     0 1   my $self = $_[0];
233 0           my $cmnd = $_[1];
234 0 0         if ($self->is_unit_test_mode()) {
235 0           $self->{'test_mode_result'} = $cmnd;
236 0 0         return (wantarray) ? (0,'') : '';
237             }
238 0           $self->_debug($cmnd);
239 0           $self->gen_tempfile_name(); # don't accept the first result
240 0           my $tmpfile = $self->gen_tempfile_name();
241 0           my $text;
242 0           system($cmnd." 2> ".$tmpfile);
243 0           my $rv = $? >> 8;
244 0 0 0       if (-f $tmpfile # don't assume the file exists
245             && open(WHIPF,"<".$tmpfile)) {
246 0           local $/;
247 0           $text = ;
248 0           close(WHIPF);
249 0           unlink($tmpfile);
250             }
251             else {
252 0           $text = "";
253             }
254 0 0         return($text) unless defined wantarray;
255 0 0         return (wantarray) ? ($rv,$text) : $text;
256             }
257             sub command_array {
258 0     0 1   my $self = $_[0];
259 0           my $cmnd = $_[1];
260 0 0         if ($self->is_unit_test_mode()) {
261 0           $self->{'test_mode_result'} = $cmnd;
262 0 0         return (wantarray) ? (0,[]) : [];
263             }
264 0           $self->_debug($cmnd);
265 0           $self->gen_tempfile_name(); # don't accept the first result
266 0           my $tmpfile = $self->gen_tempfile_name();
267 0           my $text;
268 0           system($cmnd." 2> ".$tmpfile);
269 0           my $rv = $? >> 8;
270 0 0 0       if (-f $tmpfile # don't assume the file exists
271             && open(WHIPF,"<".$tmpfile)) {
272 0           local $/;
273 0           $text = ;
274 0           close(WHIPF);
275 0           unlink($tmpfile);
276             }
277             else {
278 0           $text = "";
279             }
280 0 0         if ($self->{'_opts'}->{'force-no-separate-output'}) {
281             # a side effect of this forcible backwards compatibility is that any
282             # "tags" with spaces will get broken down. *shrugs* Not much I can
283             # do about this and because it's a minority of users with these
284             # ancient versions of dialog I'm not delving any deeper into it.
285 0 0         return([split(/\s/,$text)]) unless defined wantarray;
286 0 0         return (wantarray) ? ($rv,[split(/\s/,$text)]) : [split(/\s/,$text)];
287             }
288             else {
289 0 0         return([split("\n",$text)]) unless defined wantarray;
290 0 0         return (wantarray) ? ($rv,[split("\n",$text)]) : [split("\n",$text)];
291             }
292             }
293             sub _organize_text {
294 0     0     my $self = $_[0];
295 0   0       my $text = $_[1] || return();
296 0   0       my $width = $_[2] || 65;
297 0 0 0       my $trust = (exists $_[3] && defined $_[3]) ? $_[3] : '0';
298 0           my @array;
299              
300 0 0         if (ref($text) eq "ARRAY") {
    0          
301 0           push(@array,@{$text});
  0            
302             }
303             elsif ($text =~ /\\n/) {
304 0           @array = split(/\\n/,$text);
305             }
306             else {
307 0           @array = split(/\n/,$text);
308             }
309 0           $text = undef();
310              
311 0           @array = $self->word_wrap($width,"","",@array);
312 0           my $max = @array;
313 0           for (my $i = 0; $i < $max; $i++) {
314 0           $self->clean_format($trust,\$array[$i]);
315             }
316              
317 0 0         if ($self->{'scale'}) {
318 0           foreach my $line (@array) {
319 0           my $s_line = $line; #$self->__TRANSLATE_CLEAN($line);
320 0           $s_line =~ s!\[A\=\w+\]!!gi;
321             $self->{'width'} = length($s_line) + 5
322             if ($self->{'width'} - 5) < length($s_line)
323 0 0 0       && (length($s_line) <= $self->{'max-scale'});
324             }
325             }
326              
327 0 0         my $new_line = $^O =~ /win32/i ? '\n' : "\n";
328 0           foreach my $line (@array) {
329 0           my $pad;
330 0           my $s_line = $self->_strip_text($line);
331 0 0         if ($line =~ /\[A\=(\w+)\]/i) {
332 0           my $align = $1;
333 0           $line =~ s!\[A\=\w+\]!!gi;
334 0 0 0       if (uc($align) eq "CENTER" || uc($align) eq "C") {
    0 0        
    0 0        
335 0           $pad = ((($self->{'_opts'}->{'width'} - 5) - length($s_line)) / 2);
336             # $pad = (($self->{'_opts'}->{'width'} - length($s_line)) / 2);
337             }
338             elsif (uc($align) eq "LEFT" || uc($align) eq "L") {
339 0           $pad = 0;
340             }
341             elsif (uc($align) eq "RIGHT" || uc($align) eq "R") {
342 0           $pad = (($self->{'_opts'}->{'width'} - 5) - length($s_line));
343             # $pad = (($self->{'_opts'}->{'width'}) - length($s_line));
344             }
345             }
346 0 0         if ($pad) {
347 0           $text .= (" " x $pad).$new_line;
348             }
349             else {
350 0           $text .= $line . $new_line;
351             }
352             }
353 0           chomp($text);
354 0           return($self->_filter_text($text));
355             }
356             sub _strip_text {
357 0     0     my $self = shift();
358 0           my $text = shift();
359 0           $text =~ s!\\Z0!!gmi;
360 0           $text =~ s!\\Z1!!gmi;
361 0           $text =~ s!\\Z2!!gmi;
362 0           $text =~ s!\\Z3!!gmi;
363 0           $text =~ s!\\Z4!!gmi;
364 0           $text =~ s!\\Z5!!gmi;
365 0           $text =~ s!\\Z6!!gmi;
366 0           $text =~ s!\\Z7!!gmi;
367 0           $text =~ s!\\Zb!!gmi;
368 0           $text =~ s!\\ZB!!gmi;
369 0           $text =~ s!\\Zu!!gmi;
370 0           $text =~ s!\\ZU!!gmi;
371 0           $text =~ s!\\Zr!!gmi;
372 0           $text =~ s!\\ZR!!gmi;
373 0           $text =~ s!\\Zn!!gmi;
374 0           $text =~ s!\[C=black\]!!gmi;
375 0           $text =~ s!\[C=red\]!!gmi;
376 0           $text =~ s!\[C=green\]!!gmi;
377 0           $text =~ s!\[C=yellow\]!!gmi;
378 0           $text =~ s!\[C=blue\]!!gmi;
379 0           $text =~ s!\[C=magenta\]!!gmi;
380 0           $text =~ s!\[C=cyan\]!!gmi;
381 0           $text =~ s!\[C=white\]!!gmi;
382 0           $text =~ s!\[B\]!!gmi;
383 0           $text =~ s!\[/B\]!!gmi;
384 0           $text =~ s!\[U\]!!gmi;
385 0           $text =~ s!\[/U\]!!gmi;
386 0           $text =~ s!\[R\]!!gmi;
387 0           $text =~ s!\[/R\]!!gmi;
388 0           $text =~ s!\[N\]!!gmi;
389 0           $text =~ s!\[A=\w+\]!!gmi;
390 0           return($text);
391             }
392             sub _filter_text {
393 0     0     my $self = shift();
394 0   0       my $text = shift() || return();
395 0 0 0       if ($self->is_cdialog() && $self->{'_opts'}->{'colours'}) {
396 0           $text =~ s!\[C=black\]!\\Z0!gmi;
397 0           $text =~ s!\[C=red\]!\\Z1!gmi;
398 0           $text =~ s!\[C=green\]!\\Z2!gmi;
399 0           $text =~ s!\[C=yellow\]!\\Z3!gmi;
400 0           $text =~ s!\[C=blue\]!\\Z4!gmi;
401 0           $text =~ s!\[C=magenta\]!\\Z5!gmi;
402 0           $text =~ s!\[C=cyan\]!\\Z6!gmi;
403 0           $text =~ s!\[C=white\]!\\Z7!gmi;
404 0           $text =~ s!\[B\]!\\Zb!gmi;
405 0           $text =~ s!\[/B\]!\\ZB!gmi;
406 0           $text =~ s!\[U\]!\\Zu!gmi;
407 0           $text =~ s!\[/U\]!\\ZU!gmi;
408 0           $text =~ s!\[R\]!\\Zr!gmi;
409 0           $text =~ s!\[/R\]!\\ZR!gmi;
410 0           $text =~ s!\[N\]!\\Zn!gmi;
411 0           $text =~ s!\[A=\w+\]!!gmi;
412 0           return($text);
413             }
414             else {
415 0           return($self->_strip_text($text));
416             }
417             }
418              
419              
420             #::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
421             #: Public Methods
422             #:
423              
424             #:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
425             #: test for the good stuff
426             sub is_cdialog {
427 0     0 0   my $self = $_[0];
428 0 0 0       return(1) if $self->{'_variant'} && $self->{'_variant'} eq "cdialog";
429 0           return(0);
430             }
431              
432             #:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
433             #: Ask a binary question (Yes/No)
434             sub yesno {
435 0     0 1   my $self = shift();
436 0   0       my $caller = (caller(1))[3] || 'main';
437 0 0 0       $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
438 0 0 0       if ($_[0] && $_[0] eq 'caller') {
439 0           shift(); $caller = shift();
  0            
440             }
441 0           my $args = $self->_pre($caller,@_);
442              
443 0           my $fmt = $self->prepare_format($args);
444 0           $fmt = $self->append_format_base($args,$fmt);
445 0           $fmt = $self->append_format($fmt,'--yesno {{text}} {{height}} {{width}}');
446             my $command = $self->prepare_command
447             ( $args, $fmt,
448 0           text => $self->make_kvt($args,$args->{'text'}),
449             );
450              
451 0           my $rv = $self->command_state($command);
452 0           $self->ra('null');
453 0           $self->rs('null');
454 0           my $this_rv;
455 0 0 0       if ($rv && $rv >= 1) {
456 0           $self->ra("NO");
457 0           $self->rs("NO");
458 0           $self->rv($rv);
459 0           $this_rv = 0;
460             }
461             else {
462 0           $self->ra("YES");
463 0           $self->rs("YES");
464 0           $self->rv('null');
465 0           $this_rv = 1;
466             }
467 0           $self->_post($args);
468 0           return($this_rv);
469             }
470              
471             #:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
472             #: Text entry
473             sub inputbox {
474 0     0 1   my $self = shift();
475 0   0       my $caller = (caller(1))[3] || 'main';
476 0 0 0       $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
477 0 0 0       if ($_[0] && $_[0] eq 'caller') {
478 0           shift(); $caller = shift();
  0            
479             }
480 0           my $args = $self->_pre($caller,@_);
481              
482 0           my $fmt = $self->prepare_format($args);
483 0           $fmt = $self->append_format_base($args,$fmt);
484 0 0         if ($args->{'password'}) {
485 0           $fmt = $self->append_format($fmt,'--passwordbox');
486             }
487             else {
488 0           $fmt = $self->append_format($fmt,'--inputbox');
489             }
490 0           $fmt = $self->append_format($fmt,'{{text}} {{height}} {{width}} {{entry}}');
491             my $command = $self->prepare_command
492             ( $args, $fmt,
493             text => $self->make_kvt($args,$args->{'text'}),
494 0   0       entry => $self->make_kvl($args,($args->{'init'}||$args->{'entry'})),
495             );
496              
497 0           my ($rv,$text) = $self->command_string($command);
498 0           $self->ra('null');
499 0           my $this_rv;
500 0 0 0       if ($rv && $rv >= 1) {
501 0           $self->rv($rv);
502 0           $self->rs('null');
503 0           $this_rv = 0;
504             }
505             else {
506 0           $self->rv('null');
507 0           $self->rs($text);
508 0           $self->ra($text);
509 0           $this_rv = $text;
510             }
511 0           $self->_post($args);
512 0           return($this_rv);
513             }
514             #: password boxes aren't supported by gdialog
515             sub password {
516 0     0 1   my $self = shift();
517 0   0       return($self->inputbox('caller',((caller(1))[3]||'main'),@_,'password',1));
518             }
519              
520             #:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
521             #: Text box
522             sub msgbox {
523 0     0 1   my $self = shift();
524 0   0       my $caller = (caller(1))[3] || 'main';
525 0 0 0       $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
526 0 0 0       if ($_[0] && $_[0] eq 'caller') {
527 0           shift(); $caller = shift();
  0            
528             }
529 0           my $args = $self->_pre($caller,@_);
530              
531 0   0       $args->{'msgbox'} ||= 'msgbox';
532              
533 0           my $fmt = $self->prepare_format($args);
534 0           $fmt = $self->append_format_base($args,$fmt);
535 0 0         if ($args->{'infobox'}) {
536 0           $fmt = $self->append_format($fmt,'--infobox');
537             }
538             else {
539 0           $fmt = $self->append_format($fmt,'--msgbox');
540             }
541 0           $fmt = $self->append_format($fmt,'{{text}} {{height}} {{width}}');
542             my $command = $self->prepare_command
543             ( $args, $fmt,
544 0           text => $self->make_kvt($args,$args->{'text'}),
545             );
546              
547 0           my $rv = $self->command_state($command);
548 0           $self->ra('null');
549 0           $self->rs('null');
550 0           my $this_rv;
551 0 0 0       if ($rv && $rv >= 1) {
552 0           $self->rv($rv);
553 0           $this_rv = 0;
554             }
555             else {
556 0 0 0       if (($args->{'msgbox'} eq "infobox") && ($args->{'timeout'} || $args->{'wait'})) {
      0        
557             my $s = int(($args->{'wait'}) ? $args->{'wait'} :
558 0 0         ($args->{'timeout'}) ? ($args->{'timeout'} / 1000.0) : 1.0);
    0          
559 0           sleep($s);
560             }
561 0           $self->rv('null');
562 0           $this_rv = 1;
563             }
564 0           $self->_post($args);
565 0           return($this_rv);
566             }
567             sub infobox {
568 0     0 1   my $self = shift();
569 0   0       return($self->msgbox('caller',((caller(1))[3]||'main'),@_,'infobox',1));
570             }
571              
572             #:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
573             #: File box
574             sub textbox {
575 0     0 1   my $self = shift();
576 0   0       my $caller = (caller(1))[3] || 'main';
577 0 0 0       $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
578 0 0 0       if ($_[0] && $_[0] eq 'caller') {
579 0           shift(); $caller = shift();
  0            
580             }
581 0           my $args = $self->_pre($caller,@_);
582              
583 0           my $fmt = $self->prepare_format($args);
584 0           $fmt = $self->append_format_base($args,$fmt);
585 0           $fmt = $self->append_format($fmt,'--scrolltext');
586 0           $fmt = $self->append_format($fmt,'--textbox');
587 0           $fmt = $self->append_format($fmt,'{{path}} {{height}} {{width}}');
588             my $command = $self->prepare_command
589             ( $args, $fmt,
590 0   0       path => $self->make_kvl($args,($args->{'path'}||'.')),
591             );
592              
593 0           my ($rv,$text) = $self->command_string($command);
594 0           $self->ra('null');
595 0           $self->rs('null');
596 0           my $this_rv;
597 0 0 0       if ($rv && $rv >= 1) {
598 0           $self->rv($rv);
599 0           $this_rv = 0;
600             }
601             else {
602 0           $self->rv('null');
603 0           $this_rv = 1;
604             }
605 0           $self->_post($args);
606 0           return($this_rv);
607             }
608              
609             #:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
610             #: a simple menu
611             sub menu {
612 0     0 1   my $self = shift();
613 0   0       my $caller = (caller(1))[3] || 'main';
614 0 0 0       $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
615 0 0 0       if ($_[0] && $_[0] eq 'caller') {
616 0           shift(); $caller = shift();
  0            
617             }
618 0           my $args = $self->_pre($caller,@_);
619              
620             $args->{'listheight'} = $args->{'menuheight'}
621 0 0         if exists $args->{'menuheight'};
622              
623 0           my $fmt = $self->prepare_format($args);
624 0           $fmt = $self->append_format_base($args,$fmt);
625 0           $fmt = $self->append_format($fmt,'--separate-output');
626 0           $fmt = $self->append_format($fmt,'--menu');
627 0           $fmt = $self->append_format($fmt,'{{text}} {{height}} {{width}} {{listheight}} {{list}}');
628             my $command = $self->prepare_command
629             ( $args, $fmt,
630 0           text => $self->make_kvt($args,$args->{'text'}),
631             );
632              
633 0           my ($rv,$selected) = $self->command_string($command);
634 0           $self->ra('null');
635 0           my $this_rv;
636 0 0 0       if ($rv && $rv >= 1) {
637 0           $self->rv($rv);
638 0           $self->rs('null');
639 0           $this_rv = 0;
640             }
641             else {
642 0           $self->rv('null');
643 0           $self->rs($selected);
644 0           $this_rv = $selected;
645             }
646 0           $self->_post($args);
647 0           return($this_rv);
648             }
649              
650             #:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
651             #: a check list
652             sub checklist {
653 0     0 1   my $self = shift();
654 0   0       my $caller = (caller(1))[3] || 'main';
655 0 0 0       $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
656 0 0 0       if ($_[0] && $_[0] eq 'caller') {
657 0           shift(); $caller = shift();
  0            
658             }
659 0           my $args = $self->_pre($caller,@_);
660              
661             $args->{'listheight'} = $args->{'menuheight'}
662 0 0         if exists $args->{'menuheight'};
663              
664 0           my $fmt = $self->prepare_format($args);
665 0           $fmt = $self->append_format_base($args,$fmt);
666 0 0         if ($args->{radiolist} == 1) {
667 0           $fmt = $self->append_format($fmt,'--radiolist');
668             }
669             else {
670 0           $fmt = $self->append_format($fmt,'--separate-output');
671 0           $fmt = $self->append_format($fmt,'--checklist');
672             }
673 0           $fmt = $self->append_format($fmt,'{{text}} {{height}} {{width}} {{listheight}} {{list}}');
674             my $command = $self->prepare_command
675             ( $args, $fmt,
676 0           text => $self->make_kvt($args,$args->{'text'}),
677             );
678              
679 0 0         if ($args->{'list'}) {
680 0 0         $args->{'list'} = [ ' ', [' ', 1] ] unless ref($args->{'list'}) eq "ARRAY";
681 0           my ($item,$info);
682 0           while (@{$args->{'list'}}) {
  0            
683 0           $item = shift(@{$args->{'list'}});
  0            
684 0           $info = shift(@{$args->{'list'}});
  0            
685 0 0 0       $command .= ' "'.($item||' ').'" "'.($info->[0]||' ').'" "'.(($info->[1]) ? 'on' : 'off').'"';
      0        
686             }
687             }
688             else {
689 0 0         $args->{'items'} = [ ' ', ' ', 'off' ] unless ref($args->{'items'}) eq "ARRAY";
690 0           foreach my $item (@{$args->{'items'}}) {
  0            
691 0           $command .= ' "' . ($item|' ') . '"';
692             }
693             }
694 0           my ($rv,$selected) = $self->command_array($command);
695 0           $self->rs('null');
696 0           my $this_rv;
697 0 0 0       if ($rv && $rv >= 1) {
698 0           $self->rv($rv);
699 0           $self->ra('null');
700 0           $this_rv = 0;
701             }
702             else {
703 0           $self->rv('null');
704 0           $self->ra(@$selected);
705 0           $self->rs(join("\n",@$selected));
706 0           $this_rv = $selected;
707             }
708 0           $self->_post($args);
709 0 0         return($this_rv) unless ref($this_rv) eq "ARRAY";
710 0           return(@{$this_rv});
  0            
711             }
712             #: a radio button list
713             sub radiolist {
714 0     0 1   my $self = shift();
715 0   0       return($self->checklist('caller',((caller(1))[3]||'main'),@_,'radiolist',1));
716             }
717              
718             #:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
719             #: file select
720             sub fselect {
721 0     0 1   my $self = shift();
722 0 0         unless ($self->is_cdialog()) {
723 0           return($self->SUPER::fselect(@_));
724             }
725 0   0       my $caller = (caller(1))[3] || 'main';
726 0 0 0       $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
727 0 0 0       if ($_[0] && $_[0] eq 'caller') {
728 0           shift(); $caller = shift();
  0            
729             }
730 0           my $args = $self->_pre($caller,@_);
731              
732 0           my $fmt = $self->prepare_format($args);
733 0           $fmt = $self->append_format_base($args,$fmt);
734 0           $fmt = $self->append_format($fmt,'--fselect');
735 0           $fmt = $self->append_format($fmt,'{{path}} {{height}} {{width}}');
736             my $command = $self->prepare_command
737             ( $args, $fmt,
738 0   0       path => $self->make_kvl($args,($args->{'path'}||'.')),
739             );
740              
741 0           my ($rv,$file) = $self->command_string($command);
742 0           $self->ra('null');
743 0           my $this_rv;
744 0 0 0       if ($rv && $rv >= 1) {
745 0           $self->rv($rv);
746 0           $self->rs('null');
747 0           $this_rv = 0;
748             }
749             else {
750 0           $self->rv('null');
751 0           $self->rs($file);
752 0           $self->ra($file);
753 0           $this_rv = $file;
754             }
755 0           $self->_post($args);
756 0           return($this_rv);
757             }
758              
759             #:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
760             #: calendar
761              
762             sub calendar {
763 0     0 1   my $self = shift();
764 0   0       my $caller = (caller(1))[3] || 'main';
765 0 0 0       $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
766 0 0 0       if ($_[0] && $_[0] eq 'caller') {
767 0           shift(); $caller = shift();
  0            
768             }
769 0           my $args = $self->_pre($caller,@_);
770 0   0       $args->{'day'} ||= '1';
771 0   0       $args->{'month'} ||= '1';
772 0   0       $args->{'year'} ||= '1970';
773              
774 0           my $fmt = $self->prepare_format($args);
775 0           $fmt = $self->append_format_base($args,$fmt);
776 0           $fmt = $self->append_format($fmt,'--calendar {{text}} {{height}} {{width}} {{day}} {{month}} {{year}}');
777             my $command = $self->prepare_command
778             ( $args, $fmt,
779 0           text => $self->make_kvt($args,$args->{'text'}),
780             );
781              
782 0           my ($rv,$date) = $self->command_string($command);
783 0           $self->ra('null');
784 0           my $this_rv;
785 0 0 0       if ($rv && $rv >= 1) {
786 0           $self->rv($rv);
787 0           $self->rs('null');
788 0           $this_rv = 0;
789             }
790             else {
791 0           chomp($date);
792 0           $self->rv('null');
793 0           $self->rs($date);
794 0           $self->ra(split(/\//,$date));
795 0           $this_rv = $date;
796             }
797 0           $self->_post($args);
798 0           return($this_rv);
799             }
800              
801             #:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
802             #: timebox
803              
804             sub timebox {
805 0     0 1   my $self = shift();
806 0   0       my $caller = (caller(1))[3] || 'main';
807 0 0 0       $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
808 0 0 0       if ($_[0] && $_[0] eq 'caller') {
809 0           shift(); $caller = shift();
  0            
810             }
811 0           my $args = $self->_pre($caller,@_);
812 0           my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
813 0   0       $args->{'hour'} ||= $hour;
814 0   0       $args->{'minute'} ||= $min;
815 0   0       $args->{'second'} ||= $sec;
816              
817 0           my $fmt = $self->prepare_format($args);
818 0           $fmt = $self->append_format_base($args,$fmt);
819 0           $fmt = $self->append_format($fmt,'--timebox {{text}} {{height}} {{width}} {{hour}} {{minute}} {{second}}');
820             my $command = $self->prepare_command
821             ( $args, $fmt,
822 0           text => $self->make_kvt($args,$args->{'text'}),
823             );
824              
825 0           my ($rv,$time) = $self->command_string($command);
826 0           $self->ra('null');
827 0           my $this_rv;
828 0 0 0       if ($rv && $rv >= 1) {
829 0           $self->rv($rv);
830 0           $self->rs('null');
831 0           $this_rv = 0;
832             }
833             else {
834 0           chomp($time);
835 0           $self->rv('null');
836 0           $self->rs($time);
837 0           $self->ra(split(/\:/,$time));
838 0           $this_rv = $time;
839             }
840 0           $self->_post($args);
841 0           return($this_rv);
842             }
843              
844             #:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
845             #: tailbox
846              
847             sub tailbox {
848 0     0 1   my $self = shift();
849 0   0       my $caller = (caller(1))[3] || 'main';
850 0 0 0       $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
851 0 0 0       if ($_[0] && $_[0] eq 'caller') {
852 0           shift(); $caller = shift();
  0            
853             }
854 0           my $args = $self->_pre($caller,@_);
855              
856 0           my $fmt = $self->prepare_format($args);
857 0           $fmt = $self->append_format_base($args,$fmt);
858 0           $fmt = $self->append_format($fmt,'--tailbox');
859 0           $fmt = $self->append_format($fmt,'{{path}} {{height}} {{width}}');
860             my $command = $self->prepare_command
861             ( $args, $fmt,
862 0   0       path => $self->make_kvl($args,($args->{'path'}||'.')),
863             );
864              
865 0           my ($rv) = $self->command_state($command);
866 0           $self->ra('null');
867 0           $self->rs('null');
868 0           my $this_rv;
869 0 0 0       if ($rv && $rv >= 1) {
870 0           $self->rv($rv);
871 0           $this_rv = 0;
872             }
873             else {
874 0           $self->rv('null');
875 0           $this_rv = 1;
876             }
877 0           $self->_post($args);
878 0           return($this_rv);
879             }
880              
881             #:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
882             #: tailboxbg
883              
884             sub tailboxbg {
885 0     0 0   my $self = shift();
886 0   0       my $caller = (caller(1))[3] || 'main';
887 0 0 0       $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
888 0 0 0       if ($_[0] && $_[0] eq 'caller') {
889 0           shift(); $caller = shift();
  0            
890             }
891 0           my $args = $self->_pre($caller,@_);
892              
893 0           my $fmt = $self->prepare_format($args);
894 0           $fmt = $self->append_format_base($args,$fmt);
895 0           $fmt = $self->append_format($fmt,'--tailboxbg');
896 0           $fmt = $self->append_format($fmt,'{{path}} {{height}} {{width}}');
897             my $command = $self->prepare_command
898             ( $args, $fmt,
899 0   0       path => $self->make_kvl($args,($args->{'path'}||'.')),
900             );
901              
902 0           my ($rv) = $self->command_state($command);
903 0           $self->ra('null');
904 0           $self->rs('null');
905 0           my $this_rv;
906 0 0 0       if ($rv && $rv >= 1) {
907 0           $self->rv($rv);
908 0           $this_rv = 0;
909             }
910             else {
911 0           $self->rv('null');
912 0           $this_rv = 1;
913             }
914 0           $self->_post($args);
915 0           return($this_rv);
916             }
917              
918             #:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
919             #: an editable form (wow is this useful! holy cripes!)
920             sub form {
921 0     0 1   my $self = shift();
922 0   0       my $caller = (caller(1))[3] || 'main';
923 0 0 0       $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
924 0 0 0       if ($_[0] && $_[0] eq 'caller') {
925 0           shift(); $caller = shift();
  0            
926             }
927 0           my $args = $self->_pre($caller,@_);
928              
929             $args->{'listheight'} = $args->{'menuheight'}
930 0 0         if exists $args->{'menuheight'};
931             $args->{'listheight'} = $args->{'formheight'}
932 0 0         if exists $args->{'formheight'};
933              
934 0           my $fmt = $self->prepare_format($args);
935 0           $fmt = $self->append_format_base($args,$fmt);
936 0           $fmt = $self->append_format($fmt,'--form');
937 0           $fmt = $self->append_format($fmt,'{{text}} {{height}} {{width}} {{listheight}} {{list}}');
938              
939 0           my $list = '';
940 0           while (@{$args->{'list'}}) {
  0            
941 0           my $item = shift(@{$args->{'list'}});
  0            
942 0           my $info = shift(@{$args->{'list'}});
  0            
943 0           $self->clean_format($args->{'trust-input'},\$item->[0]);
944 0           $self->clean_format($args->{'trust-input'},\$item->[1]);
945 0           $self->clean_format($args->{'trust-input'},\$item->[2]);
946 0           $self->clean_format($args->{'trust-input'},\$info->[0]);
947 0           $self->clean_format($args->{'trust-input'},\$info->[1]);
948 0           $self->clean_format($args->{'trust-input'},\$info->[2]);
949 0           $self->clean_format($args->{'trust-input'},\$info->[3]);
950 0           $self->clean_format($args->{'trust-input'},\$info->[4]);
951 0   0       $list .= ' "'.($item->[0]||' ').'" "'.$item->[1].'" "'.$item->[2].'" "'.($info->[0]||' ').'" "'.$info->[1].'" "'.$info->[2].'" "'.$info->[3].'" "'.$info->[4].'"';
      0        
952             }
953 0           delete $args->{'list'};
954 0           $args->{'list'} = $list;
955              
956             my $command = $self->prepare_command
957             ( $args, $fmt,
958 0           list => $self->make_kvl($args,$args->{'list'}),
959             );
960              
961 0           my ($rv,$selected) = $self->command_array($command);
962 0           $self->rs('null');
963 0           my $this_rv;
964 0 0 0       if ($rv && $rv >= 1) {
965 0           $self->rv($rv);
966 0           $self->ra('null');
967 0           $this_rv = 0;
968             }
969             else {
970 0           $self->rv('null');
971 0           $self->ra(@$selected);
972 0           $self->rs(join("\n",@$selected));
973 0           $this_rv = $selected;
974             }
975 0           $self->_post($args);
976 0 0         return($this_rv) unless ref($this_rv) eq "ARRAY";
977 0           return(@{$this_rv});
  0            
978             }
979              
980             #:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
981             #: progress meter
982             sub gauge_start {
983 0     0 1   my $self = shift();
984 0   0       my $caller = (caller(1))[3] || 'main';
985 0 0 0       $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
986 0 0 0       if ($_[0] && $_[0] eq 'caller') {
987 0           shift(); $caller = shift();
  0            
988             }
989 0           my $args = $self->_pre($caller,@_);
990              
991 0   0       $self->{'_GAUGE'} ||= {};
992 0           $self->{'_GAUGE'}->{'ARGS'} = $args;
993              
994 0 0         if (defined $self->{'_GAUGE'}->{'FH'}) {
995 0           $self->rv(129);
996 0           $self->_post($args);
997 0           return(0);
998             }
999              
1000 0           my $fmt = $self->prepare_format($args);
1001 0           $fmt = $self->append_format_base($args,$fmt);
1002 0           $fmt = $self->append_format($fmt,'--gauge');
1003 0           $fmt = $self->append_format($fmt,'{{text}} {{height}} {{width}} {{percentage}}');
1004             my $command = $self->prepare_command
1005             ( $args, $fmt,
1006             text => $self->make_kvt($args,$args->{'text'}),
1007 0   0       percentage => $self->make_kvl($args,$args->{'percentage'}||'0'),
1008             );
1009              
1010 0   0       $self->{'_GAUGE'}->{'PERCENT'} = ($args->{'percentage'} || '0');
1011 0           $self->{'_GAUGE'}->{'FH'} = new FileHandle;
1012 0           $self->{'_GAUGE'}->{'FH'}->open("| $command");
1013 0           my $rv = $? >> 8;
1014 0           $self->{'_GAUGE'}->{'FH'}->autoflush(1);
1015 0   0       $self->rv($rv||'null');
1016 0           $self->ra('null');
1017 0           $self->rs('null');
1018 0           my $this_rv;
1019 0 0 0       if ($rv && $rv >= 1) {
1020 0           $this_rv = 0;
1021             }
1022             else {
1023 0           $this_rv = 1;
1024             }
1025 0           return($this_rv);
1026             }
1027             sub gauge_inc {
1028 0     0 1   my $self = $_[0];
1029 0   0       my $incr = $_[1] || 1;
1030              
1031 0 0         return(0) unless defined $self->{'_GAUGE'}->{'FH'};
1032              
1033 0           my $fh = $self->{'_GAUGE'}->{'FH'};
1034 0           $self->{'_GAUGE'}->{'PERCENT'} += $incr;
1035 0           $SIG_CODE->{$$} = $self; local $SIG{'PIPE'} = \&_del_gauge;
  0            
1036 0           print $fh $self->{'_GAUGE'}->{'PERCENT'}."\n";
1037 0 0         return(((defined $self->{'_GAUGE'}->{'FH'}) ? 1 : 0));
1038             }
1039             sub gauge_dec {
1040 0     0 1   my $self = $_[0];
1041 0   0       my $decr = $_[1] || 1;
1042              
1043 0 0         return(0) unless defined $self->{'_GAUGE'}->{'FH'};
1044              
1045 0           my $fh = $self->{'_GAUGE'}->{'FH'};
1046 0           $self->{'_GAUGE'}->{'PERCENT'} -= $decr;
1047 0           $SIG_CODE->{$$} = $self; local $SIG{'PIPE'} = \&_del_gauge;
  0            
1048 0           print $fh $self->{'_GAUGE'}->{'PERCENT'}."\n";
1049 0 0         return(((defined $self->{'_GAUGE'}->{'FH'}) ? 1 : 0));
1050             }
1051             sub gauge_set {
1052 0     0 1   my $self = $_[0];
1053 0   0       my $perc = $_[1] || $self->{'_GAUGE'}->{'PERCENT'} || 1;
1054              
1055 0 0         return(0) unless $self->{'_GAUGE'}->{'FH'};
1056              
1057 0           my $fh = $self->{'_GAUGE'}->{'FH'};
1058 0           $self->{'_GAUGE'}->{'PERCENT'} = $perc;
1059 0           $SIG_CODE->{$$} = $self; local $SIG{'PIPE'} = \&_del_gauge;
  0            
1060 0           print $fh $self->{'_GAUGE'}->{'PERCENT'}."\n";
1061 0 0         return(((defined $self->{'_GAUGE'}->{'FH'}) ? 1 : 0));
1062             }
1063             # funky flicker... grr
1064             sub gauge_text {
1065 0     0 1   my $self = $_[0];
1066 0   0       my $mesg = $_[1] || return(0);
1067              
1068 0 0         return(0) unless $self->{'_GAUGE'}->{'FH'};
1069              
1070 0           my $fh = $self->{'_GAUGE'}->{'FH'};
1071 0           $SIG_CODE->{$$} = $self; local $SIG{'PIPE'} = \&_del_gauge;
  0            
1072 0           print $fh "\nXXX\n\n".$mesg."\n\nXXX\n\n".$self->{'_GAUGE'}->{'PERCENT'}."\n";
1073 0 0         return(((defined $self->{'_GAUGE'}->{'FH'}) ? 1 : 0));
1074             }
1075             sub gauge_stop {
1076 0     0 1   my $self = $_[0];
1077              
1078 0 0         return(0) unless $self->{'_GAUGE'}->{'FH'};
1079              
1080 0           my $args = $self->{'_GAUGE'}->{'ARGS'};
1081 0           my $fh = $self->{'_GAUGE'}->{'FH'};
1082 0           $SIG_CODE->{$$} = $self; local $SIG{'PIPE'} = \&_del_gauge;
  0            
1083 0           $self->{'_GAUGE'}->{'FH'}->close();
1084 0           delete($self->{'_GAUGE'}->{'FH'});
1085 0           delete($self->{'_GAUGE'}->{'ARGS'});
1086 0           delete($self->{'_GAUGE'}->{'PERCENT'});
1087 0           delete($self->{'_GAUGE'});
1088 0           $self->rv('null');
1089 0           $self->rs('null');
1090 0           $self->ra('null');
1091 0           $self->_post($args);
1092 0           return(1);
1093             }
1094              
1095              
1096             1;
1097