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