1package UI::Dialog::Backend::KDialog;
2###############################################################################
3#  Copyright (C) 2004-2016  Kevin C. Krinke <kevin@krinke.ca>
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###############################################################################
19use 5.006;
20use strict;
21use warnings;
22use Carp;
23use Cwd qw( abs_path );
24use UI::Dialog::Backend;
25
26BEGIN {
27  use vars qw( $VERSION @ISA );
28  @ISA = qw( UI::Dialog::Backend );
29  $VERSION = '1.21';
30}
31
32#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
33#: Constructor Method
34#:
35
36sub new {
37  my $proto = shift();
38  my $class = ref($proto) || $proto;
39  my $cfg = ((ref($_[0]) eq "HASH") ? $_[0] : (@_) ? { @_ } : {});
40  my $self = {};
41  bless($self, $class);
42  $self->{'_state'} = {};
43  $self->{'_opts'} = {};
44
45	#: Dynamic path discovery...
46	my $CFG_PATH = $cfg->{'PATH'};
47	if ($CFG_PATH) {
48		if (ref($CFG_PATH) eq "ARRAY") {
49      $self->{'PATHS'} = $CFG_PATH;
50    }
51		elsif ($CFG_PATH =~ m!:!) {
52      $self->{'PATHS'} = [ split(/:/,$CFG_PATH) ];
53    }
54		elsif (-d $CFG_PATH) {
55      $self->{'PATHS'} = [ $CFG_PATH ];
56    }
57	}
58  elsif ($ENV{'PATH'}) {
59    $self->{'PATHS'} = [ split(/:/,$ENV{'PATH'}) ];
60  }
61	else {
62    $self->{'PATHS'} = '';
63  }
64
65	$self->{'_opts'}->{'literal'} = $cfg->{'literal'} || 0;
66  $self->{'_opts'}->{'callbacks'} = $cfg->{'callbacks'} || undef();
67  $self->{'_opts'}->{'debug'} = $cfg->{'debug'} || undef();
68  $self->{'_opts'}->{'caption'} = $cfg->{'caption'} || undef();
69  $self->{'_opts'}->{'icon'} = $cfg->{'icon'} || undef();
70  $self->{'_opts'}->{'miniicon'} = $cfg->{'miniicon'} || undef();
71  $self->{'_opts'}->{'title'} = $cfg->{'title'} || undef();
72  $self->{'_opts'}->{'width'} = $cfg->{'width'} || 65;
73  $self->{'_opts'}->{'height'} = $cfg->{'height'} || 10;
74  $self->{'_opts'}->{'bin'} ||= $self->_find_bin('kdialog');
75  $self->{'_opts'}->{'autoclear'} = $cfg->{'autoclear'} || 0;
76  $self->{'_opts'}->{'clearbefore'} = $cfg->{'clearbefore'} || 0;
77  $self->{'_opts'}->{'clearafter'} = $cfg->{'clearafter'} || 0;
78  $self->{'_opts'}->{'beepbin'} = $cfg->{'beepbin'} || $self->_find_bin('beep') || '/usr/bin/beep';
79  $self->{'_opts'}->{'beepbefore'} = $cfg->{'beepbefore'} || 0;
80  $self->{'_opts'}->{'beepafter'} = $cfg->{'beepafter'} || 0;
81  $self->{'_opts'}->{'timeout'} = $cfg->{'timeout'} || 0;
82  $self->{'_opts'}->{'wait'} = $cfg->{'wait'} || 0;
83  unless (-x $self->{'_opts'}->{'bin'}) {
84		croak("the kdialog binary could not be found at: ".$self->{'_opts'}->{'bin'});
85  }
86
87  $self->{'_opts'}->{'trust-input'} = $cfg->{'trust-input'} || 0;
88
89  $self->{'test_mode'} = $cfg->{'test_mode'} if exists $cfg->{'test_mode'};
90  $self->{'test_mode_result'} = '';
91
92  return($self);
93}
94
95#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
96#: Private Methods
97#:
98
99sub append_format_base {
100  my ($self,$args,$fmt) = @_;
101  $fmt = $self->append_format_check($args,$fmt,'caption','--caption {{caption}}');
102  $fmt = $self->append_format_check($args,$fmt,'icon','--icon {{icon}}');
103  $fmt = $self->append_format_check($args,$fmt,'miniicon','--miniicon {{miniicon}}');
104  if ($self->{'_opts'}->{'force-no-separate-output'}) {
105    delete $args->{'separate-output'};
106  }
107  else {
108    $fmt = $self->append_format_check($args,$fmt,"separate-output","--separate-output");
109  }
110  return $fmt;
111}
112
113#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
114#: Public Methods
115#:
116
117
118#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
119#: Ask a binary question (Yes/No)
120sub yesno {
121  my $self = shift();
122  my $caller = (caller(1))[3] || 'main';
123  $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
124  if ($_[0] && $_[0] eq 'caller') {
125    shift(); $caller = shift();
126  }
127  my $args = $self->_pre($caller,@_);
128
129  $args->{'yesno'} ||= "yesno";
130
131  my $fmt = $self->prepare_format($args);
132  $fmt = $self->append_format_base($args,$fmt);
133  $fmt = $self->append_format($fmt,'--'.$args->{'yesno'}.' {{text}} {{height}} {{width}}');
134  my $command = $self->prepare_command
135    ( $args, $fmt,
136      text => $self->make_kvt($args,$args->{'text'}),
137    );
138
139  my $rv = $self->command_state($command);
140  if ($rv && $rv >= 1) {
141    $self->ra("NO");
142    $self->rs("NO");
143    $self->rv($rv);
144  } else {
145    $self->ra("YES");
146    $self->rs("YES");
147    $self->rv('null');
148  }
149  $self->_post($args);
150  return($rv == 0 ? 1 : 0);
151}
152sub yesnocancel {
153  my $self = shift();
154  return($self->yesno('caller',((caller(1))[3]||'main'),@_,'yesno','yesnocancel'));
155}
156sub warningyesno {
157  my $self = shift();
158  return($self->yesno('caller',((caller(1))[3]||'main'),@_,'yesno','warningyesno'));
159}
160sub warningyesnocancel {
161  my $self = shift();
162  return($self->yesno('caller',((caller(1))[3]||'main'),@_,'yesno','warningyesnocancel'));
163}
164#: Broken documented "feature"
165# sub warningcontinuecancel {
166#     my $self = shift();
167#     return($self->yesno(@_,'yesno','warningcontinuecancel'));
168# }
169sub noyes {
170  my $self = shift();
171  return($self->yesno('caller',((caller(1))[3]||'main'),@_));
172}
173
174#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
175#: Text entry
176sub inputbox {
177  my $self = shift();
178  my $caller = (caller(1))[3] || 'main';
179  $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
180  if ($_[0] && $_[0] eq 'caller') {
181    shift(); $caller = shift();
182  }
183  my $args = $self->_pre($caller,@_);
184
185  $args->{'inputbox'} ||= 'inputbox';
186
187  my $fmt = $self->prepare_format($args);
188  $fmt = $self->append_format_base($args,$fmt);
189  $fmt = $self->append_format($fmt,'--'.$args->{'inputbox'}.' {{text}} {{entry}}');
190  my $command = $self->prepare_command
191    ( $args, $fmt,
192      text => $self->make_kvt($args,$args->{'text'}),
193      entry => $self->make_kvl($args,($args->{'init'}||$args->{'entry'})),
194    );
195
196  my ($rv,$text) = $self->command_string($command);
197  $self->_post($args);
198  return($rv == 0 ? $text : 0);
199}
200sub password {
201  my $self = shift();
202  return($self->inputbox('caller',((caller(1))[3]||'main'),@_,'inputbox','password'));
203}
204
205#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
206#: Text box
207sub msgbox {
208  my $self = shift();
209  my $caller = (caller(1))[3] || 'main';
210  $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
211  if ($_[0] && $_[0] eq 'caller') {
212    shift(); $caller = shift();
213  }
214  my $args = $self->_pre($caller,@_);
215
216  $args->{'msgbox'} ||= 'msgbox';
217
218  my $fmt = $self->prepare_format($args);
219  $fmt = $self->append_format_base($args,$fmt);
220  $fmt = $self->append_format($fmt,'--'.$args->{'msgbox'}.' {{text}}');
221  my $command = $self->prepare_command
222    ( $args, $fmt,
223      text => $self->make_kvt($args,$args->{'text'}),
224    );
225
226  my $rv = $self->command_state($command);
227  $self->_post($args);
228  return($rv == 0 ? 1 : 0);
229}
230sub error {
231  my $self = shift();
232  return($self->msgbox('caller',((caller(1))[3]||'main'),@_,'msgbox','error'));
233}
234sub sorry {
235  my $self = shift();
236  return($self->msgbox('caller',((caller(1))[3]||'main'),@_,'msgbox','sorry'));
237}
238sub infobox {
239  my $self = shift();
240  return($self->msgbox('caller',((caller(1))[3]||'main'),@_,'msgbox','msgbox'));
241}
242
243#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
244#: File box
245sub textbox {
246  my $self = shift();
247  my $caller = (caller(1))[3] || 'main';
248  $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
249  if ($_[0] && $_[0] eq 'caller') {
250    shift(); $caller = shift();
251  }
252  my $args = $self->_pre($caller,@_);
253
254  my $fmt = $self->prepare_format($args);
255  $fmt = $self->append_format_base($args,$fmt);
256  $fmt = $self->append_format($fmt,'--textbox');
257  $fmt = $self->append_format($fmt,'{{path}} {{height}} {{width}}');
258  my $command = $self->prepare_command
259    ( $args, $fmt,
260      path => $self->make_kvl($args,($args->{'filename'}||$args->{'path'}||'.')),
261    );
262
263  my ($rv,$text) = $self->command_string($command);
264  $self->_post($args);
265  return($rv == 0 ? 1 : 0);
266}
267
268#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
269#: a simple menu
270sub menu {
271  my $self = shift();
272  my $caller = (caller(1))[3] || 'main';
273  $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
274  if ($_[0] && $_[0] eq 'caller') {
275    shift(); $caller = shift();
276  }
277  my $args = $self->_pre($caller,@_);
278
279  my $fmt = $self->prepare_format($args);
280  $fmt = $self->append_format_base($args,$fmt);
281  $fmt = $self->append_format($fmt,'--separate-output');
282  $fmt = $self->append_format($fmt,'--menu');
283  $fmt = $self->append_format($fmt,'{{text}} {{list}}');
284  my $command = $self->prepare_command
285    ( $args, $fmt,
286      text => $self->make_kvt($args,$args->{'text'}),
287    );
288
289  my ($rv,$selected) = $self->command_string($command);
290  $self->_post($args);
291  return($rv == 0 ? $selected : 0);
292}
293
294#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
295#: a check list
296sub checklist {
297  my $self = shift();
298  my $caller = (caller(1))[3] || 'main';
299  $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
300  if ($_[0] && $_[0] eq 'caller') {
301    shift(); $caller = shift();
302  }
303  my $args = $self->_pre($caller,@_);
304
305  $args->{'listheight'} = $args->{'menuheight'}
306    if exists $args->{'menuheight'};
307
308  my $fmt = $self->prepare_format($args);
309  $fmt = $self->append_format_base($args,$fmt);
310  $args->{radiolist} ||= 0;
311  if ($args->{radiolist}) {
312    $fmt = $self->append_format($fmt,'--radiolist');
313  }
314  else {
315    $fmt = $self->append_format($fmt,'--separate-output');
316    $fmt = $self->append_format($fmt,'--checklist');
317  }
318  $fmt = $self->append_format($fmt,'{{text}} {{list}}');
319  my $command = $self->prepare_command
320    ( $args, $fmt,
321      text => $self->make_kvt($args,$args->{'text'}),
322    );
323
324  if ($args->{radiolist}) {
325    my ($rv,$selected) = $self->command_string($command);
326    return($rv == 0 ? $selected : 0);
327  }
328  my ($rv,$selected) = $self->command_array($command);
329  return($rv == 0 ? @{$selected} : 0);
330}
331#: a radio button list
332sub radiolist {
333  my $self = shift();
334  return($self->checklist('caller',((caller(1))[3]||'main'),@_,'radiolist',1));
335}
336
337
338#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
339#: file select
340sub fselect {
341  my $self = shift();
342  my $caller = (caller(1))[3] || 'main';
343  $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
344  if ($_[0] && $_[0] eq 'caller') {
345    shift(); $caller = shift();
346  }
347  my $args = $self->_pre($caller,@_);
348
349  $args->{'fselect'} ||= 'getopenfilename';
350
351  my $fmt = $self->prepare_format($args);
352  $fmt = $self->append_format_base($args,$fmt);
353  $fmt = $self->append_format($fmt,'--separate-output');
354  $fmt = $self->append_format($fmt,'--'.$args->{'fselect'});
355  if ($args->{'getexistingdirectory'}) {
356    $fmt = $self->append_format($fmt,'{{path}}');
357  } else {
358    $fmt = $self->append_format($fmt,'{{path}} {{filter}}');
359  }
360  my $command = $self->prepare_command
361    ( $args, $fmt,
362      path => $self->make_kvl($args,($args->{'path'}||abs_path())),
363      filter => $self->make_kvl($args,($args->{'filter'}||'*'))
364    );
365
366  my ($rv,$selected) = $self->command_string($command);
367  $self->_post($args);
368  return($rv == 0 ? $selected : 0);
369}
370sub getopenfilename {
371  my $self = shift();
372  return($self->fselect('caller',((caller(1))[3]||'main'),@_,'fselect','getopenfilename'));
373}
374sub getsavefilename {
375  my $self = shift();
376  return($self->fselect('caller',((caller(1))[3]||'main'),@_,'fselect','getsavefilename'));
377}
378sub getopenurl {
379  my $self = shift();
380  return($self->fselect('caller',((caller(1))[3]||'main'),@_,'fselect','getopenurl'));
381}
382sub getsaveurl {
383  my $self = shift();
384  return($self->fselect('caller',((caller(1))[3]||'main'),@_,'fselect','getsaveurl'));
385}
386
387#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
388#: directory select
389sub dselect {
390  my $self = shift();
391  return($self->fselect('caller',((caller(1))[3]||'main'),@_,'fselect','getexistingdirectory'));
392}
393sub getexistingdirectory {
394  my $self = shift();
395  return($self->fselect('caller',((caller(1))[3]||'main'),@_,'fselect','getexistingdirectory'));
396}
397
398
3991;
400