1package UI::Dialog::Backend::ASCII; 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 UI::Dialog::Backend; 24use Time::HiRes qw( sleep ); 25 26BEGIN { 27 use vars qw( $VERSION @ISA ); 28 @ISA = qw( UI::Dialog::Backend ); 29 $VERSION = '1.21'; 30} 31 32$| = 1; # turn on autoflush 33 34#:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: 35#: Constructor Method 36#: 37 38sub new { 39 my $proto = shift(); 40 my $class = ref($proto) || $proto; 41 my $cfg = ((ref($_[0]) eq "HASH") ? $_[0] : (@_) ? { @_ } : {}); 42 my $self = {}; 43 bless($self, $class); 44 $self->{'_state'} = {}; 45 $self->{'_opts'} = {}; 46 47 #: Dynamic path discovery... 48 my $CFG_PATH = $cfg->{'PATH'}; 49 if ($CFG_PATH) { 50 if (ref($CFG_PATH) eq "ARRAY") { 51 $self->{'PATHS'} = $CFG_PATH; 52 } 53 elsif ($CFG_PATH =~ m!:!) { 54 $self->{'PATHS'} = [ split(/:/,$CFG_PATH) ]; 55 } 56 elsif (-d $CFG_PATH) { 57 $self->{'PATHS'} = [ $CFG_PATH ]; 58 } 59 } 60 elsif ($ENV{'PATH'}) { 61 $self->{'PATHS'} = [ split(/:/,$ENV{'PATH'}) ]; 62 } 63 else { 64 $self->{'PATHS'} = ''; 65 } 66 67 $self->{'_opts'}->{'callbacks'} = $cfg->{'callbacks'} || undef(); 68 $self->{'_opts'}->{'timeout'} = $cfg->{'timeout'} || 0; 69 $self->{'_opts'}->{'wait'} = $cfg->{'wait'} || 0; 70 $self->{'_opts'}->{'debug'} = $cfg->{'debug'} || undef(); 71 $self->{'_opts'}->{'title'} = $cfg->{'title'} || undef(); 72 $self->{'_opts'}->{'backtitle'} = $cfg->{'backtitle'} || undef(); 73 $self->{'_opts'}->{'usestderr'} = $cfg->{'usestderr'} || 0; 74 $self->{'_opts'}->{'extra-button'} = $cfg->{'extra-button'} || 0; 75 $self->{'_opts'}->{'extra-label'} = $cfg->{'extra-label'} || undef(); 76 $self->{'_opts'}->{'help-button'} = $cfg->{'help-button'} || 0; 77 $self->{'_opts'}->{'help-label'} = $cfg->{'help-label'} || undef(); 78 $self->{'_opts'}->{'nocancel'} = $cfg->{'nocancel'} || 0; 79 $self->{'_opts'}->{'maxinput'} = $cfg->{'maxinput'} || 0; 80 $self->{'_opts'}->{'defaultno'} = $cfg->{'defaultno'} || 0; 81 $self->{'_opts'}->{'autoclear'} = $cfg->{'autoclear'} || 0; 82 $self->{'_opts'}->{'clearbefore'} = $cfg->{'clearbefore'} || 0; 83 $self->{'_opts'}->{'clearafter'} = $cfg->{'clearafter'} || 0; 84 $self->{'_opts'}->{'beepbin'} = $cfg->{'beepbin'} || $self->_find_bin('beep') || '/usr/bin/beep'; 85 $self->{'_opts'}->{'beepbefore'} = $cfg->{'beepbefore'} || 0; 86 $self->{'_opts'}->{'beepafter'} = $cfg->{'beepafter'} || 0; 87 $self->{'_opts'}->{'pager'} = ( $cfg->{'pager'} || 88 $self->_find_bin('pager') || 89 $self->_find_bin('less') || 90 $self->_find_bin('more') ); 91 $self->{'_opts'}->{'stty'} = $cfg->{'stty'} || $self->_find_bin('stty'); 92 93 $self->{'_opts'}->{'trust-input'} = 94 ( exists $cfg->{'trust-input'} 95 && $cfg->{'trust-input'}==1 96 ) ? 1 : 0; 97 98 $self->{'_state'} = {'rv'=>0}; 99 100 return($self); 101} 102 103#:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: 104#: Iherited Overrides 105#: 106 107sub _organize_text { 108 my $self = shift(); 109 my $text = shift() || return(); 110 my @array; 111 if (ref($text) eq "ARRAY") { 112 push(@array,@{$text}); 113 } 114 elsif ($text =~ /\\n/) { 115 @array = split(/\\n/,$text); 116 } 117 else { 118 @array = split(/\n/,$text); 119 } 120 $text = undef(); 121 $text = join("\n",@array); 122 return($self->_strip_text($text)); 123} 124sub _merge_attrs { 125 my $self = shift(); 126 my $args = (@_ % 2) ? { @_, '_odd' } : { @_ }; 127 my $defs = $self->{'_opts'}; 128 foreach my $def (keys(%$defs)) { 129 $args->{$def} = $defs->{$def} unless $args->{$def}; 130 } 131 # alias 'filename' and 'file' to path 132 $args->{'path'} = (($args->{'filename'}) ? $args->{'filename'} : 133 ($args->{'file'}) ? $args->{'file'} : 134 ($args->{'path'}) ? $args->{'path'} : ""); 135 $args->{'clear'} = $args->{'clearbefore'} || $args->{'clearafter'} || $args->{'autoclear'} || 0; 136 $args->{'beep'} = $args->{'beepbefore'} || $args->{'beepafter'} || $args->{'autobeep'} || 0; 137 return($args); 138} 139 140#:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: 141#: Private Methods 142#: 143 144#: this is the dynamic 'Colon Command Help' 145sub _WRITE_HELP_TEXT { 146 my $self = shift(); 147 my ($head,$foot); 148 my $body = " 149Colon Commands: [':?' (This help message)], [':pg <N>' (Go to page 'N')], 150 [':n'|':next' (Go to the next page)], [':p'|':prev' (Go to the previous page)], 151 [':esc'|':escape' (Send the [Esc] signal)]. 152"; 153 # $head .= ("~" x 79); 154 if ($self->{'_opts'}->{'extra-button'} || $self->{'_opts'}->{'extra-label'}) { 155 $foot .= "[':e'|':extra' (Send the [Extra] signal)]\n"; 156 } 157 if (!$self->{'_opts'}->{'nocancel'}) { 158 $foot .= "[':c'|':cancel' (Send the [Cancel] signal)]\n"; 159 } 160 if ($self->{'_opts'}->{'help-button'} || $self->{'_opts'}->{'help-label'}) { 161 $foot .= "[':h'|':help' (Send the [Help] signal)]\n"; 162 } 163 # $foot .= ("~" x 79)."\n"; 164 # $self->msgbox(title=>'Colon Command Help',text=>$head.$body.$foot); 165 $self->msgbox(title=>'Colon Command Help',text=>$body.$foot); 166} 167 168#: this returns the labels (or ' ') for the "extra", "help" and 169#: "cancel" buttons. 170sub _BUTTONS { 171 my $self = shift(); 172 my $cfg = $self->_merge_attrs(@_); 173 my ($help,$cancel,$extra) = (' ',' ',' '); 174 $extra = "Extra" if $cfg->{'extra-button'}; 175 $extra = $cfg->{'extra-label'} if $cfg->{'extra-label'}; 176 $extra = "':e'=[".$extra."]" if $extra and $extra ne ' '; 177 $help = "Help" if $cfg->{'help-button'}; 178 $help = $self->{'help-label'} if $cfg->{'help-label'}; 179 $help = "':h'=[".$help."]" if $help and $help ne ' '; 180 $cancel = "Cancel" unless $cfg->{'nocancel'}; 181 $cancel = $cfg->{'cancellabel'} if $cfg->{'cancellabel'}; 182 $cancel = "':c'=[".$cancel."]" if $cancel and $cancel ne ' '; 183 return($help,$cancel,$extra); 184} 185 186 187#: this writes a standard ascii interface to STDOUT. This is intended for use 188#: with any non-list native ascii mode widgets. 189sub _WRITE_TEXT { 190 my $self = shift(); 191 my $cfg = $self->_merge_attrs(@_); 192 my $text = ""; 193 if ($cfg->{'literal'}) { 194 $text = $cfg->{'text'} || ''; 195 } 196 else { 197 $text = $self->_organize_text($cfg->{'text'}) || ""; 198 } 199 $self->clean_format($cfg->{'trust-input'},\$text); 200 my $backtitle = $cfg->{'backtitle'} || " "; 201 my $title = $cfg->{'title'} || " "; 202 format ASCIIPGTXT = 203+-----------------------------------------------------------------------------+ 204| @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | 205$backtitle 206+-----------------------------------------------------------------------------+ 207| | 208| +-------------------------------------------------------------------------+ | 209| | @|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| | | 210$title 211| +-------------------------------------------------------------------------+ | 212| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | | 213$text 214| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | | 215$text 216| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | | 217$text 218| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | | 219$text 220| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | | 221$text 222| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | | 223$text 224| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | | 225$text 226| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | | 227$text 228| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | | 229$text 230| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | | 231$text 232| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | | 233$text 234| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | | 235$text 236| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | | 237$text 238| +-------------------------------------------------------------------------+ | 239| | 240+-----------------------------------------------------------------------------+ 241. 242 no strict 'subs'; 243 my $_fh = select(); 244 select(STDERR) unless not $cfg->{'usestderr'}; 245 my $LFMT = $~; 246 $~ = ASCIIPGTXT; 247 write(); 248 $~= $LFMT; 249 select($_fh) unless not $cfg->{'usestderr'}; 250 use strict 'subs'; 251} 252 253#: very much like _WRITE_TEXT() except that this is specifically for 254#: the menu() widget only. 255sub _WRITE_MENU { 256 my $self = shift(); 257 my $cfg = $self->_merge_attrs(@_); 258 my $text = ""; 259 if ($cfg->{'literal'}) { 260 $text = $cfg->{'text'} || ''; 261 } 262 else { 263 $text = $self->_organize_text($cfg->{'text'}) || ""; 264 } 265 $self->clean_format($cfg->{'trust-input'},\$text); 266 my $backtitle = $cfg->{'backtitle'} || " "; 267 my $title = $cfg->{'title'} || " "; 268 my $menu = $cfg->{'menu'} || []; 269 my ($help,$cancel,$extra) = $self->_BUTTONS(@_); 270 for (my $i=0;$i<@{$menu};$i++) { 271 $self->clean_format($cfg->{'trust-input'},\$menu->[$i]); 272 } 273 format ASCIIPGMNU = 274+-----------------------------------------------------------------------------+ 275| @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | 276$backtitle 277+-----------------------------------------------------------------------------+ 278| | 279| +-------------------------------------------------------------------------+ | 280| | @|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| | | 281$title 282| +-------------------------------------------------------------------------+ | 283| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | | 284$text 285| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | | 286$text 287| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | | 288$text 289| +-------------------------------------------------------------------------+ | 290| @<<<< @<<<<<<<<<<<<<<< @<<<< @<<<<<<<<<<<<<<< @<<<< @<<<<<<<<<<<<<< | 291($menu->[0]||' '),($menu->[1]||' '),($menu->[2]||' '),($menu->[3]||' '),($menu->[4]||' '),($menu->[5]||' ') 292| @<<<< @<<<<<<<<<<<<<<< @<<<< @<<<<<<<<<<<<<<< @<<<< @<<<<<<<<<<<<<< | 293($menu->[6]||' '),($menu->[7]||' '),($menu->[8]||' '),($menu->[9]||' '),($menu->[10]||' '),($menu->[11]||' ') 294| @<<<< @<<<<<<<<<<<<<<< @<<<< @<<<<<<<<<<<<<<< @<<<< @<<<<<<<<<<<<<< | 295($menu->[12]||' '),($menu->[13]||' '),($menu->[14]||' '),($menu->[15]||' '),($menu->[16]||' '),($menu->[17]||' ') 296| @<<<< @<<<<<<<<<<<<<<< @<<<< @<<<<<<<<<<<<<<< @<<<< @<<<<<<<<<<<<<< | 297($menu->[18]||' '),($menu->[19]||' '),($menu->[20]||' '),($menu->[21]||' '),($menu->[22]||' '),($menu->[23]||' ') 298| @<<<< @<<<<<<<<<<<<<<< @<<<< @<<<<<<<<<<<<<<< @<<<< @<<<<<<<<<<<<<< | 299($menu->[24]||' '),($menu->[25]||' '),($menu->[26]||' '),($menu->[27]||' '),($menu->[28]||' '),($menu->[29]||' ') 300| @<<<< @<<<<<<<<<<<<<<< @<<<< @<<<<<<<<<<<<<<< @<<<< @<<<<<<<<<<<<<< | 301($menu->[30]||' '),($menu->[31]||' '),($menu->[32]||' '),($menu->[33]||' '),($menu->[34]||' '),($menu->[35]||' ') 302| @<<<< @<<<<<<<<<<<<<<< @<<<< @<<<<<<<<<<<<<<< @<<<< @<<<<<<<<<<<<<< | 303($menu->[36]||' '),($menu->[37]||' '),($menu->[38]||' '),($menu->[39]||' '),($menu->[42]||' '),($menu->[43]||' ') 304| @<<<< @<<<<<<<<<<<<<<< @<<<< @<<<<<<<<<<<<<<< @<<<< @<<<<<<<<<<<<<< | 305($menu->[42]||' '),($menu->[43]||' '),($menu->[44]||' '),($menu->[45]||' '),($menu->[46]||' '),($menu->[47]||' ') 306| @<<<< @<<<<<<<<<<<<<<< @<<<< @<<<<<<<<<<<<<<< @<<<< @<<<<<<<<<<<<<< | 307($menu->[48]||' '),($menu->[49]||' '),($menu->[50]||' '),($menu->[51]||' '),($menu->[52]||' '),($menu->[53]||' ') 308| @|||||||||||||||||||| @||||||||||||||||||| @||||||||||||||||||| | 309$extra,$cancel,$help 310| ':?' = [Colon Command Help] | 311+-----------------------------------------------------------------------------+ 312. 313 no strict 'subs'; 314 my $_fh = select(); 315 select(STDERR) unless not $cfg->{'usestderr'}; 316 my $LFMT = $~; 317 $~ = ASCIIPGMNU; 318 write(); 319 $~= $LFMT; 320 select($_fh) unless not $cfg->{'usestderr'}; 321 use strict 'subs'; 322} 323 324#: very much like _WRITE_MENU() except that this is specifically for 325#: the radiolist() and checklist() widgets only. 326sub _WRITE_LIST { 327 my $self = shift(); 328 my $cfg = $self->_merge_attrs(@_); 329 my $text = ""; 330 if ($cfg->{'literal'}) { 331 $text = $cfg->{'text'} || ''; 332 } 333 else { 334 $text = $self->_organize_text($cfg->{'text'}) || ""; 335 } 336 $self->clean_format($cfg->{'trust-input'},\$text); 337 338 my $backtitle = $cfg->{'backtitle'} || " "; 339 my $title = $cfg->{'title'} || " "; 340 my $menu = []; 341 push(@{$menu},@{$cfg->{'menu'}}); 342 my ($help,$cancel,$extra) = $self->_BUTTONS(@_); 343 my $m = @{$menu}; 344 345 if ($cfg->{'wm'}) { 346 for (my $i = 2; $i < $m; $i += 3) { 347 if ($menu->[$i] && $menu->[$i] =~ /on/i) { 348 $menu->[$i] = '->'; 349 } 350 else { 351 $menu->[$i] = ' '; 352 } 353 } 354 } 355 else { 356 my $mark; 357 for (my $i = 2; $i < $m; $i += 3) { 358 if (!$mark && $menu->[$i] && $menu->[$i] =~ /on/i) { 359 $menu->[$i] = '->'; $mark = 1; 360 } 361 else { 362 $menu->[$i] = ' '; 363 } 364 } 365 } 366 367 format ASCIIPGLST = 368+-----------------------------------------------------------------------------+ 369| @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | 370$backtitle 371+-----------------------------------------------------------------------------+ 372| | 373| +-------------------------------------------------------------------------+ | 374| | @|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| | | 375$title 376| +-------------------------------------------------------------------------+ | 377| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | | 378$text 379| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | | 380$text 381| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | | 382$text 383| +-------------------------------------------------------------------------+ | 384|@<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<< | 385($menu->[2]||' '),($menu->[0]||' '),($menu->[1]||' '), ($menu->[5]||' '),($menu->[3]||' '),($menu->[4]||' '), ($menu->[8]||' '),($menu->[6]||' '),($menu->[7]||' ') 386|@<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<< | 387($menu->[11]||' '),($menu->[9]||' '),($menu->[10]||' '), ($menu->[14]||' '),($menu->[12]||' '),($menu->[13]||' '), ($menu->[17]||' '),($menu->[15]||' '),($menu->[16]||' ') 388|@<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<< | 389($menu->[20]||' '),($menu->[18]||' '),($menu->[19]||' '), ($menu->[23]||' '),($menu->[21]||' '),($menu->[22]||' '), ($menu->[26]||' '),($menu->[24]||' '),($menu->[25]||' ') 390|@<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<< | 391($menu->[29]||' '),($menu->[27]||' '),($menu->[28]||' '), ($menu->[32]||' '),($menu->[30]||' '),($menu->[31]||' '), ($menu->[35]||' '),($menu->[33]||' '),($menu->[34]||' ') 392|@<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<< | 393($menu->[38]||' '),($menu->[36]||' '),($menu->[37]||' '), ($menu->[41]||' '),($menu->[39]||' '),($menu->[40]||' '), ($menu->[44]||' '),($menu->[42]||' '),($menu->[43]||' ') 394|@<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<< | 395($menu->[47]||' '),($menu->[45]||' '),($menu->[46]||' '), ($menu->[50]||' '),($menu->[48]||' '),($menu->[49]||' '), ($menu->[53]||' '),($menu->[51]||' '),($menu->[52]||' ') 396|@<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<< | 397($menu->[56]||' '),($menu->[54]||' '),($menu->[55]||' '), ($menu->[59]||' '),($menu->[57]||' '),($menu->[58]||' '), ($menu->[62]||' '),($menu->[60]||' '),($menu->[61]||' ') 398|@<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<< | 399($menu->[65]||' '),($menu->[63]||' '),($menu->[64]||' '), ($menu->[68]||' '),($menu->[66]||' '),($menu->[67]||' '), ($menu->[71]||' '),($menu->[69]||' '),($menu->[70]||' ') 400|@<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<< | 401($menu->[74]||' '),($menu->[72]||' '),($menu->[73]||' '), ($menu->[77]||' '),($menu->[75]||' '),($menu->[76]||' '), ($menu->[80]||' '),($menu->[78]||' '),($menu->[79]||' ') 402|@<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<< | 403($menu->[83]||' '),($menu->[81]||' '),($menu->[82]||' '), ($menu->[86]||' '),($menu->[84]||' '),($menu->[85]||' '), ($menu->[89]||' '),($menu->[87]||' '),($menu->[88]||' ') 404| @|||||||||||||||||||| @||||||||||||||||||| @||||||||||||||||||| | 405$extra,$cancel,$help 406| ':?' = [Colon Command Help] | 407+-----------------------------------------------------------------------------+ 408. 409 no strict 'subs'; 410 my $_fh = select(); 411 select(STDERR) unless not $cfg->{'usestderr'}; 412 my $LFMT = $~; 413 $~ = ASCIIPGLST; 414 write(); 415 $~= $LFMT; 416 select($_fh) unless not $cfg->{'usestderr'}; 417 use strict 'subs'; 418} 419 420sub _PRINT { 421 my $self = shift(); 422 my $stderr = shift(); 423 if ($stderr) { 424 print STDERR @_; 425 } 426 else { 427 print STDOUT @_; 428 } 429} 430 431#:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: 432#: Public Methods 433#: 434 435#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 436#: Ask a binary question (Yes/No) 437sub yesno { 438 my $self = shift(); 439 my $caller = (caller(1))[3] || 'main'; 440 $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller; 441 if ($_[0] && $_[0] eq 'caller') { 442 shift(); $caller = shift(); 443 } 444 my $args = $self->_pre($caller,@_); 445 my ($YN,$RESP) = ('Yes|no','YES_OR_NO'); 446 $YN = "yes|No" if $self->{'defaultno'}; 447 while ($RESP !~ /^(y|yes|n|no)$/i) { 448 $self->_clear($args->{'clear'}); 449 $self->_WRITE_TEXT(@_,text=>$args->{'text'}); 450 $self->_PRINT($args->{'usestderr'},"(".$YN."): "); 451 chomp($RESP = <STDIN>); 452 if (!$RESP && $args->{'defaultno'}) { 453 $RESP = "no"; 454 } 455 elsif (!$RESP && !$args->{'defaultno'}) { 456 $RESP = "yes"; 457 } 458 if ($RESP =~ /^(y|yes)$/i) { 459 $self->ra("YES"); 460 $self->rs("YES"); 461 $self->rv('null'); 462 } 463 else { 464 $self->ra("NO"); 465 $self->rs("NO"); 466 $self->rv(1); 467 } 468 } 469 $self->_post($args); 470 return(1) if $self->state() eq "OK"; 471 return(0); 472} 473 474#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 475#: Text entry 476sub inputbox { 477 my $self = shift(); 478 my $caller = (caller(1))[3] || 'main'; 479 $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller; 480 if ($_[0] && $_[0] eq 'caller') { 481 shift(); $caller = shift(); 482 } 483 my $args = $self->_pre($caller,@_); 484 my $length = $args->{'maxinput'} + 1; 485 my $text = $args->{'text'}; 486 my $string; 487 chomp($text); 488 while ($length > $args->{'maxinput'}) { 489 $self->_clear($args->{'clear'}); 490 $self->_WRITE_TEXT(@_,'text'=>$args->{'text'}); 491 $self->_PRINT($args->{'usestderr'},"input: "); 492 chomp($string = <STDIN>); 493 if ($args->{'maxinput'}) { 494 $length = length($string); 495 } 496 else { 497 $length = 0; 498 } 499 if ($length > $args->{'maxinput'}) { 500 $self->_PRINT($args->{'usestderr'},"error: too many charaters input,". 501 " the maximum is: ".$args->{'maxinput'}."\n"); 502 } 503 } 504 $self->rv('null'); 505 $self->ra($string); 506 $self->rs($string); 507 $self->_post($args); 508 return($string); 509} 510 511#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 512#: Password entry 513sub password { 514 my $self = shift(); 515 my $caller = (caller(1))[3] || 'main'; 516 $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller; 517 if ($_[0] && $_[0] eq 'caller') { 518 shift(); $caller = shift(); 519 } 520 my $args = $self->_pre($caller,@_); 521 croak("The UI::Dialog::Backend::ASCII password widget depends on the stty ". 522 "binary. This was not found or is not executable.") 523 unless -x $args->{'stty'}; 524 my ($length,$key) = ($args->{'maxinput'} + 1,''); 525 my $string; 526 my $text = $args->{'text'}; 527 chomp($text); 528 my $ENV_PATH = $ENV{'PATH'}; 529 $ENV{'PATH'} = ""; 530 while ($length > $args->{'maxinput'}) { 531 $self->_clear($args->{'clear'}); 532 $self->_WRITE_TEXT(@_,'text'=>$args->{'text'}); 533 $self->_PRINT($args->{'usestderr'},"input: "); 534 if ($self->_is_bsd()) { 535 system "$args->{'stty'} cbreak </dev/tty >/dev/tty 2>&1"; 536 } 537 else { 538 system $args->{'stty'}, '-icanon', 'eol', "\001"; 539 } 540 while ($key = getc(STDIN)) { 541 last if $key =~ /\n/; 542 if ($key =~ /^\x1b$/) { 543 #this could be the DELETE key (not BS or ^H) 544 # ^[[3~ or \x1b\x5b\x33\x7e (aka: ESC + [ + 3 + ~) 545 my $key2 = getc(STDIN); 546 if ($key2 =~ /^\x5b$/) { 547 my $key3 = getc(STDIN); 548 if ($key3 =~ /^\x33$/) { 549 my $key4 = getc(STDIN); 550 if ($key4 =~ /^\x7e$/) { 551 chop($string); 552 # go back five spaces and print five spaces (erase ^[[3~) 553 # go back five spaces again (backtrack), 554 # go back one space, print a space and go back (erase *) 555 if ($args->{'usestderr'}) { 556 print STDERR "\b\b\b\b\b"." "."\b\b\b\b\b"."\b \b"; 557 } 558 else { 559 print STDOUT "\b\b\b\b\b"." "."\b\b\b\b\b"."\b \b"; 560 } 561 } 562 else { 563 $key = $key.$key2.$key3.$key4; 564 } 565 } 566 else { 567 $key = $key.$key2.$key3; 568 } 569 } 570 else { 571 $key = $key.$key2; 572 } 573 } 574 elsif ($key =~ /^(?:\x08|\x7f)$/) { 575 # this is either a BS or ^H 576 chop($string); 577 # go back two spaces and print two spaces (erase ^H) 578 # go back two spaces again (backtrack), 579 # go back one space, print a space and go back (erase *) 580 if ($args->{'usestderr'}) { 581 print STDERR "\b\b"." "."\b\b"."\b \b"; 582 } 583 else { 584 print STDOUT "\b\b"." "."\b\b"."\b \b"; 585 } 586 } 587 else { 588 if ($args->{'usestderr'}) { 589 print STDERR "\b*"; 590 } 591 else { 592 print STDOUT "\b*"; 593 } 594 $string .= $key; 595 } 596 } 597 if ($self->_is_bsd()) { 598 system "$args->{'stty'} -cbreak </dev/tty >/dev/tty 2>&1"; 599 } 600 else { 601 system $args->{'stty'}, 'icanon', 'eol', '^@'; 602 } 603 if ($args->{'maxinput'}) { 604 $length = length($string); 605 } 606 else { 607 $length = 0; 608 } 609 if ($length > $args->{'maxinput'}) { 610 $self->_PRINT($args->{'usestderr'},"error: too many charaters input,". 611 " the maximum is: ".$args->{'maxinput'}."\n"); 612 } 613 } 614 $ENV{'PATH'} = $ENV_PATH; 615 $self->rv('null'); 616 $self->ra($string); 617 $self->rs($string); 618 $self->_post($args); 619 return($string); 620} 621 622#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 623#: Information box 624sub infobox { 625 my $self = shift(); 626 my $caller = (caller(1))[3] || 'main'; 627 $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller; 628 if ($_[0] && $_[0] eq 'caller') { 629 shift(); $caller = shift(); 630 } 631 my $args = $self->_pre($caller,@_); 632 $self->_WRITE_TEXT(@_,'text'=>$args->{'text'}); 633 $self->_PRINT($args->{'usestderr'}); 634 my $s = int(($args->{'wait'}) ? $args->{'wait'} : 635 ($args->{'timeout'}) ? ($args->{'timeout'} / 1000.0) : 1.0); 636 sleep($s); 637 $self->rv('null'); 638 $self->ra('null'); 639 $self->rs('null'); 640 $self->_post($args); 641 return(1); 642} 643 644#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 645#: Message box 646sub msgbox { 647 my $self = shift(); 648 my $caller = (caller(1))[3] || 'main'; 649 $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller; 650 if ($_[0] && $_[0] eq 'caller') { 651 shift(); $caller = shift(); 652 } 653 my $args = $self->_pre($caller,@_); 654 $self->_WRITE_TEXT(@_,'text'=>$args->{'text'}); 655 $self->_PRINT($args->{'usestderr'},(" " x 25)."[ Press Enter to Continue ]"); 656 my $junk = <STDIN>; 657 $self->rv('null'); 658 $self->ra('null'); 659 $self->rs('null'); 660 $self->_post($args); 661 return(1); 662} 663 664 665#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 666#: Text box 667sub textbox { 668 my $self = shift(); 669 my $caller = (caller(1))[3] || 'main'; 670 $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller; 671 if ($_[0] && $_[0] eq 'caller') { 672 shift(); $caller = shift(); 673 } 674 my $args = $self->_pre($caller,@_); 675 my $rv = 0; 676 if (-r $args->{'path'}) { 677 my $ENV_PATH = $ENV{'PATH'}; 678 $ENV{'PATH'} = ""; 679 if ($ENV{'PAGER'} && -x $ENV{'PAGER'}) { 680 system($ENV{'PAGER'}." ".$args->{'path'}); 681 $rv = $? >> 8; 682 } 683 elsif (-x $args->{'pager'}) { 684 system($args->{'pager'}." ".$args->{'path'}); 685 $rv = $? >> 8; 686 } 687 else { 688 open(ATBFILE,"<".$args->{'path'}); 689 local $/; 690 my $data = <ATBFILE>; 691 close(ATBFILE); 692 $self->_PRINT($args->{'usestderr'},$data); 693 } 694 $ENV{'PATH'} = $ENV_PATH; 695 } 696 else { 697 return($self->msgbox('title'=>'error','text'=>$args->{'path'}.' is not a readable text file.')); 698 } 699 $self->rv($rv||'null'); 700 $self->ra('null'); 701 $self->rs('null'); 702 $self->_post($args); 703 return($rv); 704} 705 706#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 707#: A simple menu 708sub menu { 709 my $self = shift(); 710 my $caller = (caller(1))[3] || 'main'; 711 $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller; 712 if ($_[0] && $_[0] eq 'caller') { 713 shift(); $caller = shift(); 714 } 715 my $args = $self->_pre($caller,@_); 716 $args->{'menu'} ||= ref($args->{'list'}) ? $args->{'list'} : [$args->{'list'}]; 717 $args->{'menu'} ||= []; 718 my $string; 719 my $rs = ''; 720 my $m = 0; 721 $m = @{$args->{'menu'}}; 722 my ($valid,$menu,$realm) = ([],[],[]); 723 push(@{$menu},@{$args->{'menu'}}) if ref($args->{'menu'}) eq "ARRAY"; 724 725 for (my $i = 0; $i < $m; $i += 2) { 726 push(@{$valid},$menu->[$i]); 727 } 728 729 if (@{$menu} >= 60) { 730 my $c = 0; 731 while (@{$menu}) { 732 $realm->[$c] = []; 733 for (my $i = 0; $i < 60; $i++) { 734 push(@{$realm->[$c]},shift(@{$menu})); 735 } 736 $c++; 737 } 738 } 739 else { 740 $realm->[0] = []; 741 push(@{$realm->[0]},@{$menu}); 742 } 743 my $pg = 1; 744 while (!$rs) { 745 $self->_WRITE_MENU(@_,'text'=>$args->{'text'}, 746 'menu'=>$realm->[($pg - 1||0)]); 747 $self->_PRINT($args->{'usestderr'},"(".$pg."/".@{$realm}."): "); 748 chomp($rs = <STDIN>); 749 if ($rs =~ /^:\?$/i) { 750 $self->_clear($args->{'clear'}); 751 $self->_WRITE_HELP_TEXT(); 752 undef($rs); 753 next; 754 } 755 elsif ($rs =~ /^:(esc|escape)$/i) { 756 $self->_clear($args->{'clear'}); 757 undef($rs); 758 $self->rv(255); 759 return(0); 760 } 761 elsif (($args->{'extra-button'} || $args->{'extra-label'}) && $rs =~ /^:(e|extra)$/i) { 762 $self->rv(3); 763 return('EXTRA'); 764 } 765 elsif ($args->{'help-button'} && $rs =~ /^:(h|help)$/i) { 766 $self->_clear($args->{'clear'}); 767 undef($rs); 768 $self->rv(2); 769 return($self->state()); 770 } 771 elsif (!$args->{'nocancel'} && $rs =~ /^:(c|cancel)$/i) { 772 $self->_clear($args->{'clear'}); 773 undef($rs); 774 $self->rv(1); 775 return($self->state()); 776 } 777 elsif ($rs =~ /^:pg\s*(\d+)$/i) { 778 my $p = $1; 779 if ($p <= @{$realm} && $p > 0) { 780 $pg = $p; 781 } 782 undef($rs); 783 } 784 elsif ($rs =~ /^:(n|next)$/i) { 785 if ($pg < @{$realm}) { 786 $pg++; 787 } 788 else { 789 $pg = 1; 790 } 791 undef($rs); 792 } 793 elsif ($rs =~ /^:(p|prev)$/i) { 794 if ($pg > 1) { 795 $pg--; 796 } 797 else { 798 $pg = @{$realm}; 799 } 800 undef($rs); 801 } 802 else { 803 if (@_ = grep { /^\Q$rs\E$/i } @{$valid}) { 804 $rs = $_[0]; 805 } 806 else { 807 undef($rs); 808 } 809 } 810 $self->_clear($args->{'clear'}); 811 } 812 813 $self->rv('null'); 814 $self->ra($rs); 815 $self->rs($rs); 816 $self->_post($args); 817 return($rs); 818} 819 820#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 821#: A multi-selectable list 822sub checklist { 823 my $self = shift(); 824 my $caller = (caller(1))[3] || 'main'; 825 $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller; 826 if ($_[0] && $_[0] eq 'caller') { 827 shift(); $caller = shift(); 828 } 829 my $args = $self->_pre($caller,@_); 830 my $menulist = ($args->{'menu'} || $args->{'list'}); 831 my $menufix = []; 832 if (ref($menulist) eq "ARRAY") { 833 #: flatten our multidimensional array 834 foreach my $item (@$menulist) { 835 if (ref($item) eq "ARRAY") { 836 pop(@{$item}) if @$item == 3; 837 push(@$menufix,@{$item}); 838 } 839 else { 840 push(@$menufix,$item); 841 } 842 } 843 } 844 $args->{'menu'} = $menufix; 845 846 my $ra = []; 847 my $rs = ''; 848 my $m; 849 $m = @{$args->{'menu'}} if ref($args->{'menu'}) eq "ARRAY"; 850 my ($valid,$menu,$realm) = ([],[],[]); 851 push(@{$menu},@{$args->{'menu'}}) if ref($args->{'menu'}) eq "ARRAY"; 852 853 for (my $i = 0; $i < $m; $i += 3) { 854 push(@{$valid},$menu->[$i]); 855 } 856 857 if (@{$menu} >= 90) { 858 my $c = 0; 859 while (@{$menu}) { 860 $realm->[$c] = []; 861 for (my $i = 0; $i < 90; $i++) { 862 push(@{$realm->[$c]},shift(@{$menu})); 863 } 864 $c++; 865 } 866 } 867 else { 868 $realm->[0] = []; 869 push(@{$realm->[0]},@{$menu}); 870 } 871 my $go = "GO"; 872 my $pg = 1; 873 while ($go) { 874 $self->_WRITE_LIST(@_,'wm'=>'check','text'=>$args->{'text'},'menu'=>$realm->[($pg - 1||0)]); 875 $self->_PRINT($args->{'usestderr'},"(".$pg."/".@{$realm}."): "); 876 chomp($rs = <STDIN>); 877 if ($rs =~ /^:\?$/i) { 878 $self->_clear($args->{'clear'}); 879 $self->_WRITE_HELP_TEXT(); 880 undef($rs); 881 next; 882 } 883 elsif ($rs =~ /^:(esc|escape)$/i) { 884 $self->_clear($args->{'clear'}); 885 undef($rs); 886 $self->rv(255); 887 return($self->state()); 888 } 889 elsif (($args->{'extra-button'} || $args->{'extra-label'}) && $rs =~ /^:(e|extra)$/i) { 890 $self->_clear($args->{'clear'}); 891 $self->rv(3); 892 return($self->state()); 893 } 894 elsif (($args->{'help-button'} || $args->{'help-label'}) && $rs =~ /^:(h|help)$/i) { 895 $self->_clear($args->{'clear'}); 896 undef($rs); 897 $self->rv(2); 898 return($self->rv()); 899 } 900 elsif (!$args->{'nocancel'} && $rs =~ /^:(c|cancel)$/i) { 901 $self->_clear($args->{'clear'}); 902 undef($rs); 903 $self->rv(1); 904 return($self->state()); 905 } 906 elsif ($rs =~ /^:pg\s*(\d+)$/i) { 907 my $p = $1; 908 if ($p <= @{$realm} && $p > 0) { 909 $pg = $p; 910 } 911 } 912 elsif ($rs =~ /^:(n|next)$/i) { 913 if ($pg < @{$realm}) { 914 $pg++; 915 } 916 else { 917 $pg = 1; 918 } 919 } 920 elsif ($rs =~ /^:(p|prev)$/i) { 921 if ($pg > 1) { 922 $pg--; 923 } 924 else { 925 $pg = @{$realm}; 926 } 927 } 928 else { 929 my @opts = split(/\,\s|\,|\s/,$rs); 930 my @good; 931 foreach my $opt (@opts) { 932 if (@_ = grep { /^\Q$opt\E$/i } @{$valid}) { 933 push(@good,$_[0]); 934 } 935 } 936 if (@opts == @good) { 937 undef($go); 938 $ra = []; 939 push(@{$ra},@good); 940 } 941 } 942 $self->_clear($args->{'clear'}); 943 undef($rs); 944 } 945 946 $self->rv('null'); 947 $self->ra($ra); 948 $self->rs(join("\n",@$ra)); 949 $self->_post($args); 950 return(@{$ra}); 951} 952 953#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 954#: A radio button based list. very much like the menu widget. 955sub radiolist { 956 my $self = shift(); 957 my $caller = (caller(1))[3] || 'main'; 958 $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller; 959 if ($_[0] && $_[0] eq 'caller') { 960 shift(); $caller = shift(); 961 } 962 my $args = $self->_pre($caller,@_); 963 my $menulist = ($args->{'menu'} || $args->{'list'}); 964 my $menufix = []; 965 if (ref($menulist) eq "ARRAY") { 966 #: flatten our multidimensional array 967 foreach my $item (@$menulist) { 968 if (ref($item) eq "ARRAY") { 969 pop(@{$item}) if @$item == 3; 970 push(@$menufix,@{$item}); 971 } 972 else { 973 push(@$menufix,$item); 974 } 975 } 976 } 977 $args->{'menu'} = $menufix; 978 my $rs = ''; 979 my $m; 980 $m = @{$args->{'menu'}} if ref($args->{'menu'}) eq "ARRAY"; 981 my ($valid,$menu,$realm) = ([],[],[]); 982 push(@{$menu},@{$args->{'menu'}}) if ref($args->{'menu'}) eq "ARRAY"; 983 984 for (my $i = 0; $i < $m; $i += 3) { 985 push(@{$valid},$menu->[$i]); 986 } 987 988 if (@{$menu} >= 90) { 989 my $c = 0; 990 while (@{$menu}) { 991 $realm->[$c] = []; 992 for (my $i = 0; $i < 90; $i++) { 993 push(@{$realm->[$c]},shift(@{$menu})); 994 } 995 $c++; 996 } 997 } 998 else { 999 $realm->[0] = []; 1000 push(@{$realm->[0]},@{$menu}); 1001 } 1002 my $pg = 1; 1003 while (!$rs) { 1004 $self->_WRITE_LIST(@_,'text'=>$args->{'text'},'menu'=>$realm->[($pg - 1||0)]); 1005 $self->_PRINT($args->{'usestderr'},"(".$pg."/".@{$realm}."): "); 1006 chomp($rs = <STDIN>); 1007 if ($rs =~ /^:\?$/i) { 1008 $self->_clear($args->{'clear'}); 1009 $self->_WRITE_HELP_TEXT(); 1010 undef($rs); 1011 next; 1012 } 1013 elsif ($rs =~ /^:(esc|escape)$/i) { 1014 $self->_clear($args->{'clear'}); 1015 undef($rs); 1016 $self->rv(255); 1017 return($self->rv()); 1018 } 1019 elsif (($args->{'extra-button'} || $args->{'extra-label'}) && $rs =~ /^:(e|extra)$/i) { 1020 $self->rv(3); 1021 return($self->state()); 1022 } 1023 elsif (($args->{'help-button'} || $args->{'help-label'}) && $rs =~ /^:(h|help)$/i) { 1024 $self->_clear($args->{'clear'}); 1025 undef($rs); 1026 $self->rv(2); 1027 return($self->state()); 1028 } 1029 elsif (!$args->{'nocancel'} && $rs =~ /^:(c|cancel)$/i) { 1030 $self->_clear($args->{'clear'}); 1031 undef($rs); 1032 $self->rv(1); 1033 return($self->state()); 1034 } 1035 elsif ($rs =~ /^:pg\s*(\d+)$/i) { 1036 my $p = $1; 1037 if ($p <= @{$realm} && $p > 0) { 1038 $pg = $p; 1039 } 1040 undef($rs); 1041 } 1042 elsif ($rs =~ /^:(n|next)$/i) { 1043 if ($pg < @{$realm}) { 1044 $pg++; 1045 } 1046 else { 1047 $pg = 1; 1048 } 1049 undef($rs); 1050 } 1051 elsif ($rs =~ /^:(p|prev)$/i) { 1052 if ($pg > 1) { 1053 $pg--; 1054 } 1055 else { 1056 $pg = @{$realm}; 1057 } 1058 undef($rs); 1059 } 1060 else { 1061 if (@_ = grep { /^\Q$rs\E$/i } @{$valid}) { 1062 $rs = $_[0]; 1063 } 1064 else { 1065 undef($rs); 1066 } 1067 } 1068 $self->_clear($args->{'clear'}); 1069 } 1070 1071 $self->rv('null'); 1072 $self->ra($rs); 1073 $self->rs($rs); 1074 $self->_post($args); 1075 return($rs); 1076} 1077 1078 1079#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1080#: Simple ASCII progress indicator :) 1081sub spinner { 1082 my $self = shift(); 1083 if (!$self->{'__SPIN'} || $self->{'__SPIN'} == 1) { 1084 $self->{'__SPIN'} = 2; return("\b|"); 1085 } 1086 elsif ($self->{'__SPIN'} == 2) { 1087 $self->{'__SPIN'} = 3; return("\b/"); 1088 } 1089 elsif ($self->{'__SPIN'} == 3) { 1090 $self->{'__SPIN'} = 4; return("\b-"); 1091 } 1092 elsif ($self->{'__SPIN'} == 4) { 1093 $self->{'__SPIN'} = 1; return("\b\\"); 1094 } 1095} 1096 1097#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1098#: Simple ASCII meter bar 1099# the idea of a "true" dialog like gauge widget with ASCII is not that bad and 1100# as such, I've named these methods differently so as to keep the namespace 1101# open for gauge_*() widgets. 1102sub draw_gauge { 1103 my $self = shift(); 1104 my $args = $self->_merge_attrs(@_); 1105 my $length = $args->{'length'} || $args->{'width'} || 74; 1106 my $bar = ($args->{'bar'} || "-") x $length; 1107 my $current = $args->{'current'} || 0; 1108 my $total = $args->{'total'} || 0; 1109 my $percent = (($current && $total) ? int($current / ($total / 100)) : 1110 ($args->{'percent'} || '0')); 1111 $percent = int(($percent <= 100 && $percent >= 0) ? $percent : 0 ); 1112 my $perc = int((($length / 100) * $percent)); 1113 substr($bar,($perc||0),1,($args->{'mark'}||"|")); 1114 my $text = (($percent =~ /^\d$/) ? " " : 1115 ($percent =~ /^\d\d$/) ? " " : "").$percent."% ".$bar; 1116 $self->_PRINT($args->{'usestderr'},(($args->{'noCR'} && not $args->{'CR'}) ? "" : "\x0D").$text); 1117 return($percent||1); 1118} 1119sub end_gauge { 1120 my $self = shift(); 1121 my $args = $self->_merge_attrs(@_); 1122 $self->_PRINT($args->{'usestderr'},"\n"); 1123} 1124 11251; 1126