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
|
|
|
|
|
|
|
|