line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package UI::Dialog::Backend; |
2
|
|
|
|
|
|
|
############################################################################### |
3
|
|
|
|
|
|
|
# Copyright (C) 2015 Kevin C. Krinke |
4
|
|
|
|
|
|
|
# |
5
|
|
|
|
|
|
|
# This library is free software; you can redistribute it and/or |
6
|
|
|
|
|
|
|
# modify it under the terms of the GNU Lesser General Public |
7
|
|
|
|
|
|
|
# License as published by the Free Software Foundation; either |
8
|
|
|
|
|
|
|
# version 2.1 of the License, or (at your option) any later version. |
9
|
|
|
|
|
|
|
# |
10
|
|
|
|
|
|
|
# This library is distributed in the hope that it will be useful, |
11
|
|
|
|
|
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of |
12
|
|
|
|
|
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
13
|
|
|
|
|
|
|
# Lesser General Public License for more details. |
14
|
|
|
|
|
|
|
# |
15
|
|
|
|
|
|
|
# You should have received a copy of the GNU Lesser General Public |
16
|
|
|
|
|
|
|
# License along with this library; if not, write to the Free Software |
17
|
|
|
|
|
|
|
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA |
18
|
|
|
|
|
|
|
############################################################################### |
19
|
6
|
|
|
6
|
|
149
|
use 5.006; |
|
6
|
|
|
|
|
19
|
|
20
|
6
|
|
|
6
|
|
31
|
use strict; |
|
6
|
|
|
|
|
11
|
|
|
6
|
|
|
|
|
148
|
|
21
|
6
|
|
|
6
|
|
27
|
use Carp; |
|
6
|
|
|
|
|
10
|
|
|
6
|
|
|
|
|
362
|
|
22
|
6
|
|
|
6
|
|
30
|
use Cwd qw( abs_path ); |
|
6
|
|
|
|
|
11
|
|
|
6
|
|
|
|
|
285
|
|
23
|
6
|
|
|
6
|
|
30
|
use File::Basename; |
|
6
|
|
|
|
|
11
|
|
|
6
|
|
|
|
|
567
|
|
24
|
6
|
|
|
6
|
|
4730
|
use Text::Wrap qw( wrap ); |
|
6
|
|
|
|
|
18859
|
|
|
6
|
|
|
|
|
413
|
|
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
BEGIN { |
27
|
6
|
|
|
6
|
|
36
|
use vars qw($VERSION); |
|
6
|
|
|
|
|
13
|
|
|
6
|
|
|
|
|
208
|
|
28
|
6
|
|
|
6
|
|
17261
|
$VERSION = '1.12'; |
29
|
|
|
|
|
|
|
} |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
#:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: |
32
|
|
|
|
|
|
|
#: Constructor Method |
33
|
|
|
|
|
|
|
#: |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
#: not even really necessary as this class is inherited, and the constructor is |
36
|
|
|
|
|
|
|
#: more often than not overridden by the backend inheriting it. |
37
|
|
|
|
|
|
|
sub new { |
38
|
0
|
|
|
0
|
0
|
0
|
my $proto = shift(); |
39
|
0
|
|
0
|
|
|
0
|
my $class = ref($proto) || $proto; |
40
|
0
|
0
|
|
|
|
0
|
my $cfg = ((ref($_[0]) eq "HASH") ? $_[0] : (@_) ? { @_ } : {}); |
|
|
0
|
|
|
|
|
|
41
|
0
|
|
|
|
|
0
|
my $self = { '_opts' => $cfg }; |
42
|
0
|
0
|
|
|
|
0
|
$self->{'test_mode'} = $cfg->{'test_mode'} if exists $cfg->{'test_mode'}; |
43
|
0
|
|
|
|
|
0
|
$self->{'test_mode_result'} = ''; |
44
|
0
|
|
|
|
|
0
|
bless($self, $class); |
45
|
0
|
|
|
|
|
0
|
return($self); |
46
|
|
|
|
|
|
|
} |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
#:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: |
49
|
|
|
|
|
|
|
#: Accessory Methods |
50
|
|
|
|
|
|
|
#: |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
#: Return the path to the dialog variant binary |
53
|
|
|
|
|
|
|
sub get_bin { |
54
|
1
|
50
|
|
1
|
0
|
388
|
return $_[0]->{'_opts'}{'bin'} if defined $_[0]->{'_opts'}{'bin'}; |
55
|
0
|
|
|
|
|
0
|
return undef; |
56
|
|
|
|
|
|
|
} |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
#: Provide the API interface to nautilus |
59
|
|
|
|
|
|
|
sub nautilus { |
60
|
0
|
|
|
0
|
1
|
0
|
my $self = $_[0]; |
61
|
0
|
|
0
|
|
|
0
|
my $nautilus = $self->{'_nautilus'} || {}; |
62
|
0
|
0
|
|
|
|
0
|
unless (ref($nautilus) eq "UI::Dialog::Backend::Nautilus") { |
63
|
0
|
0
|
|
|
|
0
|
if ($self->_find_bin('nautilus')) { |
64
|
0
|
0
|
|
|
|
0
|
if (eval "require UI::Dialog::Backend::Nautilus; 1") { |
65
|
0
|
|
|
|
|
0
|
require UI::Dialog::Backend::Nautilus; |
66
|
0
|
|
|
|
|
0
|
$self->{'_nautilus'} = new UI::Dialog::Backend::Nautilus; |
67
|
|
|
|
|
|
|
} |
68
|
|
|
|
|
|
|
} |
69
|
|
|
|
|
|
|
} |
70
|
0
|
|
|
|
|
0
|
return($self->{'_nautilus'}); |
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
#: Provide the API interface to osd_cat (aka: xosd) |
74
|
|
|
|
|
|
|
sub xosd { |
75
|
0
|
|
|
0
|
1
|
0
|
my $self = shift(); |
76
|
0
|
0
|
|
|
|
0
|
my @args = (@_ %2 == 0) ? (@_) : (); |
77
|
0
|
|
0
|
|
|
0
|
my $xosd = $self->{'_xosd'} || {}; |
78
|
0
|
0
|
|
|
|
0
|
unless (ref($xosd) eq "UI::Dialog::Backend::XOSD") { |
79
|
0
|
0
|
|
|
|
0
|
if ($self->_find_bin('osd_cat')) { |
80
|
0
|
0
|
|
|
|
0
|
if (eval "require UI::Dialog::Backend::XOSD; 1") { |
81
|
0
|
|
|
|
|
0
|
require UI::Dialog::Backend::XOSD; |
82
|
0
|
|
|
|
|
0
|
$self->{'_xosd'} = new UI::Dialog::Backend::XOSD (@args); |
83
|
|
|
|
|
|
|
} |
84
|
|
|
|
|
|
|
} |
85
|
|
|
|
|
|
|
} |
86
|
0
|
|
|
|
|
0
|
return($self->{'_xosd'}); |
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
#: Provide the API interface to notify-send |
90
|
|
|
|
|
|
|
sub notify_send { |
91
|
0
|
|
|
0
|
1
|
0
|
my $self = shift(); |
92
|
0
|
0
|
|
|
|
0
|
my @args = (@_ %2 == 0) ? (@_) : (); |
93
|
0
|
|
0
|
|
|
0
|
my $notify_send = $self->{'_notify_send'} || {}; |
94
|
0
|
0
|
|
|
|
0
|
unless (ref($notify_send) eq "UI::Dialog::Backend::NotifySend") { |
95
|
0
|
0
|
|
|
|
0
|
if ($self->_find_bin('notify-send')) { |
96
|
0
|
0
|
|
|
|
0
|
if (eval "require UI::Dialog::Backend::NotifySend; 1") { |
97
|
0
|
|
|
|
|
0
|
require UI::Dialog::Backend::NotifySend; |
98
|
0
|
|
|
|
|
0
|
$self->{'_notify_send'} = new UI::Dialog::Backend::NotifySend (@args); |
99
|
|
|
|
|
|
|
} |
100
|
|
|
|
|
|
|
} |
101
|
|
|
|
|
|
|
} |
102
|
0
|
|
|
|
|
0
|
return($self->{'_notify_send'}); |
103
|
|
|
|
|
|
|
} |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
#:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: |
106
|
|
|
|
|
|
|
#: State Methods |
107
|
|
|
|
|
|
|
#: |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
#: enable altering of attributes |
110
|
|
|
|
|
|
|
sub attr { |
111
|
0
|
|
|
0
|
1
|
0
|
my $self = $_[0]; |
112
|
0
|
|
|
|
|
0
|
my $name = $_[1]; |
113
|
0
|
0
|
|
|
|
0
|
unless ($_[2]) { |
114
|
0
|
0
|
|
|
|
0
|
return($self->{'_opts'}->{$name}) unless not $self->{'_opts'}->{$name}; |
115
|
0
|
|
|
|
|
0
|
return(undef()); |
116
|
|
|
|
|
|
|
} |
117
|
0
|
0
|
0
|
|
|
0
|
if ($_[2] == 0 || $_[2] =~ /^NULL$/i) { |
118
|
0
|
|
|
|
|
0
|
$self->{'_opts'}->{$name} = 0; |
119
|
|
|
|
|
|
|
} |
120
|
|
|
|
|
|
|
else { |
121
|
0
|
|
|
|
|
0
|
$self->{'_opts'}->{$name} = $_[2]; |
122
|
|
|
|
|
|
|
} |
123
|
0
|
|
|
|
|
0
|
return($self->{'_opts'}->{$name}); |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
#: return the last response data as an ARRAY |
127
|
|
|
|
|
|
|
sub ra { |
128
|
14
|
|
|
14
|
1
|
21
|
my $self = shift(); |
129
|
14
|
100
|
|
|
|
95
|
$self->_debug((join(" | ",(caller())))." > ra() > rset: ".((@_) ? "@_" : 'NULL'),3); |
130
|
14
|
100
|
|
|
|
76
|
$self->{'_state'}->{'ra'} = ($_[0] =~ /^null$/i) ? [ 0 ] : [ @_ ] unless not @_; |
|
|
100
|
|
|
|
|
|
131
|
14
|
|
|
|
|
26
|
my $aref = $self->{'_state'}->{'ra'}; |
132
|
14
|
50
|
|
|
|
36
|
ref($aref) eq "ARRAY" or $aref = []; |
133
|
14
|
|
|
|
|
19
|
return(@{$aref}); |
|
14
|
|
|
|
|
40
|
|
134
|
|
|
|
|
|
|
} |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
#: return the last response data as a SCALAR |
137
|
|
|
|
|
|
|
sub rs { |
138
|
12
|
|
|
12
|
1
|
17
|
my $self = shift(); |
139
|
12
|
|
|
|
|
20
|
my $rset = $_[0]; |
140
|
12
|
100
|
|
|
|
63
|
$self->_debug((join(" | ",(caller())))." > rs() > rset: ".(($rset) ? $rset : 'NULL'),3); |
141
|
12
|
100
|
|
|
|
51
|
$self->{'_state'}->{'rs'} = ($rset =~ /^null$/i) ? 0 : $rset unless not $rset; |
|
|
100
|
|
|
|
|
|
142
|
12
|
|
|
|
|
26
|
return($self->{'_state'}->{'rs'}); |
143
|
|
|
|
|
|
|
} |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
#: return the last exit code as a SCALAR |
146
|
|
|
|
|
|
|
sub rv { |
147
|
11
|
|
|
11
|
1
|
13
|
my $self = shift(); |
148
|
11
|
|
|
|
|
25
|
my $rset = $_[0]; |
149
|
11
|
50
|
|
|
|
59
|
$self->_debug((join(" | ",(caller())))." > rv() > rset: ".(($rset) ? $rset : 'NULL'),3); |
150
|
11
|
50
|
|
|
|
52
|
$self->{'_state'}->{'rv'} = ($rset =~ /^null$/i) ? '0' : $rset unless not $rset; |
|
|
50
|
|
|
|
|
|
151
|
11
|
|
|
|
|
28
|
return($self->{'_state'}->{'rv'}); |
152
|
|
|
|
|
|
|
} |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
#: report on the state of the last dialog variant execution. |
155
|
|
|
|
|
|
|
sub state { |
156
|
0
|
|
|
0
|
1
|
0
|
my $self = shift(); |
157
|
0
|
|
0
|
|
|
0
|
my $rv = $self->rv() || 0; |
158
|
0
|
|
0
|
|
|
0
|
$self->_debug((join(" | ",(caller())))." > state() > is: ".($rv||'NULL'),2); |
159
|
0
|
0
|
0
|
|
|
0
|
if ($rv == 1 or $rv == 129) { |
|
|
0
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
160
|
0
|
|
|
|
|
0
|
return("CANCEL"); |
161
|
|
|
|
|
|
|
} |
162
|
|
|
|
|
|
|
elsif ($rv == 2) { |
163
|
0
|
|
|
|
|
0
|
return("HELP"); |
164
|
|
|
|
|
|
|
} |
165
|
|
|
|
|
|
|
elsif ($rv == 3) { |
166
|
0
|
|
|
|
|
0
|
return("EXTRA"); |
167
|
|
|
|
|
|
|
} |
168
|
|
|
|
|
|
|
elsif ($rv == 254) { |
169
|
0
|
|
|
|
|
0
|
return("ERROR"); |
170
|
|
|
|
|
|
|
} |
171
|
|
|
|
|
|
|
elsif ($rv == 255) { |
172
|
0
|
|
|
|
|
0
|
return("ESC"); |
173
|
|
|
|
|
|
|
} |
174
|
|
|
|
|
|
|
elsif (not $rv or $rv =~ /^null$/i) { |
175
|
0
|
|
|
|
|
0
|
return("OK"); |
176
|
|
|
|
|
|
|
} |
177
|
|
|
|
|
|
|
else { |
178
|
0
|
|
|
|
|
0
|
return("UNKNOWN(".$rv.")"); |
179
|
|
|
|
|
|
|
} |
180
|
|
|
|
|
|
|
} |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
#:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: |
183
|
|
|
|
|
|
|
#: Preparation Methods |
184
|
|
|
|
|
|
|
# |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
#: construct a HASHREF for command {{tag}} substitutions |
187
|
|
|
|
|
|
|
sub make_kvt { |
188
|
10
|
|
|
10
|
0
|
16
|
my ($self,$args,$value) = @_; |
189
|
|
|
|
|
|
|
return |
190
|
|
|
|
|
|
|
{ |
191
|
|
|
|
|
|
|
literal => ($args->{'literal'} || 0), |
192
|
|
|
|
|
|
|
width => ($args->{'width'}||'65'), |
193
|
10
|
|
50
|
|
|
134
|
trust => ($args->{'trust-input'} || 0), |
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
194
|
|
|
|
|
|
|
value => ($value || '') |
195
|
|
|
|
|
|
|
}; |
196
|
|
|
|
|
|
|
} |
197
|
|
|
|
|
|
|
sub make_kvl { |
198
|
278
|
|
|
278
|
0
|
402
|
my ($self,$args,$value) = @_; |
199
|
|
|
|
|
|
|
return |
200
|
|
|
|
|
|
|
{ |
201
|
|
|
|
|
|
|
literal => 1, |
202
|
|
|
|
|
|
|
width => ($args->{'width'}||'65'), |
203
|
278
|
|
50
|
|
|
2329
|
trust => ($args->{'trust-input'} || 0), |
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
204
|
|
|
|
|
|
|
value => ($value || '') |
205
|
|
|
|
|
|
|
}; |
206
|
|
|
|
|
|
|
} |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
#: Helper method to generate a base format string, accepts additional |
209
|
|
|
|
|
|
|
#: strings which are considered trusted programmer template input. |
210
|
|
|
|
|
|
|
sub prepare_format { |
211
|
11
|
|
|
11
|
0
|
16
|
my $self = shift(@_); |
212
|
11
|
|
|
|
|
19
|
my $args = shift(@_); |
213
|
|
|
|
|
|
|
# start with our binary path |
214
|
11
|
|
|
|
|
26
|
my $fmt = $self->{'_opts'}{'bin'}; |
215
|
11
|
|
|
|
|
30
|
$fmt = $self->append_format_check($args,$fmt,'title','--title {{title}}'); |
216
|
11
|
|
|
|
|
31
|
return $fmt; |
217
|
|
|
|
|
|
|
} |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
sub append_format { |
220
|
51
|
|
|
51
|
0
|
91
|
my ($self,$fmt,$value) = @_; |
221
|
51
|
50
|
|
|
|
98
|
if (ref($fmt) eq "SCALAR") { |
222
|
0
|
|
|
|
|
0
|
$$fmt .= ' '.$value; |
223
|
|
|
|
|
|
|
} |
224
|
|
|
|
|
|
|
else { |
225
|
51
|
|
|
|
|
129
|
$fmt .= ' '.$value; |
226
|
|
|
|
|
|
|
} |
227
|
51
|
|
|
|
|
124
|
return $fmt; |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
#: simple test and if true; append value to format |
231
|
|
|
|
|
|
|
sub append_format_check { |
232
|
22
|
|
|
22
|
0
|
42
|
my ($self,$args,$fmt,$key,$value) = @_; |
233
|
22
|
50
|
33
|
|
|
115
|
if (exists $args->{$key} and defined $args->{$key}) { |
234
|
22
|
|
|
|
|
51
|
$fmt = $self->append_format($fmt,$value); |
235
|
|
|
|
|
|
|
} |
236
|
22
|
|
|
|
|
52
|
return $fmt; |
237
|
|
|
|
|
|
|
} |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
sub clean_format { |
240
|
293
|
|
|
293
|
0
|
454
|
my ($self,$trust,$sref) = @_; |
241
|
293
|
50
|
|
|
|
696
|
unless (ref($sref) eq "SCALAR") { |
242
|
0
|
|
|
|
|
0
|
die("Programmer error. clean_format requires a SCALAR ref, found: ".ref($sref)); |
243
|
|
|
|
|
|
|
} |
244
|
293
|
|
|
|
|
451
|
$$sref =~ s!\x00!!mg; # remove nulls |
245
|
293
|
100
|
|
|
|
554
|
unless ($trust) { |
246
|
268
|
|
|
|
|
388
|
$$sref =~ s!\`!'!mg; |
247
|
268
|
|
|
|
|
377
|
$$sref =~ s!\$\(!\(!mg; |
248
|
268
|
|
|
|
|
406
|
$$sref =~ s!\$!\\\$!mg; |
249
|
|
|
|
|
|
|
} |
250
|
293
|
|
|
|
|
460
|
$$sref =~ s!"!\\"!mg; # escape double-quotes |
251
|
293
|
|
|
|
|
529
|
return $sref; |
252
|
|
|
|
|
|
|
} |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
#: Given a command string "format" and any key/value replacement pairs, |
255
|
|
|
|
|
|
|
#: construct the exec'able command string. |
256
|
|
|
|
|
|
|
sub prepare_command { |
257
|
11
|
|
|
11
|
0
|
16
|
my $self = shift(@_); |
258
|
11
|
|
|
|
|
16
|
my $args = shift(@_); |
259
|
11
|
|
|
|
|
18
|
my $format = shift(@_); |
260
|
11
|
|
|
|
|
29
|
my (%rpl_add) = @_; |
261
|
11
|
|
|
|
|
18
|
my %rpl = (); |
262
|
11
|
|
|
|
|
16
|
foreach my $key (keys %{$args}) { |
|
11
|
|
|
|
|
63
|
|
263
|
275
|
|
100
|
|
|
1056
|
$rpl{$key} = $self->make_kvl($args,$args->{$key}||''); |
264
|
|
|
|
|
|
|
} |
265
|
11
|
|
|
|
|
38
|
foreach my $key (keys %rpl_add) { |
266
|
13
|
|
|
|
|
42
|
$rpl{$key} = $rpl_add{$key}; |
267
|
|
|
|
|
|
|
} |
268
|
11
|
|
|
|
|
49
|
foreach my $key (keys %rpl) { |
269
|
275
|
|
100
|
|
|
988
|
my $value = $rpl{$key}->{value}||''; |
270
|
275
|
100
|
|
|
|
736
|
if (ref($value) eq "ARRAY") { |
|
|
50
|
|
|
|
|
|
271
|
|
|
|
|
|
|
#: menu, checklist, radiolist... |
272
|
3
|
|
|
|
|
6
|
my $list = ''; |
273
|
3
|
|
|
|
|
4
|
foreach my $item (@{$value}) { |
|
3
|
|
|
|
|
7
|
|
274
|
12
|
100
|
|
|
|
30
|
if (ref($item) eq "ARRAY") { |
275
|
|
|
|
|
|
|
# checklist, radiolist... |
276
|
4
|
50
|
|
|
|
6
|
if (@{$item} == 2) { |
|
4
|
0
|
|
|
|
11
|
|
|
|
0
|
|
|
|
|
|
277
|
4
|
|
|
|
|
12
|
$self->clean_format( $rpl{$key}->{trust}, \$item->[0] ); |
278
|
4
|
100
|
|
|
|
14
|
$list .= ' "'.$item->[0].'" "'.($item->[1] ? 'on' : 'off').'"'; |
279
|
4
|
|
|
|
|
10
|
next; |
280
|
|
|
|
|
|
|
} |
281
|
0
|
|
|
|
|
0
|
elsif (@{$item} == 3) { |
282
|
0
|
|
|
|
|
0
|
$self->clean_format( $rpl{$key}->{trust}, \$item->[0] ); |
283
|
0
|
|
|
|
|
0
|
$self->clean_format( $rpl{$key}->{trust}, \$item->[2] ); |
284
|
0
|
0
|
0
|
|
|
0
|
$list .= ' "'.$item->[0].'" "'.($item->[1] ? 'on' : 'off').'" "'.($item->[2]||1).'"'; |
285
|
0
|
|
|
|
|
0
|
next; |
286
|
|
|
|
|
|
|
} |
287
|
0
|
|
|
|
|
0
|
elsif (@{$item} == 4) { |
288
|
0
|
|
|
|
|
0
|
$self->clean_format( $rpl{$key}->{trust}, \$item->[0] ); |
289
|
0
|
|
|
|
|
0
|
$self->clean_format( $rpl{$key}->{trust}, \$item->[2] ); |
290
|
0
|
|
|
|
|
0
|
$self->clean_format( $rpl{$key}->{trust}, \$item->[3] ); |
291
|
0
|
0
|
0
|
|
|
0
|
$list .= ' "'.$item->[0].'" "'.($item->[1] ? 'on' : 'off').'" "'.($item->[2]||1).'"'; |
292
|
0
|
|
|
|
|
0
|
$list .= ' "'.$item->[3].'"'; |
293
|
0
|
|
|
|
|
0
|
next; |
294
|
|
|
|
|
|
|
} |
295
|
|
|
|
|
|
|
} |
296
|
|
|
|
|
|
|
# menu... |
297
|
8
|
|
|
|
|
26
|
$self->clean_format( $rpl{$key}->{trust}, \$item ); |
298
|
8
|
|
|
|
|
18
|
$list .= ' "'.$item.'"'; |
299
|
|
|
|
|
|
|
} |
300
|
3
|
|
|
|
|
25
|
$format =~ s!\{\{\Q${key}\E\}\}!${list}!mg; |
301
|
|
|
|
|
|
|
} # if (ref($value) eq "ARRAY") |
302
|
|
|
|
|
|
|
elsif ($key eq "list") { |
303
|
|
|
|
|
|
|
# assume this has been manipulated already? |
304
|
0
|
|
|
|
|
0
|
$format =~ s!\{\{\Q${key}\E\}\}!${value}!mg; |
305
|
|
|
|
|
|
|
} |
306
|
|
|
|
|
|
|
else { |
307
|
272
|
50
|
0
|
|
|
541
|
$value ||= '' unless defined $value; |
308
|
272
|
100
|
|
|
|
742
|
$value = "$1" if $value =~ m!^(\d+)$!; |
309
|
272
|
50
|
|
|
|
693
|
if (ref(\$value) eq "SCALAR") { |
310
|
272
|
100
|
66
|
|
|
952
|
unless ($rpl{$key}->{'trust'}||$rpl{$key}->{literal}) { |
311
|
|
|
|
|
|
|
$value = $self->_organize_text |
312
|
9
|
|
|
|
|
26
|
( $value, $rpl{$key}->{width}, $rpl{$key}->{'trust'} ); |
313
|
|
|
|
|
|
|
} |
314
|
272
|
|
|
|
|
702
|
$self->clean_format( $rpl{$key}->{'trust'}, \$value ); |
315
|
272
|
|
|
|
|
2757
|
$format =~ s!\{\{\Q${key}\E\}\}!"${value}"!mg; |
316
|
|
|
|
|
|
|
} |
317
|
|
|
|
|
|
|
} |
318
|
|
|
|
|
|
|
} |
319
|
11
|
|
|
|
|
172
|
return $format; |
320
|
|
|
|
|
|
|
} |
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
#:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: |
324
|
|
|
|
|
|
|
#: Execution Methods |
325
|
|
|
|
|
|
|
#: |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
sub is_unit_test_mode { |
328
|
11
|
|
|
11
|
0
|
19
|
my ($self) = @_; |
329
|
|
|
|
|
|
|
return 1 |
330
|
|
|
|
|
|
|
if ( exists $self->{'test_mode'} |
331
|
|
|
|
|
|
|
&& |
332
|
|
|
|
|
|
|
defined $self->{'test_mode'} |
333
|
|
|
|
|
|
|
&& |
334
|
11
|
50
|
33
|
|
|
107
|
$self->{'test_mode'} |
|
|
|
33
|
|
|
|
|
335
|
|
|
|
|
|
|
); |
336
|
0
|
|
|
|
|
0
|
return 0; |
337
|
|
|
|
|
|
|
} |
338
|
|
|
|
|
|
|
sub get_unit_test_result { |
339
|
11
|
|
|
11
|
0
|
25
|
my ($self) = @_; |
340
|
11
|
|
|
|
|
70
|
return $self->{'test_mode_result'}; |
341
|
|
|
|
|
|
|
} |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
#: execute a simple command (return the exit code only); |
344
|
|
|
|
|
|
|
sub command_state { |
345
|
0
|
|
|
0
|
1
|
0
|
my $self = $_[0]; |
346
|
0
|
|
|
|
|
0
|
my $cmnd = $_[1]; |
347
|
0
|
0
|
|
|
|
0
|
if ($self->is_unit_test_mode()) { |
348
|
0
|
|
|
|
|
0
|
$self->{'test_mode_result'} = $cmnd; |
349
|
0
|
|
|
|
|
0
|
return 0; |
350
|
|
|
|
|
|
|
} |
351
|
0
|
|
|
|
|
0
|
$self->_debug("command: ".$cmnd,1); |
352
|
0
|
|
|
|
|
0
|
system($cmnd . " 2>&1 > /dev/null"); |
353
|
0
|
|
|
|
|
0
|
my $rv = $? >> 8; |
354
|
0
|
|
|
|
|
0
|
$self->_debug("command rv: ".$rv,2); |
355
|
0
|
|
|
|
|
0
|
return($rv); |
356
|
|
|
|
|
|
|
} |
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
#: execute a command and return the exit code and one-line SCALAR |
359
|
|
|
|
|
|
|
sub command_string { |
360
|
0
|
|
|
0
|
1
|
0
|
my $self = $_[0]; |
361
|
0
|
|
|
|
|
0
|
my $cmnd = $_[1]; |
362
|
0
|
0
|
|
|
|
0
|
if ($self->is_unit_test_mode()) { |
363
|
0
|
|
|
|
|
0
|
$self->{'test_mode_result'} = $cmnd; |
364
|
0
|
0
|
|
|
|
0
|
return (wantarray) ? (0,'') : ''; |
365
|
|
|
|
|
|
|
} |
366
|
0
|
|
|
|
|
0
|
$self->_debug("command: ".$cmnd,1); |
367
|
0
|
|
|
|
|
0
|
chomp(my $text = `$cmnd 2>&1`); |
368
|
0
|
|
|
|
|
0
|
my $rv = $? >> 8; |
369
|
0
|
|
|
|
|
0
|
$self->_debug("command rs: ".$rv." '".$text."'",2); |
370
|
0
|
0
|
|
|
|
0
|
return($text) unless defined wantarray; |
371
|
0
|
0
|
|
|
|
0
|
return (wantarray) ? ($rv,$text) : $text; |
372
|
|
|
|
|
|
|
} |
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
#: execute a command and return the exit code and ARRAY of data |
375
|
|
|
|
|
|
|
sub command_array { |
376
|
0
|
|
|
0
|
1
|
0
|
my $self = $_[0]; |
377
|
0
|
|
|
|
|
0
|
my $cmnd = $_[1]; |
378
|
0
|
0
|
|
|
|
0
|
if ($self->is_unit_test_mode()) { |
379
|
0
|
|
|
|
|
0
|
$self->{'test_mode_result'} = $cmnd; |
380
|
0
|
0
|
|
|
|
0
|
return (wantarray) ? (0,[]) : []; |
381
|
|
|
|
|
|
|
} |
382
|
0
|
|
|
|
|
0
|
$self->_debug("command: ".$cmnd,1); |
383
|
0
|
|
|
|
|
0
|
chomp(my $text = `$cmnd 2>&1`); |
384
|
0
|
|
|
|
|
0
|
my $rv = $? >> 8; |
385
|
0
|
|
|
|
|
0
|
$self->_debug("command ra: ".$rv." '".$text."'",2); |
386
|
0
|
0
|
|
|
|
0
|
return([split(/\n/,$text)]) unless defined wantarray; |
387
|
0
|
0
|
|
|
|
0
|
return (wantarray) ? ($rv,[split(/\n/,$text)]) : [split(/\n/,$text)]; |
388
|
|
|
|
|
|
|
} |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
#:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: |
391
|
|
|
|
|
|
|
#: Utility Methods |
392
|
|
|
|
|
|
|
#: |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
#: make some noise |
396
|
|
|
|
|
|
|
sub beep { |
397
|
0
|
|
|
0
|
1
|
0
|
my $self = $_[0]; |
398
|
0
|
|
|
|
|
0
|
return($self->_beep(1)); |
399
|
|
|
|
|
|
|
} |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
#: Clear terminal screen. |
402
|
|
|
|
|
|
|
sub clear { |
403
|
0
|
|
|
0
|
1
|
0
|
my $self = $_[0]; |
404
|
0
|
|
|
|
|
0
|
return($self->_clear(1)); |
405
|
|
|
|
|
|
|
} |
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
# word-wrap a line |
408
|
|
|
|
|
|
|
sub word_wrap { |
409
|
9
|
|
|
9
|
1
|
11
|
my $self = shift(); |
410
|
9
|
|
50
|
|
|
20
|
my $width = shift() || 65; |
411
|
9
|
|
50
|
|
|
37
|
my $indent = shift() || ""; |
412
|
9
|
|
50
|
|
|
33
|
my $sub_indent = shift() || ""; |
413
|
9
|
|
|
|
|
14
|
$Text::Wrap::columns = $width; |
414
|
9
|
|
|
|
|
31
|
my @strings = wrap($indent, $sub_indent, @_); |
415
|
9
|
|
|
|
|
1316
|
return(@strings); |
416
|
|
|
|
|
|
|
} |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
# generate a temporary file name |
419
|
|
|
|
|
|
|
sub gen_tempfile_name { |
420
|
0
|
|
|
0
|
1
|
0
|
my $self = $_[0]; |
421
|
0
|
|
0
|
|
|
0
|
my $template = $self->{'_opts'}->{'tempfiletemplate'} || "UI_Dialog_tempfile_XXXXX"; |
422
|
0
|
0
|
|
|
|
0
|
if (eval("require File::Temp; 1")) { |
423
|
6
|
|
|
6
|
|
7396
|
use File::Temp qw( tempfile ); |
|
6
|
|
|
|
|
105096
|
|
|
6
|
|
|
|
|
20583
|
|
424
|
0
|
0
|
|
|
|
0
|
my ($fh,$filename) = tempfile( UNLINK => 1 ) or croak( "Can't create tempfile: $!" ); |
425
|
0
|
0
|
|
|
|
0
|
if (wantarray) { |
426
|
0
|
|
|
|
|
0
|
return($fh,$filename); |
427
|
|
|
|
|
|
|
} |
428
|
|
|
|
|
|
|
else { |
429
|
0
|
|
|
|
|
0
|
close($fh); # actually required on win32 |
430
|
0
|
|
|
|
|
0
|
return($filename); |
431
|
|
|
|
|
|
|
} |
432
|
0
|
|
|
|
|
0
|
return($fh,$filename); |
433
|
|
|
|
|
|
|
} |
434
|
|
|
|
|
|
|
else { |
435
|
0
|
|
|
|
|
0
|
my $mktemp = $self->_find_bin('mktemp'); |
436
|
0
|
0
|
0
|
|
|
0
|
if ($mktemp && -x $mktemp) { |
437
|
0
|
|
|
|
|
0
|
chomp(my $tempfile = `$mktemp "$template"`); |
438
|
0
|
|
|
|
|
0
|
return($tempfile); |
439
|
|
|
|
|
|
|
} |
440
|
|
|
|
|
|
|
else { |
441
|
|
|
|
|
|
|
#pseudo-random filename coming up! |
442
|
0
|
|
|
|
|
0
|
my $tempdir = "/tmp"; |
443
|
0
|
0
|
|
|
|
0
|
unless (-d $tempdir) { |
444
|
0
|
0
|
|
|
|
0
|
if (-d "/var/tmp") { |
445
|
0
|
|
|
|
|
0
|
$tempdir = "/var/tmp"; |
446
|
|
|
|
|
|
|
} |
447
|
|
|
|
|
|
|
else { |
448
|
0
|
|
|
|
|
0
|
$tempdir = "."; |
449
|
|
|
|
|
|
|
} |
450
|
|
|
|
|
|
|
} |
451
|
0
|
|
|
|
|
0
|
$self->gen_random_string(5); |
452
|
0
|
|
|
|
|
0
|
my $tempfile = "UI_Dialog_tempfile_".$self->gen_random_string(5); |
453
|
0
|
|
|
|
|
0
|
while (-e $tempdir."/".$tempfile) { |
454
|
0
|
|
|
|
|
0
|
$self->gen_random_string(5); |
455
|
0
|
|
|
|
|
0
|
$tempfile = "UI_Dialog_tempfile_".$self->gen_random_string(5); |
456
|
|
|
|
|
|
|
} |
457
|
0
|
|
|
|
|
0
|
return($tempdir."/".$tempfile); |
458
|
|
|
|
|
|
|
} |
459
|
|
|
|
|
|
|
} |
460
|
|
|
|
|
|
|
} |
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
# generate a random string as a (possibly) suitable failover option in the |
463
|
|
|
|
|
|
|
# event that File::Temp is not installed and the 'mktemp' program does not |
464
|
|
|
|
|
|
|
# exist in the path. |
465
|
|
|
|
|
|
|
sub gen_random_string { |
466
|
0
|
|
|
0
|
1
|
0
|
my $self = $_[0]; |
467
|
0
|
|
0
|
|
|
0
|
my $length = $_[1] || 5; |
468
|
0
|
|
|
|
|
0
|
my $string = ""; |
469
|
0
|
|
|
|
|
0
|
my $counter = 0; |
470
|
0
|
|
|
|
|
0
|
while ($counter < $length) { |
471
|
|
|
|
|
|
|
# 33 - 127 |
472
|
0
|
|
|
|
|
0
|
my $num = rand(128); |
473
|
0
|
|
0
|
|
|
0
|
while ($num < 33 or $num > 127) { |
474
|
0
|
|
|
|
|
0
|
$num = rand(128); |
475
|
|
|
|
|
|
|
} |
476
|
0
|
|
|
|
|
0
|
$string .= chr($num); |
477
|
0
|
|
|
|
|
0
|
$counter++; |
478
|
|
|
|
|
|
|
} |
479
|
0
|
|
|
|
|
0
|
return($string); |
480
|
|
|
|
|
|
|
} |
481
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
#:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: |
483
|
|
|
|
|
|
|
#: Widget Wrapping Methods |
484
|
|
|
|
|
|
|
#: |
485
|
|
|
|
|
|
|
|
486
|
|
|
|
|
|
|
#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
487
|
|
|
|
|
|
|
#: file select |
488
|
|
|
|
|
|
|
sub fselect { |
489
|
0
|
|
|
0
|
1
|
0
|
my $self = shift(); |
490
|
0
|
|
0
|
|
|
0
|
my $caller = (caller(1))[3] || 'main'; |
491
|
0
|
0
|
0
|
|
|
0
|
$caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller; |
492
|
0
|
0
|
0
|
|
|
0
|
if ($_[0] && $_[0] eq 'caller') { |
493
|
0
|
|
|
|
|
0
|
shift(); $caller = shift(); |
|
0
|
|
|
|
|
0
|
|
494
|
|
|
|
|
|
|
} |
495
|
0
|
|
|
|
|
0
|
my $args = $self->_pre($caller,@_); |
496
|
|
|
|
|
|
|
|
497
|
0
|
|
|
|
|
0
|
$self->rv('NULL'); |
498
|
0
|
|
|
|
|
0
|
$self->rs('NULL'); |
499
|
0
|
|
|
|
|
0
|
$self->ra('NULL'); |
500
|
|
|
|
|
|
|
|
501
|
0
|
|
|
|
|
0
|
$self->_beep($args->{'beepbefore'}); |
502
|
|
|
|
|
|
|
|
503
|
0
|
|
|
|
|
0
|
my $cwd = abs_path(); |
504
|
0
|
|
0
|
|
|
0
|
$args->{'path'} ||= abs_path(); |
505
|
0
|
|
|
|
|
0
|
my $path = $args->{'path'}; |
506
|
0
|
0
|
0
|
|
|
0
|
if (!$path || $path =~ /^(\.|\.\/)$/) { |
507
|
0
|
|
|
|
|
0
|
$path = $cwd; |
508
|
|
|
|
|
|
|
} |
509
|
0
|
|
|
|
|
0
|
my $file; |
510
|
0
|
|
|
|
|
0
|
my ($menu,$list) = ([],[]); |
511
|
0
|
|
0
|
|
|
0
|
FSEL: while ($self->state() ne "ESC" && $self->state() ne "CANCEL") { |
512
|
0
|
0
|
|
|
|
0
|
my $entries = ($args->{'dselect'}) ? ['[new directory]'] : ['[new file]']; |
513
|
0
|
|
|
|
|
0
|
($menu, $list) = $self->_list_dir($path,$entries); |
514
|
|
|
|
|
|
|
$file = $self->menu(height=>$args->{'height'},width=>$args->{'width'},listheight=>($args->{'listheight'}||$args->{'menuheight'}), |
515
|
0
|
|
0
|
|
|
0
|
title=>$args->{'title'},text=>$path,list=>$menu); |
516
|
0
|
0
|
|
|
|
0
|
if ($self->state() eq "CANCEL") { |
|
|
0
|
|
|
|
|
|
517
|
0
|
|
|
|
|
0
|
$self->rv(1); |
518
|
0
|
|
|
|
|
0
|
$self->rs('NULL'); |
519
|
0
|
|
|
|
|
0
|
$self->ra('NULL'); |
520
|
0
|
|
|
|
|
0
|
last FSEL; |
521
|
|
|
|
|
|
|
} |
522
|
|
|
|
|
|
|
elsif ($file ne "") { |
523
|
0
|
0
|
0
|
|
|
0
|
if ($list->[($file - 1 || 0)] =~ /^\[(new\sdirectory|new\sfile)\]$/) { |
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
524
|
0
|
|
|
|
|
0
|
my $nfn; |
525
|
0
|
|
0
|
|
|
0
|
while (!$nfn || -e $path."/".$nfn) { |
526
|
0
|
|
|
|
|
0
|
$nfn = $self->inputbox(height=>$args->{'height'},width=>$args->{'width'},title=>$args->{'title'}, |
527
|
|
|
|
|
|
|
text=>'Enter a name (will have a base directory of: '.$path.')'); |
528
|
0
|
0
|
0
|
|
|
0
|
next FSEL if $self->state() eq "ESC" or $self->state() eq "CANCEL"; |
529
|
0
|
0
|
|
|
|
0
|
if (-e $path."/".$nfn) { |
530
|
0
|
|
|
|
|
0
|
$self->msgbox(title=>'error',text=>$path."/".$nfn.' already exists! Choose another name please.'); |
531
|
|
|
|
|
|
|
} |
532
|
|
|
|
|
|
|
} |
533
|
0
|
|
|
|
|
0
|
$file = $path."/".$nfn; |
534
|
0
|
0
|
|
|
|
0
|
$file =~ s!/$!! unless $file =~ m!^/$!; |
535
|
0
|
|
|
|
|
0
|
$file =~ s!/\./!/!g; $file =~ s!/+!/!g; |
|
0
|
|
|
|
|
0
|
|
536
|
0
|
|
|
|
|
0
|
last FSEL; |
537
|
|
|
|
|
|
|
} |
538
|
|
|
|
|
|
|
elsif ($list->[($file - 1 || 0)] eq "../") { |
539
|
0
|
|
|
|
|
0
|
$path = dirname($path); |
540
|
|
|
|
|
|
|
} |
541
|
|
|
|
|
|
|
elsif ($list->[($file - 1 || 0)] eq "./") { |
542
|
0
|
|
|
|
|
0
|
$file = $path; |
543
|
0
|
0
|
|
|
|
0
|
$file =~ s!/$!! unless $file =~ m!^/$!; |
544
|
0
|
|
|
|
|
0
|
$file =~ s!/\./!/!g; $file =~ s!/+!/!g; |
|
0
|
|
|
|
|
0
|
|
545
|
0
|
|
|
|
|
0
|
last FSEL; |
546
|
|
|
|
|
|
|
} |
547
|
|
|
|
|
|
|
elsif (-d $path."/".$list->[($file - 1 || 0)]) { |
548
|
0
|
|
0
|
|
|
0
|
$path = $path."/".$list->[($file - 1 || 0)]; |
549
|
|
|
|
|
|
|
} |
550
|
|
|
|
|
|
|
elsif (-e $path."/".$list->[($file - 1 || 0)]) { |
551
|
0
|
|
0
|
|
|
0
|
$file = $path."/".$list->[($file - 1 || 0)]; |
552
|
0
|
0
|
|
|
|
0
|
$file =~ s!/$!! unless $file =~ m!^/$!; |
553
|
0
|
|
|
|
|
0
|
$file =~ s!/\./!/!g; $file =~ s!/+!/!g; |
|
0
|
|
|
|
|
0
|
|
554
|
0
|
|
|
|
|
0
|
last FSEL; |
555
|
|
|
|
|
|
|
} |
556
|
|
|
|
|
|
|
} |
557
|
0
|
|
|
|
|
0
|
$file = undef(); |
558
|
0
|
|
|
|
|
0
|
$path =~ s!(/*)!/!; $path =~ s!/\./!/!g; |
|
0
|
|
|
|
|
0
|
|
559
|
|
|
|
|
|
|
} |
560
|
0
|
|
|
|
|
0
|
$self->_beep($args->{'beepafter'}); |
561
|
0
|
|
|
|
|
0
|
my $rv = $self->rv(); |
562
|
0
|
|
|
|
|
0
|
$self->ra('NULL'); |
563
|
0
|
0
|
0
|
|
|
0
|
if ($rv && $rv >= 1) { |
564
|
0
|
|
|
|
|
0
|
$self->rs('NULL'); |
565
|
0
|
|
|
|
|
0
|
return(0); |
566
|
|
|
|
|
|
|
} |
567
|
|
|
|
|
|
|
else { |
568
|
0
|
|
|
|
|
0
|
$self->rs($file); |
569
|
0
|
|
|
|
|
0
|
return($file); |
570
|
|
|
|
|
|
|
} |
571
|
|
|
|
|
|
|
} |
572
|
|
|
|
|
|
|
|
573
|
|
|
|
|
|
|
#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
574
|
|
|
|
|
|
|
#: directory selection |
575
|
|
|
|
|
|
|
sub dselect { |
576
|
0
|
|
|
0
|
1
|
0
|
my $self = shift(); |
577
|
0
|
|
0
|
|
|
0
|
my $caller = (caller(1))[3] || 'main'; |
578
|
0
|
0
|
0
|
|
|
0
|
$caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller; |
579
|
0
|
0
|
0
|
|
|
0
|
if ($_[0] && $_[0] eq 'caller') { |
580
|
0
|
|
|
|
|
0
|
shift(); $caller = shift(); |
|
0
|
|
|
|
|
0
|
|
581
|
|
|
|
|
|
|
} |
582
|
0
|
|
|
|
|
0
|
my $args = $self->_pre($caller,@_); |
583
|
0
|
|
|
|
|
0
|
my $dirname; |
584
|
0
|
|
|
|
|
0
|
$self->rv('NULL'); |
585
|
0
|
|
|
|
|
0
|
$self->rs('NULL'); |
586
|
0
|
|
|
|
|
0
|
$self->ra('NULL'); |
587
|
0
|
|
0
|
|
|
0
|
while (not $dirname && $self->state() !~ /^(CANCEL|ESC|ERROR)$/) { |
588
|
0
|
|
|
|
|
0
|
$dirname = $self->fselect(@_,'dselect',1); |
589
|
0
|
0
|
|
|
|
0
|
if ($self->state() =~ /^(CANCEL|ESC|ERROR)$/) { |
590
|
0
|
|
|
|
|
0
|
return(0); |
591
|
|
|
|
|
|
|
} |
592
|
0
|
0
|
|
|
|
0
|
unless (not $dirname) { |
593
|
|
|
|
|
|
|
# if it's a directory or not exist (assume new dir) |
594
|
0
|
0
|
0
|
|
|
0
|
unless (-d $dirname || not -e $dirname) { |
595
|
0
|
|
|
|
|
0
|
$self->msgbox( text => $dirname . " is not a directory.\nPlease select a directory." ); |
596
|
0
|
|
|
|
|
0
|
$dirname = undef(); |
597
|
|
|
|
|
|
|
} |
598
|
|
|
|
|
|
|
} |
599
|
|
|
|
|
|
|
} |
600
|
0
|
|
0
|
|
|
0
|
return($dirname||''); |
601
|
|
|
|
|
|
|
} |
602
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
|
604
|
|
|
|
|
|
|
#:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: |
605
|
|
|
|
|
|
|
#: Backend Methods |
606
|
|
|
|
|
|
|
#: |
607
|
|
|
|
|
|
|
|
608
|
|
|
|
|
|
|
sub _pre { |
609
|
11
|
|
|
11
|
|
15
|
my $self = shift(); |
610
|
11
|
|
|
|
|
25
|
my $caller = shift(); |
611
|
11
|
|
|
|
|
33
|
my $args = $self->_merge_attrs(@_); |
612
|
11
|
|
|
|
|
24
|
$args->{'caller'} = $caller; |
613
|
11
|
|
|
|
|
17
|
my $class = ref($self); |
614
|
|
|
|
|
|
|
|
615
|
11
|
|
|
|
|
20
|
my $CODEREFS = $args->{'callbacks'}; |
616
|
11
|
50
|
|
|
|
28
|
if (ref($CODEREFS) eq "HASH") { |
617
|
0
|
|
|
|
|
0
|
my $PRECODE = $CODEREFS->{'PRE'}; |
618
|
0
|
0
|
|
|
|
0
|
if (ref($PRECODE) eq "CODE") { |
619
|
0
|
|
|
|
|
0
|
&$PRECODE($args,$self->state()); |
620
|
|
|
|
|
|
|
} |
621
|
|
|
|
|
|
|
} |
622
|
|
|
|
|
|
|
|
623
|
11
|
|
|
|
|
34
|
$self->_beep($args->{'beepbefore'}); |
624
|
11
|
|
|
|
|
31
|
$self->_clear($args->{'clearbefore'}); |
625
|
11
|
|
|
|
|
32
|
return($args); |
626
|
|
|
|
|
|
|
} |
627
|
|
|
|
|
|
|
|
628
|
|
|
|
|
|
|
sub _post { |
629
|
10
|
|
|
10
|
|
15
|
my $self = shift(); |
630
|
10
|
|
50
|
|
|
23
|
my $args = shift() || {}; |
631
|
10
|
|
|
|
|
20
|
my $class = ref($self); |
632
|
|
|
|
|
|
|
|
633
|
10
|
|
|
|
|
24
|
$self->_beep($args->{'beepafter'}); |
634
|
10
|
|
|
|
|
26
|
$self->_clear($args->{'clearafter'}); |
635
|
|
|
|
|
|
|
|
636
|
10
|
|
|
|
|
19
|
my $CODEREFS = $args->{'callbacks'}; |
637
|
10
|
50
|
|
|
|
22
|
if (ref($CODEREFS) eq "HASH") { |
638
|
0
|
|
|
|
|
0
|
my $state = $self->state(); |
639
|
0
|
0
|
|
|
|
0
|
if ($state eq "OK") { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
640
|
0
|
|
|
|
|
0
|
my $OKCODE = $CODEREFS->{'OK'}; |
641
|
0
|
0
|
|
|
|
0
|
if (ref($OKCODE) eq "CODE") { |
642
|
0
|
|
|
|
|
0
|
&$OKCODE($args); |
643
|
|
|
|
|
|
|
} |
644
|
|
|
|
|
|
|
} |
645
|
|
|
|
|
|
|
elsif ($state eq "ESC") { |
646
|
0
|
|
|
|
|
0
|
my $ESCCODE = $CODEREFS->{'ESC'}; |
647
|
0
|
0
|
|
|
|
0
|
if (ref($ESCCODE) eq "CODE") { |
648
|
0
|
|
|
|
|
0
|
&$ESCCODE($args); |
649
|
|
|
|
|
|
|
} |
650
|
|
|
|
|
|
|
} |
651
|
|
|
|
|
|
|
elsif ($state eq "CANCEL") { |
652
|
0
|
|
|
|
|
0
|
my $CANCELCODE = $CODEREFS->{'CANCEL'}; |
653
|
0
|
0
|
|
|
|
0
|
if (ref($CANCELCODE) eq "CODE") { |
654
|
0
|
|
|
|
|
0
|
&$CANCELCODE($args); |
655
|
|
|
|
|
|
|
} |
656
|
|
|
|
|
|
|
} |
657
|
0
|
|
|
|
|
0
|
my $POSTCODE = $CODEREFS->{'POST'}; |
658
|
0
|
0
|
|
|
|
0
|
if (ref($POSTCODE) eq "CODE") { |
659
|
0
|
|
|
|
|
0
|
&$POSTCODE($args,$state); |
660
|
|
|
|
|
|
|
} |
661
|
|
|
|
|
|
|
} |
662
|
|
|
|
|
|
|
|
663
|
10
|
|
|
|
|
26
|
return(1); |
664
|
|
|
|
|
|
|
} |
665
|
|
|
|
|
|
|
|
666
|
|
|
|
|
|
|
|
667
|
|
|
|
|
|
|
#: indent and organize the text argument |
668
|
|
|
|
|
|
|
sub _organize_text { |
669
|
9
|
|
|
9
|
|
14
|
my $self = $_[0]; |
670
|
9
|
|
|
|
|
15
|
my $text = $_[1]; |
671
|
9
|
|
50
|
|
|
21
|
my $width = $_[2] || 65; |
672
|
9
|
50
|
33
|
|
|
44
|
my $trust = (exists $_[3] && defined $_[3]) ? $_[3] : '0'; |
673
|
9
|
|
|
|
|
15
|
$width -= 4; # take account of borders? |
674
|
9
|
|
|
|
|
10
|
my @array; |
675
|
|
|
|
|
|
|
|
676
|
9
|
50
|
|
|
|
31
|
if (ref($text) eq "ARRAY") { |
|
|
50
|
|
|
|
|
|
677
|
0
|
|
|
|
|
0
|
push(@array,@{$text}); |
|
0
|
|
|
|
|
0
|
|
678
|
|
|
|
|
|
|
} |
679
|
|
|
|
|
|
|
elsif ($text =~ /\\n/) { |
680
|
0
|
|
|
|
|
0
|
@array = split(/\\n/,$text); |
681
|
|
|
|
|
|
|
} |
682
|
|
|
|
|
|
|
else { |
683
|
9
|
|
|
|
|
26
|
@array = split(/\n/,$text); |
684
|
|
|
|
|
|
|
} |
685
|
9
|
|
|
|
|
46
|
$text = undef; |
686
|
|
|
|
|
|
|
|
687
|
9
|
|
|
|
|
29
|
@array = $self->word_wrap($width,"","",@array); |
688
|
|
|
|
|
|
|
|
689
|
9
|
50
|
|
|
|
30
|
if ($self->{'scale'}) { |
690
|
0
|
|
|
|
|
0
|
foreach my $line (@array) { |
691
|
0
|
|
|
|
|
0
|
my $s_line = $line;#$self->__TRANSLATE_CLEAN($line); |
692
|
0
|
|
|
|
|
0
|
$s_line =~ s!\[A\=\w+\]!!gi; |
693
|
|
|
|
|
|
|
$self->{'width'} = length($s_line) + 5 |
694
|
|
|
|
|
|
|
if ($self->{'width'} - 5) < length($s_line) |
695
|
0
|
0
|
0
|
|
|
0
|
&& (length($s_line) <= $self->{'max-scale'}); |
696
|
|
|
|
|
|
|
} |
697
|
|
|
|
|
|
|
} |
698
|
|
|
|
|
|
|
|
699
|
9
|
|
|
|
|
17
|
foreach my $line (@array) { |
700
|
9
|
|
|
|
|
11
|
my $pad; |
701
|
9
|
|
|
|
|
52
|
$self->clean_format( $trust, \$line ); |
702
|
9
|
|
|
|
|
36
|
my $s_line = $self->_strip_text($line); |
703
|
9
|
50
|
|
|
|
25
|
if ($line =~ /\[A\=(\w+)\]/i) { |
704
|
0
|
|
|
|
|
0
|
my $align = $1; |
705
|
0
|
|
|
|
|
0
|
$line =~ s!\[A\=\w+\]!!gi; |
706
|
0
|
0
|
0
|
|
|
0
|
if (uc($align) eq "CENTER" || uc($align) eq "C") { |
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
707
|
0
|
|
|
|
|
0
|
$pad = ((($self->{'_opts'}->{'width'} - 5) - length($s_line)) / 2); |
708
|
|
|
|
|
|
|
} |
709
|
|
|
|
|
|
|
elsif (uc($align) eq "LEFT" || uc($align) eq "L") { |
710
|
0
|
|
|
|
|
0
|
$pad = 0; |
711
|
|
|
|
|
|
|
} |
712
|
|
|
|
|
|
|
elsif (uc($align) eq "RIGHT" || uc($align) eq "R") { |
713
|
0
|
|
|
|
|
0
|
$pad = (($self->{'_opts'}->{'width'} - 5) - length($s_line)); |
714
|
|
|
|
|
|
|
} |
715
|
|
|
|
|
|
|
} |
716
|
9
|
50
|
|
|
|
19
|
if ($pad) { |
717
|
0
|
|
|
|
|
0
|
$text .= (" " x $pad).$line."\n"; |
718
|
|
|
|
|
|
|
} |
719
|
|
|
|
|
|
|
else { |
720
|
9
|
|
|
|
|
25
|
$text .= $line."\n"; |
721
|
|
|
|
|
|
|
} |
722
|
|
|
|
|
|
|
} |
723
|
9
|
|
|
|
|
21
|
$text = $self->_strip_text($text); |
724
|
9
|
|
|
|
|
17
|
chomp($text); |
725
|
9
|
|
|
|
|
21
|
return($text); |
726
|
|
|
|
|
|
|
} |
727
|
|
|
|
|
|
|
|
728
|
|
|
|
|
|
|
#: merge the arguments with the default attributes, and arguments override defaults. |
729
|
|
|
|
|
|
|
sub _merge_attrs { |
730
|
11
|
|
|
11
|
|
15
|
my $self = shift(); |
731
|
11
|
50
|
|
|
|
71
|
my $args = (@_ % 2) ? { @_, '_odd' } : { @_ }; |
732
|
11
|
|
|
|
|
20
|
my $defs = $self->{'_opts'}; |
733
|
|
|
|
|
|
|
|
734
|
11
|
|
|
|
|
65
|
foreach my $def (keys(%$defs)) { |
735
|
|
|
|
|
|
|
# default unless exists |
736
|
209
|
100
|
|
|
|
572
|
$args->{$def} = $defs->{$def} unless exists $args->{$def}; |
737
|
|
|
|
|
|
|
} |
738
|
|
|
|
|
|
|
|
739
|
|
|
|
|
|
|
# alias 'filename' and 'file' to path |
740
|
|
|
|
|
|
|
$args->{'path'} = (($args->{'filename'}) ? $args->{'filename'} : |
741
|
|
|
|
|
|
|
($args->{'file'}) ? $args->{'file'} : |
742
|
11
|
100
|
|
|
|
61
|
($args->{'path'}) ? $args->{'path'} : ""); |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
743
|
|
|
|
|
|
|
|
744
|
11
|
|
50
|
|
|
79
|
$args->{'clear'} = $args->{'clearbefore'} || $args->{'clearafter'} || $args->{'autoclear'} || 0; |
745
|
11
|
|
50
|
|
|
78
|
$args->{'beep'} = $args->{'beepbefore'} || $args->{'beepafter'} || $args->{'autobeep'} || 0; |
746
|
11
|
|
|
|
|
21
|
return($args); |
747
|
|
|
|
|
|
|
} |
748
|
|
|
|
|
|
|
|
749
|
|
|
|
|
|
|
#: search through the given paths for a specific variant |
750
|
|
|
|
|
|
|
sub _find_bin { |
751
|
16
|
|
|
16
|
|
30
|
my $self = $_[0]; |
752
|
16
|
|
|
|
|
31
|
my $variant = $_[1]; |
753
|
|
|
|
|
|
|
$self->{'PATHS'} = ((ref($self->{'PATHS'}) eq "ARRAY") ? $self->{'PATHS'} : |
754
|
16
|
0
|
|
|
|
66
|
($self->{'PATHS'}) ? [ $self->{'PATHS'} ] : |
|
|
50
|
|
|
|
|
|
755
|
|
|
|
|
|
|
[ '/bin', '/usr/bin', '/usr/local/bin', '/opt/bin' ]); |
756
|
16
|
|
|
|
|
27
|
foreach my $PATH (@{$self->{'PATHS'}}) { |
|
16
|
|
|
|
|
51
|
|
757
|
105
|
100
|
|
|
|
53239
|
return($PATH . '/' . $variant) |
758
|
|
|
|
|
|
|
unless not -x $PATH . '/' . $variant; |
759
|
|
|
|
|
|
|
} |
760
|
11
|
|
|
|
|
91
|
return(0); |
761
|
|
|
|
|
|
|
} |
762
|
|
|
|
|
|
|
|
763
|
|
|
|
|
|
|
#: clean the text arguments of all colour codes, alignments and attributes. |
764
|
|
|
|
|
|
|
sub _strip_text { |
765
|
18
|
|
|
18
|
|
26
|
my $self = $_[0]; |
766
|
18
|
|
|
|
|
64
|
my $text = $_[1]; |
767
|
18
|
|
|
|
|
35
|
$text =~ s!\\Z[0-7bBuUrRn]!!gmi; |
768
|
18
|
|
|
|
|
25
|
$text =~ s!\[[AC]=\w+\]!!gmi; |
769
|
18
|
|
|
|
|
26
|
$text =~ s!\[/?[BURN]\]!!gmi; |
770
|
18
|
|
|
|
|
51
|
return($text); |
771
|
|
|
|
|
|
|
} |
772
|
|
|
|
|
|
|
|
773
|
|
|
|
|
|
|
#: is this a BSD system? |
774
|
|
|
|
|
|
|
sub _is_bsd { |
775
|
0
|
|
|
0
|
|
0
|
my $self = shift(); |
776
|
0
|
0
|
|
|
|
0
|
return(1) if $^O =~ /bsd/i; |
777
|
0
|
|
|
|
|
0
|
return(0); |
778
|
|
|
|
|
|
|
} |
779
|
|
|
|
|
|
|
|
780
|
|
|
|
|
|
|
#: gather a list of the contents of a directory and return it in |
781
|
|
|
|
|
|
|
#: two forms, one is the "simple" list of all the filenames and the |
782
|
|
|
|
|
|
|
#: other is a 'menu' list corresponding to the simple list. |
783
|
|
|
|
|
|
|
sub _list_dir { |
784
|
0
|
|
|
0
|
|
0
|
my $self = shift(); |
785
|
0
|
|
0
|
|
|
0
|
my $path = shift() || return(); |
786
|
0
|
|
|
|
|
0
|
my $pref = shift(); |
787
|
0
|
|
|
|
|
0
|
my (@listing,@list); |
788
|
0
|
0
|
|
|
|
0
|
if (opendir(GETDIR,$path)) { |
789
|
0
|
|
|
|
|
0
|
my @dir_data = readdir(GETDIR); |
790
|
0
|
|
|
|
|
0
|
closedir(GETDIR); |
791
|
0
|
0
|
|
|
|
0
|
if ($pref) { |
792
|
0
|
|
|
|
|
0
|
push(@listing,@{$pref}); |
|
0
|
|
|
|
|
0
|
|
793
|
|
|
|
|
|
|
} |
794
|
0
|
|
|
|
|
0
|
foreach my $dir (sort(grep { -d $path."/".$_ } @dir_data)) { |
|
0
|
|
|
|
|
0
|
|
795
|
0
|
|
|
|
|
0
|
push(@listing,$dir."/"); |
796
|
|
|
|
|
|
|
} |
797
|
0
|
|
|
|
|
0
|
foreach my $item (sort(grep { !-d $path."/".$_ } @dir_data)) { |
|
0
|
|
|
|
|
0
|
|
798
|
0
|
|
|
|
|
0
|
push(@listing,$item); |
799
|
|
|
|
|
|
|
} |
800
|
0
|
|
|
|
|
0
|
my $c = 1; |
801
|
0
|
|
|
|
|
0
|
foreach my $item (@listing) { |
802
|
0
|
|
|
|
|
0
|
push(@list,"$c",$item); $c++; |
|
0
|
|
|
|
|
0
|
|
803
|
|
|
|
|
|
|
} |
804
|
0
|
|
|
|
|
0
|
return(\@list,\@listing); |
805
|
|
|
|
|
|
|
} |
806
|
|
|
|
|
|
|
else { |
807
|
0
|
|
|
|
|
0
|
return("failed to read directory: ".$path); |
808
|
|
|
|
|
|
|
} |
809
|
|
|
|
|
|
|
} |
810
|
|
|
|
|
|
|
|
811
|
|
|
|
|
|
|
sub _debug { |
812
|
37
|
|
|
37
|
|
61
|
my $self = $_[0]; |
813
|
37
|
|
50
|
|
|
80
|
my $mesg = $_[1] || 'null debug message given!'; |
814
|
37
|
|
50
|
|
|
80
|
my $rate = $_[2] || 1; |
815
|
37
|
50
|
33
|
|
|
123
|
return() unless $self->{'_opts'}->{'debug'} and $self->{'_opts'}->{'debug'} >= $rate; |
816
|
0
|
|
|
|
|
0
|
chomp($mesg); |
817
|
0
|
|
|
|
|
0
|
print STDERR "Debug: ".$mesg."\n"; |
818
|
|
|
|
|
|
|
} |
819
|
|
|
|
|
|
|
sub _error { |
820
|
0
|
|
|
0
|
|
0
|
my $self = $_[0]; |
821
|
0
|
|
0
|
|
|
0
|
my $mesg = $_[1] || 'null error message given!'; |
822
|
0
|
|
|
|
|
0
|
chomp($mesg); |
823
|
0
|
|
|
|
|
0
|
print STDERR "Error: ".$mesg."\n"; |
824
|
|
|
|
|
|
|
} |
825
|
|
|
|
|
|
|
|
826
|
|
|
|
|
|
|
#: really make some noise |
827
|
|
|
|
|
|
|
sub _beep { |
828
|
21
|
|
|
21
|
|
32
|
my $self = $_[0]; |
829
|
21
|
|
|
|
|
27
|
my $beep = $_[1]; |
830
|
21
|
50
|
|
|
|
49
|
unless (not $beep) { |
831
|
0
|
0
|
|
|
|
0
|
if (-x $self->{'_opts'}->{'beepbin'}) { |
832
|
0
|
|
|
|
|
0
|
return(eval { system($self->{'_opts'}->{'beepbin'}); 1; }); |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
833
|
|
|
|
|
|
|
} |
834
|
|
|
|
|
|
|
else { |
835
|
0
|
0
|
0
|
|
|
0
|
return (1) unless $ENV{'TERM'} && $ENV{'TERM'} ne "dumb"; |
836
|
0
|
|
|
|
|
0
|
print STDERR "\a"; |
837
|
|
|
|
|
|
|
} |
838
|
|
|
|
|
|
|
} |
839
|
21
|
|
|
|
|
33
|
return(1); |
840
|
|
|
|
|
|
|
} |
841
|
|
|
|
|
|
|
|
842
|
|
|
|
|
|
|
#: The actual clear action. |
843
|
|
|
|
|
|
|
sub _clear { |
844
|
21
|
|
|
21
|
|
29
|
my $self = $_[0]; |
845
|
21
|
|
50
|
|
|
78
|
my $clear = $_[1] || 0; |
846
|
|
|
|
|
|
|
# Useless with GUI based variants so we return here. |
847
|
|
|
|
|
|
|
# Is the use of the "dumb" TERM appropriate? need feedback. |
848
|
21
|
50
|
33
|
|
|
107
|
return (1) unless $ENV{'TERM'} && $ENV{'TERM'} ne "dumb"; |
849
|
21
|
50
|
33
|
|
|
107
|
unless (not $clear and not $self->{'_opts'}->{'autoclear'}) { |
850
|
0
|
|
0
|
|
|
0
|
$self->{'_clear'} ||= `clear`; |
851
|
0
|
|
|
|
|
0
|
print STDOUT $self->{'_clear'}; |
852
|
|
|
|
|
|
|
} |
853
|
21
|
|
|
|
|
30
|
return(1); |
854
|
|
|
|
|
|
|
} |
855
|
|
|
|
|
|
|
|
856
|
|
|
|
|
|
|
|
857
|
|
|
|
|
|
|
|
858
|
|
|
|
|
|
|
1; |