File Coverage

blib/lib/UI/Dialog/Backend/Zenity.pm
Criterion Covered Total %
statement 62 396 15.6
branch 5 136 3.6
condition 19 182 10.4
subroutine 12 43 27.9
pod 19 30 63.3
total 117 787 14.8


line stmt bran cond sub pod time code
1             package UI::Dialog::Backend::Zenity;
2             ###############################################################################
3             # Copyright (C) 2004-2016 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   13776 use 5.006;
  2         4  
20 2     2   7 use strict;
  2         2  
  2         30  
21 2     2   6 use warnings;
  2         2  
  2         58  
22 2     2   7 use Carp;
  2         2  
  2         112  
23 2     2   879 use FileHandle;
  2         14984  
  2         9  
24 2     2   497 use Cwd qw( abs_path );
  2         2  
  2         69  
25 2     2   799 use UI::Dialog::Backend;
  2         5  
  2         63  
26 2     2   11 use File::Slurp;
  2         3  
  2         195  
27 2     2   11 use String::ShellQuote;
  2         3  
  2         112  
28              
29             BEGIN {
30 2     2   8 use vars qw( $VERSION @ISA );
  2         2  
  2         90  
31 2     2   14 @ISA = qw( UI::Dialog::Backend );
32 2         5968 $VERSION = '1.21';
33             }
34              
35             #::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
36             #: Constructor Method
37             #:
38              
39             sub new {
40 1     1 1 630 my $proto = shift();
41 1   33     6 my $class = ref($proto) || $proto;
42 1 50       5 my $cfg = ((ref($_[0]) eq "HASH") ? $_[0] : (@_) ? { @_ } : {});
    50          
43 1         2 my $self = {};
44 1         2 bless($self, $class);
45 1         6 $self->{'_state'} = {};
46 1         2 $self->{'_opts'} = {};
47              
48             #: Dynamic path discovery...
49 1         2 my $CFG_PATH = $cfg->{'PATH'};
50 1 50       5 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!:!) {
55 0         0 $self->{'PATHS'} = [ split(/:/,$CFG_PATH) ];
56             }
57             elsif (-d $CFG_PATH) {
58 0         0 $self->{'PATHS'} = [ $CFG_PATH ];
59             }
60             }
61             elsif ($ENV{'PATH'}) {
62 1         7 $self->{'PATHS'} = [ split(/:/,$ENV{'PATH'}) ];
63             }
64             else {
65 0         0 $self->{'PATHS'} = '';
66             }
67              
68 1   50     6 $self->{'_opts'}->{'literal'} = $cfg->{'literal'} || 0;
69 1   50     6 $self->{'_opts'}->{'debug'} = $cfg->{'debug'} || undef();
70 1   50     5 $self->{'_opts'}->{'window-icon'} = $cfg->{'window-icon'} || undef();
71 1   50     4 $self->{'_opts'}->{'title'} = $cfg->{'title'} || undef();
72 1   50     4 $self->{'_opts'}->{'width'} = $cfg->{'width'} || 65;
73 1   50     5 $self->{'_opts'}->{'height'} = $cfg->{'height'} || 10;
74 1   50     4 $self->{'_opts'}->{'display'} = $cfg->{'display'} || undef();
75 1   50     4 $self->{'_opts'}->{'name'} = $cfg->{'name'} || undef();
76 1   50     3 $self->{'_opts'}->{'class'} = $cfg->{'class'} || undef();
77 1         6 $self->{'_opts'}->{'bin'} = $self->_find_bin('zenity');
78 1   50     5 $self->{'_opts'}->{'autoclear'} = $cfg->{'autoclear'} || 0;
79 1   50     13 $self->{'_opts'}->{'clearbefore'} = $cfg->{'clearbefore'} || 0;
80 1   50     3 $self->{'_opts'}->{'clearafter'} = $cfg->{'clearafter'} || 0;
81 1   50     6 $self->{'_opts'}->{'beepbin'} = $cfg->{'beepbin'} || $self->_find_bin('beep') || '/usr/bin/beep';
82 1   50     4 $self->{'_opts'}->{'beepbefore'} = $cfg->{'beepbefore'} || 0;
83 1   50     5 $self->{'_opts'}->{'beepafter'} = $cfg->{'beepafter'} || 0;
84 1   50     8 $self->{'_opts'}->{'callbacks'} = $cfg->{'callbacks'} || undef();
85 1   50     4 $self->{'_opts'}->{'timeout'} = $cfg->{'timeout'} || 0;
86 1   50     4 $self->{'_opts'}->{'wait'} = $cfg->{'wait'} || 0;
87 1 50       6 unless (-x $self->{'_opts'}->{'bin'}) {
88 1         162 croak("the zenity binary could not be found at: ".$self->{'_opts'}->{'bin'});
89             }
90              
91 0   0       $self->{'_opts'}->{'trust-input'} = $cfg->{'trust-input'} || 0;
92              
93 0           my $command = $self->{'_opts'}->{'bin'}." --version";
94 0           my $version = `$command 2>&1`;
95 0           chomp( $version );
96 0   0       $self->{'ZENITY_VERSION'} = $version || '1';
97              
98 0 0         $self->{'test_mode'} = $cfg->{'test_mode'} if exists $cfg->{'test_mode'};
99 0           $self->{'test_mode_result'} = '';
100              
101 0           return($self);
102             }
103              
104             #::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
105             #: Private Methods
106             #:
107              
108             my $SIG_CODE = {};
109             sub _del_gauge {
110             #: this is beyond self...
111 0     0     my $CODE = $SIG_CODE->{$$};
112 0 0         unless (not ref($CODE)) {
113 0           delete($CODE->{'_GAUGE'});
114 0           $CODE->rv('1');
115 0           $CODE->rs('null');
116 0           $CODE->ra('null');
117 0           $SIG_CODE->{$$} = "";
118             }
119             }
120             sub append_format_base {
121 0     0 0   my ($self,$args,$fmt) = @_;
122 0           $ENV{'ZENITY_CANCEL'} = '1';
123 0           $ENV{'ZENITY_ERROR'} = '254';
124 0           $ENV{'ZENITY_ESC'} = '255';
125 0           $ENV{'ZENITY_EXTRA'} = '3';
126 0           $ENV{'ZENITY_HELP'} = '2';
127 0           $ENV{'ZENITY_OK'} = '0';
128 0           $fmt = $self->append_format_check($args,$fmt,'window-icon','--window-icon {{window-icon}}');
129 0           $fmt = $self->append_format_check($args,$fmt,'width','--width {{width}}');
130 0           $fmt = $self->append_format_check($args,$fmt,'height','--height {{height}}');
131 0           $fmt = $self->append_format_check($args,$fmt,'display','--display {{display}}');
132 0           $fmt = $self->append_format_check($args,$fmt,'name','--name {{name}}');
133 0           $fmt = $self->append_format_check($args,$fmt,'class','--class {{class}}');
134              
135 0           return $fmt;
136             }
137              
138             sub _is_bad_version {
139             # my $self = shift();
140             # my ($d_maj, $d_min, $d_mac) = ( 1, 4, 0 );
141             # my ($z_maj, $z_min, $z_mac) = ( 0, 0, 0 );
142             # my $zenity_version = $self->{'ZENITY_VERSION'} || '0.0.0';
143             # if ( $zenity_version =~ m!^(\d+)\.(\d+)\.(\d+)$! ) {
144             # ($z_maj, $z_min, $z_mac) = ( $1, $2, $3 );
145             # }
146             # if ( ( $d_maj < $z_maj ) ||
147             # ( $d_maj == $z_maj && $d_min < $z_min ) ||
148             # ( $d_maj == $z_maj && $d_min == $z_min && $d_mac < $z_mac )
149             # ) {
150             # return(0);
151             # }
152 0     0     return(1);
153             }
154              
155             #::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
156             #: Override Inherited Methods
157             #:
158              
159             # May want to override Backend::perform_command(). Not sure.
160             #: run command and return the rv and any text output from stderr
161             sub perform_command {
162 0     0 0   my $self = $_[0];
163 0           my $cmnd = $_[1];
164 0 0         if ($self->is_unit_test_mode()) {
165 0           $self->{'test_mode_result'} = $cmnd;
166 0           return (0,'test_mode_result');
167             }
168 0           $self->_debug("perform_command: ".$cmnd.";");
169 0 0         my $null_dev = $^O =~ /win32/i ? 'NUL:' : '/dev/null';
170 0           my $tmp_stderr = $self->gen_tempfile_name();
171 0           system($cmnd." 2> $null_dev > ".$tmp_stderr);
172 0           my $rv = $? >> 8;
173 0           my $text = read_file($tmp_stderr);
174 0 0         unlink($tmp_stderr) if -f $tmp_stderr;
175 0           $self->_debug("perform_command: stderr=".shell_quote($text),2);
176 0           return ($rv,$text);
177             }
178              
179              
180             #::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
181             #: Public Methods
182             #:
183              
184             #:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
185             #: Ask a binary question (Yes/No)
186             sub question {
187 0     0 1   my $self = shift();
188 0   0       my $caller = (caller(1))[3] || 'main';
189 0 0 0       $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
190 0 0 0       if ($_[0] && $_[0] eq 'caller') {
191 0           shift(); $caller = shift();
  0            
192             }
193 0           my $args = $self->_pre($caller,@_);
194              
195 0           my $fmt = $self->prepare_format($args);
196 0           $fmt = $self->append_format_base($args,$fmt);
197 0           $fmt = $self->append_format($fmt,'--question --text {{text}}');
198             my $command = $self->prepare_command
199             ( $args, $fmt,
200 0           text => $self->make_kvt($args,$args->{'text'}),
201             );
202              
203 0           my $rv = $self->command_state($command);
204 0 0 0       if ($rv && $rv >= 1) {
205 0           $self->ra("NO");
206 0           $self->rs("NO");
207             }
208             else {
209 0           $self->ra("YES");
210 0           $self->rs("YES");
211             }
212 0           $self->_post($args);
213 0 0         return($rv == 0 ? 1 : 0);
214             }
215             #: Zenity doesn't support alternation of the buttons like gdialog et al.
216             #: so here we just wrap for compliance.
217             sub yesno {
218 0     0 1   my $self = shift();
219 0   0       return($self->question('caller',((caller(1))[3]||'main'),@_));
220             }
221             sub noyes {
222 0     0 0   my $self = shift();
223 0   0       return($self->question('caller',((caller(1))[3]||'main'),@_));
224             }
225              
226             #:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
227             #: Text entry
228             sub entry {
229 0     0 0   my $self = shift();
230 0   0       my $caller = (caller(1))[3] || 'main';
231 0 0 0       $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
232 0 0 0       if ($_[0] && $_[0] eq 'caller') {
233 0           shift(); $caller = shift();
  0            
234             }
235 0           my $args = $self->_pre($caller,@_);
236              
237 0   0       $args->{'entry'} ||= ($args->{'init'} || $args->{'entry'});
      0        
238              
239 0           my $fmt = $self->prepare_format($args);
240 0           $fmt = $self->append_format_base($args,$fmt);
241 0           $fmt = $self->append_format($fmt,'--entry');
242 0           $fmt = $self->append_format_check($args,$fmt,'hide-text','--hide-text');
243 0           $fmt = $self->append_format_check($args,$fmt,'entry','--entry-text {{entry}}');
244 0           $fmt = $self->append_format($fmt,'--text {{text}}');
245             my $command = $self->prepare_command
246             ( $args, $fmt,
247 0           text => $self->make_kvt($args,$args->{'text'}),
248             );
249              
250 0           my ($rv,$text) = $self->command_string($command);
251 0           $self->_post($args);
252 0 0         return($rv == 0 ? $text : 0);
253             }
254             sub inputbox {
255 0     0 1   my $self = shift();
256 0   0       return($self->entry('caller',((caller(1))[3]||'main'),@_));
257             }
258             sub password {
259 0     0 1   my $self = shift();
260 0   0       return($self->entry('caller',((caller(1))[3]||'main'),@_,'hide-text',1));
261             }
262              
263             #:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
264             #: Text box
265             sub info {
266 0     0 0   my $self = shift();
267 0   0       my $caller = (caller(1))[3] || 'main';
268 0 0 0       $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
269 0 0 0       if ($_[0] && $_[0] eq 'caller') {
270 0           shift(); $caller = shift();
  0            
271             }
272 0           my $args = $self->_pre($caller,@_);
273              
274 0           my $fmt = $self->prepare_format($args);
275 0           $fmt = $self->append_format_base($args,$fmt);
276 0 0         if ($args->{'error'}) {
    0          
277 0           $fmt = $self->append_format($fmt,'--error');
278             }
279             elsif ($args->{'warning'}) {
280 0           $fmt = $self->append_format($fmt,'--warning');
281             }
282             else {
283 0           $fmt = $self->append_format($fmt,'--info');
284             }
285 0           $fmt = $self->append_format($fmt,'--text {{text}}');
286             my $command = $self->prepare_command
287             ( $args, $fmt,
288 0           text => $self->make_kvt($args,$args->{'text'}),
289             );
290              
291 0           my $rv = $self->command_state($command);
292 0           $self->_post($args);
293 0 0         return($rv == 0 ? 1 : 0);
294             }
295             sub infobox {
296 0     0 0   my $self = shift();
297 0   0       return($self->info('caller',((caller(1))[3]||'main'),@_));
298             }
299             sub msgbox {
300 0     0 1   my $self = shift();
301 0   0       return($self->info('caller',((caller(1))[3]||'main'),@_));
302             }
303             sub error {
304 0     0 0   my $self = shift();
305 0   0       return($self->info('caller',((caller(1))[3]||'main'),@_,'error',1));
306             }
307             sub warning {
308 0     0 0   my $self = shift();
309 0   0       return($self->info('caller',((caller(1))[3]||'main'),@_,'warning',1));
310             }
311              
312             #:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
313             #: File box
314             sub text_info {
315 0     0 0   my $self = shift();
316 0   0       my $caller = (caller(1))[3] || 'main';
317 0 0 0       $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
318 0 0 0       if ($_[0] && $_[0] eq 'caller') {
319 0           shift(); $caller = shift();
  0            
320             }
321 0           my $args = $self->_pre($caller,@_);
322              
323 0   0       my $filename = $args->{'path'} || $args->{'filename'};
324 0           my $fmt = $self->prepare_format($args);
325 0           $fmt = $self->append_format_base($args,$fmt);
326 0           $fmt = $self->append_format($fmt,'--text-info');
327 0           $fmt = $self->append_format_check($args,$fmt,'editable','--editable');
328 0           $fmt = $self->append_format($fmt,'--filename {{filename}}');
329             my $command = $self->prepare_command
330             ( $args, $fmt,
331 0           text => $self->make_kvt($args,$args->{'text'}),
332             filename => $self->make_kvl($args,$filename)
333             );
334              
335 0           my ($rv,$text) = $self->command_string($command);
336 0           $self->_post($args);
337 0 0         return($rv == 0 ? $text : 0);
338             }
339             sub textbox {
340 0     0 1   my $self = shift();
341 0   0       return($self->text_info('caller',((caller(1))[3]||'main'),@_));
342             }
343             sub editbox {
344 0     0 1   my $self = shift();
345 0   0       return($self->text_info('caller',((caller(1))[3]||'main'),@_,'editable',1));
346             }
347              
348             #:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
349             #: Lists
350             sub list {
351 0     0 0   my $self = shift();
352 0   0       my $caller = (caller(1))[3] || 'main';
353 0 0 0       $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
354 0 0 0       if ($_[0] && $_[0] eq 'caller') {
355 0           shift(); $caller = shift();
  0            
356             }
357 0           my $args = $self->_pre($caller,@_);
358              
359 0           my $fmt = $self->prepare_format($args);
360 0           $fmt = $self->append_format_base($args,$fmt);
361 0           $fmt = $self->append_format($fmt,'--list');
362 0   0       $args->{'checklist'} ||= 0;
363 0   0       $args->{'radiolist'} ||= 0;
364 0 0         if ($args->{'checklist'}) {
    0          
365 0           $fmt = $self->append_format($fmt,'--checklist');
366             }
367             elsif ($args->{'radiolist'}) {
368 0           $fmt = $self->append_format($fmt,'--radiolist');
369             }
370 0           $fmt = $self->append_format($fmt,"--separator '\\n'");
371              
372 0 0         if (ref($args->{'list'}) eq "ARRAY") {
373 0 0 0       if ($args->{'checklist'}||$args->{'radiolist'}) {
374 0           $fmt = $self->append_format($fmt,'--column " " --column " " --column " "');
375             } else {
376 0           $fmt = $self->append_format($fmt,'--column " " --column " "');
377             }
378 0           while (@{$args->{'list'}}) {
  0            
379 0           my $item = shift(@{$args->{'list'}});
  0            
380 0           $self->clean_format($args->{'trust-input'},\$item);
381 0           my $info = shift(@{$args->{'list'}});
  0            
382 0 0         if (ref($info) eq "ARRAY") {
383 0           $self->clean_format($args->{'trust-input'},\$info->[0]);
384 0 0         $fmt = $self->append_format($fmt,'"'.(($info->[1]) ? 'TRUE' : 'FALSE').'"');
385 0           $fmt = $self->append_format($fmt,'"'.$item.'"');
386 0           $fmt = $self->append_format($fmt,'"'.$info->[0].'"');
387             }
388             else {
389 0           $self->clean_format($args->{'trust-input'},\$info);
390 0           $fmt = $self->append_format($fmt,'"'.$item.'"');
391 0           $fmt = $self->append_format($fmt,'"'.$info.'"');
392             }
393             }
394             } else {
395 0           croak("Programmer error. list argument missing or not an array.")
396             }
397              
398 0           my $command = $self->prepare_command( $args, $fmt );
399              
400 0 0         if ($args->{'checklist'}) {
401 0           my ($rv,$selected) = $self->command_array($command);
402 0           $self->_post($args);
403 0 0 0       return($rv == 0 ? $selected : 0) unless defined wantarray and wantarray;
    0          
404 0 0         return($rv == 0 ? $self->ra() : (0));
405             }
406 0           my ($rv,$selected) = $self->command_string($command);
407 0           $self->_post($args);
408 0 0         return($rv == 0 ? $selected : 0);
409             }
410             sub menu {
411 0     0 1   my $self = shift();
412 0   0       return($self->list('caller',((caller(1))[3]||'main'),@_));
413             }
414             sub checklist {
415 0     0 1   my $self = shift();
416 0   0       return($self->list('caller',((caller(1))[3]||'main'),@_,'checklist',1));
417             }
418             sub radiolist {
419 0     0 1   my $self = shift();
420 0   0       return($self->list('caller',((caller(1))[3]||'main'),@_,'radiolist',1));
421             }
422              
423             #:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
424             #: file select
425             sub fselect {
426 0     0 1   my $self = shift();
427 0   0       my $caller = (caller(1))[3] || 'main';
428 0 0 0       $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
429 0 0 0       if ($_[0] && $_[0] eq 'caller') {
430 0           shift(); $caller = shift();
  0            
431             }
432 0           my $args = $self->_pre($caller,@_);
433              
434 0   0       my $filename = $args->{'path'} || $args->{'filename'} || abs_path();
435 0           $args->{'path'} = $filename;
436 0 0         $args->{'path'} = (-d $args->{'path'}) ? $args->{'path'}."/" : $args->{'path'};
437 0           $args->{'path'} =~ s!/+!/!g;
438              
439 0           my $fmt = $self->prepare_format($args);
440 0           $fmt = $self->append_format_base($args,$fmt);
441 0           $fmt = $self->append_format($fmt,'--file-selection');
442 0           $fmt = $self->append_format($fmt,'--filename {{filename}}');
443 0           my $command = $self->prepare_command
444             ( $args, $fmt,
445             filename => $self->make_kvl($args,$filename)
446             );
447              
448 0           $self->_debug("fselect: ".$args->{'path'});
449 0           my ($rv,$file) = $self->command_string($command);
450 0           $self->_post($args);
451 0 0         return($rv == 0 ? $file : 0);
452             }
453              
454             #:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
455             #: directory select
456             sub dselect {
457 0     0 1   my $self = shift();
458 0   0       my $caller = (caller(1))[3] || 'main';
459 0 0 0       $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
460 0 0 0       if ($_[0] && $_[0] eq 'caller') {
461 0           shift(); $caller = shift();
  0            
462             }
463 0           my $args = $self->_pre($caller,@_);
464              
465 0   0       my $filename = $args->{'path'} || $args->{'filename'} || abs_path();
466 0           $args->{'path'} = $filename;
467 0 0         $args->{'path'} = (-d $args->{'path'}) ? $args->{'path'}."/" : $args->{'path'};
468 0           $args->{'path'} =~ s!/+!/!g;
469              
470 0           my $fmt = $self->prepare_format($args);
471 0           $fmt = $self->append_format_base($args,$fmt);
472 0           $fmt = $self->append_format($fmt,'--file-selection --directory');
473 0           $fmt = $self->append_format($fmt,'--filename {{filename}}');
474 0           my $command = $self->prepare_command
475             ( $args, $fmt,
476             filename => $self->make_kvl($args,$filename)
477             );
478              
479 0           $self->_debug("fselect: ".$args->{'path'});
480 0           my ($rv,$file) = $self->command_string($command);
481 0           $self->_post($args);
482 0 0         return($rv == 0 ? $file : 0);
483             }
484              
485             #:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
486             #: calendar
487             sub calendar {
488 0     0 1   my $self = shift();
489 0   0       my $caller = (caller(1))[3] || 'main';
490 0 0 0       $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
491 0 0 0       if ($_[0] && $_[0] eq 'caller') {
492 0           shift(); $caller = shift();
  0            
493             }
494 0           my $args = $self->_pre($caller,@_);
495              
496 0           my $fmt = $self->prepare_format($args);
497 0           $fmt = $self->append_format_base($args,$fmt);
498 0           $fmt = $self->append_format($fmt,'--calendar');
499 0           $fmt = $self->append_format_check($args,$fmt,'text','--text {{text}}');
500 0           $fmt = $self->append_format_check($args,$fmt,'date-format','--date-format {{date-format}}');
501 0           $fmt = $self->append_format_check($args,$fmt,'day','--day {{day}}');
502 0           $fmt = $self->append_format_check($args,$fmt,'month','--month {{month}}');
503 0           $fmt = $self->append_format_check($args,$fmt,'year','--year {{year}}');
504             my $command = $self->prepare_command
505             ( $args, $fmt,
506 0           text => $self->make_kvt($args,$args->{'text'}),
507             );
508              
509 0           my ($rv,$date) = $self->command_string($command);
510 0 0         if ($rv == 0) {
511 0           $self->ra(split(m!/!,$date));
512             }
513 0           $self->_post($args);
514 0 0 0       return($rv == 0 ? $date : 0) unless defined wantarray and wantarray;
    0          
515 0 0         return($rv == 0 ? $self->ra() : (0,0,0));
516             }
517              
518             #:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
519             #: progress
520              
521             sub gauge_start {
522 0     0 1   my $self = shift();
523 0   0       my $caller = (caller(1))[3] || 'main';
524 0 0 0       $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
525 0 0 0       if ($_[0] && $_[0] eq 'caller') {
526 0           shift(); $caller = shift();
  0            
527             }
528 0           my $args = $self->_pre($caller,@_);
529              
530 0   0       $self->{'_GAUGE'} ||= {};
531 0           $self->{'_GAUGE'}->{'ARGS'} = $args;
532              
533 0 0         if (defined $self->{'_GAUGE'}->{'FH'}) {
534 0           $self->rv(129);
535 0           $self->_post($args);
536 0           return(0);
537             }
538              
539 0           my $fmt = $self->prepare_format($args);
540 0           $fmt = $self->append_format_base($args,$fmt);
541 0           $fmt = $self->append_format($fmt,'--progress');
542 0           $fmt = $self->append_format_check($args,$fmt,'pulsate','--pulsate');
543 0           $fmt = $self->append_format_check($args,$fmt,'text','--text {{text}}');
544 0           $fmt = $self->append_format($fmt,'--percentage {{percentage}}');
545             my $command = $self->prepare_command
546             ( $args, $fmt,
547             text => $self->make_kvt($args,$args->{'text'}),
548 0   0       percentage => $self->make_kvl($args,$args->{'percentage'}||'0'),
549             );
550              
551 0   0       $self->{'_GAUGE'}->{'PERCENT'} = ($args->{'percentage'} || '0');
552 0           $self->{'_GAUGE'}->{'FH'} = new FileHandle;
553 0           $self->{'_GAUGE'}->{'FH'}->open("| $command");
554 0           my $rv = ($? >> 8);
555 0           $self->{'_GAUGE'}->{'FH'}->autoflush(1);
556 0   0       $self->rv($rv||'null');
557 0           $self->ra('null');
558 0           $self->rs('null');
559 0 0         return($rv == 0 ? 1 : 0);
560             }
561             sub gauge_inc {
562 0     0 1   my $self = $_[0];
563 0   0       my $incr = $_[1] || 1;
564              
565 0 0         return(0) unless defined $self->{'_GAUGE'}->{'FH'};
566              
567 0           my $fh = $self->{'_GAUGE'}->{'FH'};
568 0           $self->{'_GAUGE'}->{'PERCENT'} += $incr;
569 0           $SIG_CODE->{$$} = $self; local $SIG{'PIPE'} = \&_del_gauge;
  0            
570 0           print $fh $self->{'_GAUGE'}->{'PERCENT'}."\n";
571 0 0         return(((defined $self->{'_GAUGE'}->{'FH'}) ? 1 : 0));
572             }
573             sub gauge_dec {
574 0     0 1   my $self = $_[0];
575 0   0       my $decr = $_[1] || 1;
576              
577 0 0         return(0) unless defined $self->{'_GAUGE'}->{'FH'};
578              
579 0           my $fh = $self->{'_GAUGE'}->{'FH'};
580 0           $self->{'_GAUGE'}->{'PERCENT'} -= $decr;
581 0           $SIG_CODE->{$$} = $self; local $SIG{'PIPE'} = \&_del_gauge;
  0            
582 0           print $fh $self->{'_GAUGE'}->{'PERCENT'}."\n";
583 0 0         return(((defined $self->{'_GAUGE'}->{'FH'}) ? 1 : 0));
584             }
585             sub gauge_set {
586 0     0 1   my $self = $_[0];
587 0   0       my $perc = $_[1] || $self->{'_GAUGE'}->{'PERCENT'} || 1;
588              
589 0 0         return(0) unless $self->{'_GAUGE'}->{'FH'};
590              
591 0           my $fh = $self->{'_GAUGE'}->{'FH'};
592 0           $self->{'_GAUGE'}->{'PERCENT'} = $perc;
593 0           $SIG_CODE->{$$} = $self; local $SIG{'PIPE'} = \&_del_gauge;
  0            
594 0           print $fh $self->{'_GAUGE'}->{'PERCENT'}."\n";
595 0 0         return(((defined $self->{'_GAUGE'}->{'FH'}) ? 1 : 0));
596             }
597             #: Textual updates are not supported by Zenity...
598             sub gauge_text {
599 0     0 0   my $self = $_[0];
600 0   0       my $mesg = $_[1] || return(0);
601              
602 0           my $fh = $self->{'_GAUGE'};
603 0 0         return(0) unless $self->{'_GAUGE'};
604              
605             # $SIG_CODE->{$$} = $self; local $SIG{'PIPE'} = \&_del_gauge;
606             # print $fh "\nXXX\n\n".$mesg."\n\nXXX\n\n".$self->{'_GAUGE'}->{'PERCENT'}."\n";
607 0 0         return(((defined $self->{'_GAUGE'}) ? 1 : 0));
608             }
609             sub gauge_stop {
610 0     0 1   my $self = $_[0];
611 0   0       my $args = $self->{'_GUAGE'}->{'ARGS'} ||
612             $self->_merge_attrs( title => 'gauge_stop',
613             'caller' => ((caller(1))[3]||'main') );
614              
615 0 0         unless ($self->{'_GAUGE'}->{'FH'}) {
616 0           $self->rv(129);
617 0           $self->_post($args);
618 0           return(0);
619             }
620              
621 0           my $fh = $self->{'_GAUGE'}->{'FH'};
622 0           $SIG_CODE->{$$} = $self; local $SIG{'PIPE'} = \&_del_gauge;
  0            
623 0           $self->{'_GAUGE'}->{'FH'}->close();
624 0           delete($self->{'_GAUGE'}->{'ARGS'});
625 0           delete($self->{'_GAUGE'}->{'FH'});
626 0           delete($self->{'_GAUGE'}->{'PERCENT'});
627 0           delete($self->{'_GAUGE'});
628 0           $self->rv('null');
629 0           $self->rs('null');
630 0           $self->ra('null');
631 0           $self->_post($args);
632 0           return(1);
633             }
634              
635             1;
636