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