1package UI::Dialog::Backend::GDialog;
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 FileHandle;
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'}->{'title'} = $cfg->{'title'} || undef();
69  $self->{'_opts'}->{'backtitle'} = $cfg->{'backtitle'} || undef();
70  $self->{'_opts'}->{'width'} = $cfg->{'width'} || 65;
71  $self->{'_opts'}->{'height'} = $cfg->{'height'} || 10;
72  $self->{'_opts'}->{'percentage'} = $cfg->{'percentage'} || 1;
73  $self->{'_opts'}->{'bin'} ||= $self->_find_bin('gdialog.real') || $self->_find_bin('gdialog') || '/usr/bin/gdialog';
74  $self->{'_opts'}->{'autoclear'} = $cfg->{'autoclear'} || 0;
75  $self->{'_opts'}->{'clearbefore'} = $cfg->{'clearbefore'} || 0;
76  $self->{'_opts'}->{'clearafter'} = $cfg->{'clearafter'} || 0;
77  $self->{'_opts'}->{'beepbin'} = $cfg->{'beepbin'} || $self->_find_bin('beep') || '/usr/bin/beep';
78  $self->{'_opts'}->{'beepbefore'} = $cfg->{'beepbefore'} || 0;
79  $self->{'_opts'}->{'beepafter'} = $cfg->{'beepafter'} || 0;
80  $self->{'_opts'}->{'timeout'} = $cfg->{'timeout'} || 0;
81  $self->{'_opts'}->{'wait'} = $cfg->{'wait'} || 0;
82  unless (-x $self->{'_opts'}->{'bin'}) {
83		croak("the gdialog binary could not be found at: ".$self->{'_opts'}->{'bin'});
84  }
85
86  $self->{'_opts'}->{'trust-input'} = $cfg->{'trust-input'} || 0;
87
88  $self->{'test_mode'} = $cfg->{'test_mode'} if exists $cfg->{'test_mode'};
89  $self->{'test_mode_result'} = '';
90
91  return($self);
92}
93
94#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
95#: Private Methods
96#:
97
98my $SIG_CODE = {};
99sub _del_gauge {
100  my $CODE = $SIG_CODE->{$$};
101  unless (not ref($CODE)) {
102		delete($CODE->{'_GAUGE'});
103		$CODE->rv('1');
104		$CODE->rs('null');
105		$CODE->ra('null');
106		$SIG_CODE->{$$} = "";
107  }
108}
109
110sub append_format_base {
111  my ($self,$args,$fmt) = @_;
112  return $fmt;
113}
114
115
116#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
117#: Public Methods
118#:
119
120#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
121#: Ask a binary question (Yes/No)
122sub yesno {
123  my $self = shift();
124  my $caller = (caller(1))[3] || 'main';
125  $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
126  if ($_[0] && $_[0] eq 'caller') {
127    shift(); $caller = shift();
128  }
129  my $args = $self->_pre($caller,@_);
130
131  my $fmt = $self->prepare_format($args);
132  $fmt = $self->append_format_base($args,$fmt);
133  $fmt = $self->append_format($fmt,'--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}
152
153#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
154#: Text entry
155sub inputbox {
156  my $self = shift();
157  my $caller = (caller(1))[3] || 'main';
158  $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
159  if ($_[0] && $_[0] eq 'caller') {
160    shift(); $caller = shift();
161  }
162  my $args = $self->_pre($caller,@_);
163
164  my $fmt = $self->prepare_format($args);
165  $fmt = $self->append_format_base($args,$fmt);
166  $fmt = $self->append_format($fmt,'--inputbox');
167  $fmt = $self->append_format($fmt,'{{text}} {{height}} {{width}} {{entry}}');
168  my $command = $self->prepare_command
169    ( $args, $fmt,
170      text => $self->make_kvt($args,$args->{'text'}),
171      entry     => $self->make_kvl($args,($args->{'init'}||$args->{'entry'})),
172    );
173
174  my ($rv,$text) = $self->command_string($command);
175  $self->_post($args);
176  return($rv == 0 ? $text : 0);
177}
178#: password boxes aren't supported by gdialog
179sub password {
180  carp("Password entry fields are not supported by GDialog.");
181  return(1); #: Cancel every time.
182}
183
184#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
185#: Text box
186sub msgbox {
187  my $self = shift();
188  my $caller = (caller(1))[3] || 'main';
189  $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
190  if ($_[0] && $_[0] eq 'caller') {
191    shift(); $caller = shift();
192  }
193  my $args = $self->_pre($caller,@_);
194
195  my $fmt = $self->prepare_format($args);
196  $fmt = $self->append_format_base($args,$fmt);
197  $fmt = $self->append_format($fmt,'--scrolltext');
198  if ($args->{'infobox'}) {
199    $fmt = $self->append_format($fmt,'--infobox');
200  }
201  else {
202    $fmt = $self->append_format($fmt,'--msgbox');
203  }
204  $fmt = $self->append_format($fmt,'{{text}} {{height}} {{width}}');
205  my $command = $self->prepare_command
206    ( $args, $fmt,
207      text => $self->make_kvt($args,$args->{'text'}),
208    );
209
210  my $rv = $self->command_state($command);
211  $self->_post($args);
212  return($rv == 0 ? 1 : 0);
213}
214sub infobox {
215  my $self = shift();
216  return($self->msgbox('caller',((caller(1))[3]||'main'),@_,'infobox',1));
217}
218
219#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
220#: File box
221sub textbox {
222  my $self = shift();
223  my $caller = (caller(1))[3] || 'main';
224  $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
225  if ($_[0] && $_[0] eq 'caller') {
226    shift(); $caller = shift();
227  }
228  my $args = $self->_pre($caller,@_);
229
230  my $fmt = $self->prepare_format($args);
231  $fmt = $self->append_format_base($args,$fmt);
232  $fmt = $self->append_format($fmt,'--textbox');
233  $fmt = $self->append_format($fmt,'{{path}} {{height}} {{width}}');
234  my $command = $self->prepare_command
235    ( $args, $fmt,
236      path => $self->make_kvl($args,($args->{'path'}||'.')),
237    );
238
239  my ($rv,$text) = $self->command_string($command);
240  $self->_post($args);
241  return($rv == 0 ? 1 : 0);
242}
243
244#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
245#: a simple menu list
246sub menu {
247  my $self = shift();
248  my $caller = (caller(1))[3] || 'main';
249  $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
250  if ($_[0] && $_[0] eq 'caller') {
251    shift(); $caller = shift();
252  }
253  my $args = $self->_pre($caller,@_);
254
255  $args->{'listheight'} ||= $args->{'menuheight'};
256
257  my $fmt = $self->prepare_format($args);
258  $fmt = $self->append_format_base($args,$fmt);
259  $fmt = $self->append_format($fmt,'--menu');
260  $fmt = $self->append_format($fmt,'{{text}} {{height}} {{width}} {{listheight}} {{list}}');
261  my $command = $self->prepare_command
262    ( $args, $fmt,
263      text => $self->make_kvt($args,$args->{'text'}),
264    );
265
266  my ($rv,$selected) = $self->command_string($command);
267  $self->_post($args);
268  return($rv == 0 ? $selected : 0);
269}
270
271#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
272#: a check list
273sub checklist {
274  my $self = shift();
275  my $caller = (caller(1))[3] || 'main';
276  $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
277  if ($_[0] && $_[0] eq 'caller') {
278    shift(); $caller = shift();
279  }
280  my $args = $self->_pre($caller,@_);
281
282  $args->{'listheight'} = $args->{'menuheight'}
283    if exists $args->{'menuheight'};
284
285  my $fmt = $self->prepare_format($args);
286  $fmt = $self->append_format_base($args,$fmt);
287  $fmt = $self->append_format($fmt,'--separate-output');
288  $args->{radiolist} ||= 0;
289  if ($args->{radiolist}) {
290    $fmt = $self->append_format($fmt,'--radiolist');
291  }
292  else {
293    $fmt = $self->append_format($fmt,'--checklist');
294  }
295  $fmt = $self->append_format($fmt,'{{text}} {{height}} {{width}} {{listheight}} {{list}}');
296  my $command = $self->prepare_command
297    ( $args, $fmt,
298      text => $self->make_kvt($args,$args->{'text'}),
299      listheight => $self->make_kvl($args,$args->{'listheight'})
300    );
301
302  if ($args->{radiolist}) {
303    my ($rv,$selected) = $self->command_string($command);
304    return($rv == 0 ? $selected : 0);
305  }
306  my ($rv,$selected) = $self->command_array($command);
307  return($rv == 0 ? @{$selected} : 0);
308}
309#: a radio button list
310sub radiolist {
311  my $self = shift();
312  return($self->checklist('caller',((caller(1))[3]||'main'),@_,'radiolist',1));
313}
314
3151;
316
317