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