1package UI::Dialog::Backend::Whiptail; 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 Time::HiRes qw( sleep ); 25use UI::Dialog::Backend; 26 27BEGIN { 28 use vars qw( $VERSION @ISA ); 29 @ISA = qw( UI::Dialog::Backend ); 30 $VERSION = '1.21'; 31} 32 33#:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: 34#: Constructor Method 35#: 36 37sub new { 38 my $proto = shift(); 39 my $class = ref($proto) || $proto; 40 my $cfg = ((ref($_[0]) eq "HASH") ? $_[0] : (@_) ? { @_ } : {}); 41 my $self = {}; 42 bless($self, $class); 43 $self->{'_state'} = {}; 44 $self->{'_opts'} = {}; 45 46 #: Dynamic path discovery... 47 my $CFG_PATH = $cfg->{'PATH'}; 48 if ($CFG_PATH) { 49 if (ref($CFG_PATH) eq "ARRAY") { 50 $self->{'PATHS'} = $CFG_PATH; 51 } 52 elsif ($CFG_PATH =~ m!:!) { 53 $self->{'PATHS'} = [ split(/:/,$CFG_PATH) ]; 54 } 55 elsif (-d $CFG_PATH) { 56 $self->{'PATHS'} = [ $CFG_PATH ]; 57 } 58 } 59 elsif ($ENV{'PATH'}) { 60 $self->{'PATHS'} = [ split(/:/,$ENV{'PATH'}) ]; 61 } 62 else { 63 $self->{'PATHS'} = ''; 64 } 65 66 $self->{'_opts'}->{'literal'} = $cfg->{'literal'} || 0; 67 $self->{'_opts'}->{'callbacks'} = $cfg->{'callbacks'} || undef(); 68 $self->{'_opts'}->{'debug'} = $cfg->{'debug'} || undef(); 69 $self->{'_opts'}->{'title'} = $cfg->{'title'} || undef(); 70 $self->{'_opts'}->{'backtitle'} = $cfg->{'backtitle'} || undef(); 71 $self->{'_opts'}->{'width'} = $cfg->{'width'} || 65; 72 $self->{'_opts'}->{'height'} = $cfg->{'height'} || 10; 73 $self->{'_opts'}->{'listheight'} = $cfg->{'listheight'} || $cfg->{'menuheight'} || 10; 74 $self->{'_opts'}->{'percentage'} = $cfg->{'percentage'} || 1; 75 $self->{'_opts'}->{'bin'} ||= $self->_find_bin('whiptail'); 76 $self->{'_opts'}->{'autoclear'} = $cfg->{'autoclear'} || 0; 77 $self->{'_opts'}->{'clearbefore'} = $cfg->{'clearbefore'} || 0; 78 $self->{'_opts'}->{'clearafter'} = $cfg->{'clearafter'} || 0; 79 $self->{'_opts'}->{'beepbin'} = $cfg->{'beepbin'} || $self->_find_bin('beep') || '/usr/bin/beep'; 80 $self->{'_opts'}->{'beepbefore'} = $cfg->{'beepbefore'} || 0; 81 $self->{'_opts'}->{'beepafter'} = $cfg->{'beepafter'} || 0; 82 $self->{'_opts'}->{'timeout'} = $cfg->{'timeout'} || 0; 83 $self->{'_opts'}->{'wait'} = $cfg->{'wait'} || 0; 84 unless (-x $self->{'_opts'}->{'bin'}) { 85 croak("the whiptail binary could not be found at: ".$self->{'_opts'}->{'bin'}); 86 } 87 88 $self->{'_opts'}->{'trust-input'} = $cfg->{'trust-input'} || 0; 89 90 $self->{'test_mode'} = $cfg->{'test_mode'} if exists $cfg->{'test_mode'}; 91 $self->{'test_mode_result'} = ''; 92 93 return($self); 94} 95 96 97#:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: 98#: Private Methods 99#: 100my $SIG_CODE = {}; 101sub _del_gauge { 102 my $CODE = $SIG_CODE->{$$}; 103 unless (not ref($CODE)) { 104 delete($CODE->{'_GAUGE'}); 105 $CODE->rv('1'); 106 $CODE->rs('null'); 107 $CODE->ra('null'); 108 $SIG_CODE->{$$} = ""; 109 } 110} 111 112sub append_format_base { 113 my ($self,$args,$fmt) = @_; 114 $fmt = $self->append_format_check($args,$fmt,'backtitle','--backtitle {{backtitle}}'); 115 $fmt = $self->append_format_check($args,$fmt,"defaultno","--defaultno"); 116 $fmt = $self->append_format_check($args,$fmt,"default-item","--default-item {{default-item}}"); 117 $fmt = $self->append_format_check($args,$fmt,"fullbuttons","--fullbuttons"); 118 $fmt = $self->append_format_check($args,$fmt,"nocancel","--nocancel"); 119 $fmt = $self->append_format_check($args,$fmt,"yes-button","--yes-button {{yes-button}}"); 120 $fmt = $self->append_format_check($args,$fmt,"no-button","--no-button {{no-button}}"); 121 $fmt = $self->append_format_check($args,$fmt,"ok-button","--ok-button {{ok-button}}"); 122 $fmt = $self->append_format_check($args,$fmt,"cancel-button","--cancel-button {{cancel-button}}"); 123 $fmt = $self->append_format_check($args,$fmt,"notags","--notags"); 124 $fmt = $self->append_format_check($args,$fmt,"scrolltext","--scrolltext"); 125 $fmt = $self->append_format_check($args,$fmt,"top-left","--top-left"); 126 if ($self->{'_opts'}->{'force-no-separate-output'}) { 127 delete $args->{'separate-output'}; 128 } else { 129 $fmt = $self->append_format_check($args,$fmt,"separate-output","--separate-output"); 130 } 131 return $fmt; 132} 133 134#:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: 135#: Public Methods 136#: 137 138#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 139#: Ask a binary question (Yes/No) 140sub yesno { 141 my $self = shift(); 142 my $caller = (caller(1))[3] || 'main'; 143 $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller; 144 if ($_[0] && $_[0] eq 'caller') { 145 shift(); $caller = shift(); 146 } 147 my $args = $self->_pre($caller,@_); 148 149 my $fmt = $self->prepare_format($args); 150 $fmt = $self->append_format_base($args,$fmt); 151 $fmt = $self->append_format($fmt,'--yesno {{text}} {{height}} {{width}}'); 152 my $command = $self->prepare_command 153 ( $args, $fmt, 154 text => $self->make_kvt($args,$args->{'text'}), 155 ); 156 157 my $rv = $self->command_state($command); 158 if ($rv && $rv >= 1) { 159 $self->ra("NO"); 160 $self->rs("NO"); 161 $self->rv($rv); 162 } 163 else { 164 $self->ra("YES"); 165 $self->rs("YES"); 166 $self->rv('null'); 167 } 168 $self->_post($args); 169 return($rv == 0 ? 1 : 0); 170} 171 172#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 173#: Text entry 174sub inputbox { 175 my $self = shift(); 176 my $caller = (caller(1))[3] || 'main'; 177 $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller; 178 if ($_[0] && $_[0] eq 'caller') { 179 shift(); $caller = shift(); 180 } 181 my $args = $self->_pre($caller,@_); 182 183 my $fmt = $self->prepare_format($args); 184 $fmt = $self->append_format_base($args,$fmt); 185 if ($args->{'password'}) { 186 $fmt = $self->append_format($fmt,'--passwordbox'); 187 } else { 188 $fmt = $self->append_format($fmt,'--inputbox'); 189 } 190 $fmt = $self->append_format($fmt,'{{text}} {{height}} {{width}} {{entry}}'); 191 my $command = $self->prepare_command 192 ( $args, $fmt, 193 text => $self->make_kvt($args,$args->{'text'}), 194 entry => $self->make_kvl($args,($args->{'init'}||$args->{'entry'})), 195 ); 196 197 my ($rv,$text) = $self->command_string($command); 198 $self->_post($args); 199 return($rv == 0 ? $text : 0); 200} 201#: password boxes aren't supported by gdialog 202sub password { 203 my $self = shift(); 204 return($self->inputbox('caller',((caller(1))[3]||'main'),@_,'password',1)); 205} 206 207#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 208#: Text box 209sub msgbox { 210 my $self = shift(); 211 my $caller = (caller(1))[3] || 'main'; 212 $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller; 213 if ($_[0] && $_[0] eq 'caller') { 214 shift(); $caller = shift(); 215 } 216 my $args = $self->_pre($caller,@_); 217 $args->{'msgbox'} ||= 'msgbox'; 218 219 my $fmt = $self->prepare_format($args); 220 $fmt = $self->append_format_base($args,$fmt); 221 if ($args->{'infobox'}) { 222 $fmt = $self->append_format($fmt,'--infobox'); 223 } 224 else { 225 $fmt = $self->append_format($fmt,'--msgbox'); 226 } 227 $fmt = $self->append_format($fmt,'{{text}} {{height}} {{width}}'); 228 my $command = $self->prepare_command 229 ( $args, $fmt, 230 text => $self->make_kvt($args,$args->{'text'}), 231 ); 232 233 $args->{'timeout'} ||= $args->{'wait'} 234 if exists $args->{'wait'} and $args->{'wait'}; 235 236 my $tmp_term = $ENV{TERM}; 237 $ENV{TERM} = 'vt220' # wow, really folks? 238 if ($args->{'infobox'}); 239 my $rv = $self->command_state($command); 240 if ($args->{'infobox'}) { 241 $ENV{TERM} = $tmp_term; # yep, really. 242 my $sec = 0; 243 if ($args->{'timeout'}) { 244 $sec = int($args->{'timeout'} ? ($args->{'timeout'} / 1000.0) : 1.0); 245 $self->_debug("Will sleep for timeout=".$sec); 246 } elsif ($args->{'wait'}) { 247 $sec = int($args->{'wait'} ? $args->{'wait'} : 1); 248 $self->_debug("Will sleep for wait=".$sec); 249 } 250 sleep($sec) if $sec; 251 } 252 $self->_post($args); 253 return($rv == 0 ? 1 : 0); 254} 255sub infobox { 256 my $self = shift(); 257 return($self->msgbox('caller',((caller(1))[3]||'main'),@_,'infobox',1)); 258} 259 260#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 261#: File box 262sub textbox { 263 my $self = shift(); 264 my $caller = (caller(1))[3] || 'main'; 265 $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller; 266 if ($_[0] && $_[0] eq 'caller') { 267 shift(); $caller = shift(); 268 } 269 my $args = $self->_pre($caller,@_); 270 271 my $fmt = $self->prepare_format($args); 272 $fmt = $self->append_format_base($args,$fmt); 273 $fmt = $self->append_format($fmt,'--textbox'); 274 $fmt = $self->append_format($fmt,'{{path}} {{height}} {{width}}'); 275 my $command = $self->prepare_command 276 ( $args, $fmt, 277 path => $self->make_kvl($args,($args->{'path'}||'.')), 278 ); 279 280 my ($rv,$text) = $self->command_string($command); 281 $self->_post($args); 282 return($rv == 0 ? 1 : 0); 283} 284 285#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 286#: Lists 287sub menu { 288 my $self = shift(); 289 my $caller = (caller(1))[3] || 'main'; 290 $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller; 291 if ($_[0] && $_[0] eq 'caller') { 292 shift(); $caller = shift(); 293 } 294 my $args = $self->_pre($caller,@_); 295 296 $args->{'listheight'} = $args->{'menuheight'} 297 if exists $args->{'menuheight'}; 298 299 my $fmt = $self->prepare_format($args); 300 $fmt = $self->append_format_base($args,$fmt); 301 $fmt = $self->append_format($fmt,'--separate-output'); 302 $fmt = $self->append_format($fmt,'--menu'); 303 $fmt = $self->append_format($fmt,'{{text}} {{height}} {{width}} {{listheight}} {{list}}'); 304 my $command = $self->prepare_command 305 ( $args, $fmt, 306 text => $self->make_kvt($args,$args->{'text'}), 307 ); 308 309 my ($rv,$selected) = $self->command_string($command); 310 $self->_post($args); 311 return($rv == 0 ? $selected : 0); 312} 313 314sub checklist { 315 my $self = shift(); 316 my $caller = (caller(1))[3] || 'main'; 317 $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller; 318 if ($_[0] && $_[0] eq 'caller') { 319 shift(); $caller = shift(); 320 } 321 my $args = $self->_pre($caller,@_); 322 323 $args->{'listheight'} = $args->{'menuheight'} 324 if exists $args->{'menuheight'}; 325 326 my $fmt = $self->prepare_format($args); 327 $fmt = $self->append_format_base($args,$fmt); 328 $fmt = $self->append_format($fmt,'--separate-output'); 329 $args->{radiolist} ||= 0; 330 if ($args->{radiolist}) { 331 $fmt = $self->append_format($fmt,'--radiolist'); 332 } else { 333 $fmt = $self->append_format($fmt,'--checklist'); 334 } 335 $fmt = $self->append_format($fmt,'{{text}} {{height}} {{width}} {{listheight}} {{list}}'); 336 my $command = $self->prepare_command 337 ( $args, $fmt, 338 text => $self->make_kvt($args,$args->{'text'}), 339 ); 340 341 if ($args->{radiolist}) { 342 my ($rv,$selected) = $self->command_string($command); 343 return($rv == 0 ? $selected : 0); 344 } 345 my ($rv,$selected) = $self->command_array($command); 346 return($rv == 0 ? @{$selected} : 0); 347} 348sub radiolist { 349 my $self = shift(); 350 return($self->checklist('caller',((caller(1))[3]||'main'),@_,'radiolist',1)); 351} 352 353#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 354#: progress meter 355sub gauge_start { 356 my $self = shift(); 357 my $caller = (caller(1))[3] || 'main'; 358 $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller; 359 if ($_[0] && $_[0] eq 'caller') { 360 shift(); $caller = shift(); 361 } 362 my $args = $self->_pre($caller,@_); 363 364 $self->{'_GAUGE'} ||= {}; 365 $self->{'_GAUGE'}->{'ARGS'} = $args; 366 367 if (defined $self->{'_GAUGE'}->{'FH'}) { 368 $self->rv(129); 369 $self->_post($args); 370 return(0); 371 } 372 373 my $fmt = $self->prepare_format($args); 374 $fmt = $self->append_format($fmt,'--gauge'); 375 $fmt = $self->append_format($fmt,'{{text}} {{height}} {{width}} {{percentage}}'); 376 my $command = $self->prepare_command 377 ( $args, $fmt, 378 text => $self->make_kvt($args,$args->{'text'}), 379 percentage => $self->make_kvl($args,$args->{'percentage'}||'0'), 380 ); 381 382 $self->{'_GAUGE'}->{'PERCENT'} = ($args->{'percentage'} || '0'); 383 $self->{'_GAUGE'}->{'FH'} = new FileHandle; 384 $self->{'_GAUGE'}->{'FH'}->open("| $command"); 385 my $rv = $? >> 8; 386 $self->{'_GAUGE'}->{'FH'}->autoflush(1); 387 $self->rv($rv||'null'); 388 $self->ra('null'); 389 $self->rs('null'); 390 my $this_rv; 391 if ($rv && $rv >= 1) { 392 $this_rv = 0; 393 } 394 else { 395 $this_rv = 1; 396 } 397 return($this_rv); 398} 399sub gauge_inc { 400 my $self = $_[0]; 401 my $incr = $_[1] || 1; 402 403 return(0) unless defined $self->{'_GAUGE'}->{'FH'}; 404 405 my $fh = $self->{'_GAUGE'}->{'FH'}; 406 $self->{'_GAUGE'}->{'PERCENT'} += $incr; 407 $SIG_CODE->{$$} = $self; local $SIG{'PIPE'} = \&_del_gauge; 408 print $fh $self->{'_GAUGE'}->{'PERCENT'}."\n"; 409 return(((defined $self->{'_GAUGE'}->{'FH'}) ? 1 : 0)); 410} 411sub gauge_dec { 412 my $self = $_[0]; 413 my $decr = $_[1] || 1; 414 415 return(0) unless defined $self->{'_GAUGE'}->{'FH'}; 416 417 my $fh = $self->{'_GAUGE'}->{'FH'}; 418 $self->{'_GAUGE'}->{'PERCENT'} -= $decr; 419 $SIG_CODE->{$$} = $self; local $SIG{'PIPE'} = \&_del_gauge; 420 print $fh $self->{'_GAUGE'}->{'PERCENT'}."\n"; 421 return(((defined $self->{'_GAUGE'}->{'FH'}) ? 1 : 0)); 422} 423sub gauge_set { 424 my $self = $_[0]; 425 my $perc = $_[1] || $self->{'_GAUGE'}->{'PERCENT'} || 1; 426 427 my $fh = $self->{'_GAUGE'}->{'FH'}; 428 return(0) unless $self->{'_GAUGE'}->{'FH'}; 429 430 $self->{'_GAUGE'}->{'PERCENT'} = $perc; 431 $SIG_CODE->{$$} = $self; local $SIG{'PIPE'} = \&_del_gauge; 432 print $fh $self->{'_GAUGE'}->{'PERCENT'}."\n"; 433 return(((defined $self->{'_GAUGE'}->{'FH'}) ? 1 : 0)); 434} 435sub gauge_text { 436 my $self = $_[0]; 437 my $mesg = $_[1] || return(0); 438 439 my $fh = $self->{'_GAUGE'}->{'FH'}; 440 return(0) unless $self->{'_GAUGE'}->{'FH'}; 441 442 $SIG_CODE->{$$} = $self; local $SIG{'PIPE'} = \&_del_gauge; 443 print $fh "\nXXX\n\n".$mesg."\n\nXXX\n\n".$self->{'_GAUGE'}->{'PERCENT'}."\n"; 444 return(((defined $self->{'_GAUGE'}->{'FH'}) ? 1 : 0)); 445} 446sub gauge_stop { 447 my $self = $_[0]; 448 449 return(0) unless $self->{'_GAUGE'}->{'FH'}; 450 451 my $args = $self->{'_GAUGE'}->{'ARGS'}; 452 my $fh = $self->{'_GAUGE'}->{'FH'}; 453 $SIG_CODE->{$$} = $self; local $SIG{'PIPE'} = \&_del_gauge; 454 $self->{'_GAUGE'}->{'FH'}->close(); 455 delete($self->{'_GAUGE'}->{'FH'}); 456 delete($self->{'_GAUGE'}->{'ARGS'}); 457 delete($self->{'_GAUGE'}->{'PERCENT'}); 458 delete($self->{'_GAUGE'}); 459 $self->rv('null'); 460 $self->rs('null'); 461 $self->ra('null'); 462 $self->_post($args); 463 return(1); 464} 465 466 4671; 468