package UI::Dialog::Backend::ASCII;
###############################################################################
# Copyright (C) 2004 Kevin C. Krinke <kckrinke@opendoorsoftware.com>
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Lesser General Public
# License as published by the Free Software Foundation; either
# version 2.1 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# Lesser General Public License for more details.
#
# You should have received a copy of the GNU Lesser General Public
# License along with this library; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
###############################################################################
use 5.006;
use strict;
use Carp;
use UI::Dialog::Backend;
use Time::HiRes qw( sleep );
BEGIN {
use vars qw( $VERSION @ISA );
@ISA = qw( UI::Dialog::Backend );
$VERSION = '1.08';
}
$| = 1; # turn on autoflush
#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
#: Constructor Method
#:
sub new {
my $proto = shift();
my $class = ref($proto) || $proto;
my $cfg = ((ref($_[0]) eq "HASH") ? $_[0] : (@_) ? { @_ } : {});
my $self = {};
bless($self, $class);
$self->{'_state'} = {};
$self->{'_opts'} = {};
#: Dynamic path discovery...
my $CFG_PATH = $cfg->{'PATH'};
if ($CFG_PATH) {
if (ref($CFG_PATH) eq "ARRAY") { $self->{'PATHS'} = $CFG_PATH; }
elsif ($CFG_PATH =~ m!:!) { $self->{'PATHS'} = [ split(/:/,$CFG_PATH) ]; }
elsif (-d $CFG_PATH) { $self->{'PATHS'} = [ $CFG_PATH ]; }
} elsif ($ENV{'PATH'}) { $self->{'PATHS'} = [ split(/:/,$ENV{'PATH'}) ]; }
else { $self->{'PATHS'} = ''; }
$self->{'_opts'}->{'callbacks'} = $cfg->{'callbacks'} || undef();
$self->{'_opts'}->{'timeout'} = $cfg->{'timeout'} || 0;
$self->{'_opts'}->{'wait'} = $cfg->{'wait'} || 0;
$self->{'_opts'}->{'debug'} = $cfg->{'debug'} || undef();
$self->{'_opts'}->{'title'} = $cfg->{'title'} || undef();
$self->{'_opts'}->{'backtitle'} = $cfg->{'backtitle'} || undef();
$self->{'_opts'}->{'usestderr'} = $cfg->{'usestderr'} || 0;
$self->{'_opts'}->{'extra-button'} = $cfg->{'extra-button'} || 0;
$self->{'_opts'}->{'extra-label'} = $cfg->{'extra-label'} || undef();
$self->{'_opts'}->{'help-button'} = $cfg->{'help-button'} || 0;
$self->{'_opts'}->{'help-label'} = $cfg->{'help-label'} || undef();
$self->{'_opts'}->{'nocancel'} = $cfg->{'nocancel'} || 0;
$self->{'_opts'}->{'maxinput'} = $cfg->{'maxinput'} || 0;
$self->{'_opts'}->{'defaultno'} = $cfg->{'defaultno'} || 0;
$self->{'_opts'}->{'autoclear'} = $cfg->{'autoclear'} || 0;
$self->{'_opts'}->{'clearbefore'} = $cfg->{'clearbefore'} || 0;
$self->{'_opts'}->{'clearafter'} = $cfg->{'clearafter'} || 0;
$self->{'_opts'}->{'beepbin'} = $cfg->{'beepbin'} || $self->_find_bin('beep') || '/usr/bin/beep';
$self->{'_opts'}->{'beepbefore'} = $cfg->{'beepbefore'} || 0;
$self->{'_opts'}->{'beepafter'} = $cfg->{'beepafter'} || 0;
$self->{'_opts'}->{'pager'} = ( $cfg->{'pager'} ||
$self->_find_bin('pager') ||
$self->_find_bin('less') ||
$self->_find_bin('more') );
$self->{'_opts'}->{'stty'} = $cfg->{'stty'} || $self->_find_bin('stty');
$self->{'_state'} = {'rv'=>0};
return($self);
}
#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
#: Iherited Overrides
#:
sub _organize_text {
my $self = shift();
my $text = shift() || return();
my @array;
if (ref($text) eq "ARRAY") { push(@array,@{$text}); }
elsif ($text =~ /\\n/) { @array = split(/\\n/,$text); }
else { @array = split(/\n/,$text); }
$text = undef();
$text = join("\n",@array);
return($self->_strip_text($text));
}
sub _merge_attrs {
my $self = shift();
my $args = (@_ % 2) ? { @_, '_odd' } : { @_ };
my $defs = $self->{'_opts'};
foreach my $def (keys(%$defs)) {
$args->{$def} = $defs->{$def} unless $args->{$def};
}
# alias 'filename' and 'file' to path
$args->{'path'} = (($args->{'filename'}) ? $args->{'filename'} :
($args->{'file'}) ? $args->{'file'} :
($args->{'path'}) ? $args->{'path'} : "");
$args->{'clear'} = $args->{'clearbefore'} || $args->{'clearafter'} || $args->{'autoclear'} || 0;
$args->{'beep'} = $args->{'beepbefore'} || $args->{'beepafter'} || $args->{'autobeep'} || 0;
return($args);
}
#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
#: Private Methods
#:
#: this is the dynamic 'Colon Command Help'
sub _WRITE_HELP_TEXT {
my $self = shift();
my ($head,$foot);
my $body = "
Colon Commands: [':?' (This help message)], [':pg <N>' (Go to page 'N')],
[':n'|':next' (Go to the next page)], [':p'|':prev' (Go to the previous page)],
[':esc'|':escape' (Send the [Esc] signal)].
";
# $head .= ("~" x 79);
if ($self->{'_opts'}->{'extra-button'} || $self->{'_opts'}->{'extra-label'}) {
$foot .= "[':e'|':extra' (Send the [Extra] signal)]\n";
}
if (!$self->{'_opts'}->{'nocancel'}) {
$foot .= "[':c'|':cancel' (Send the [Cancel] signal)]\n";
}
if ($self->{'_opts'}->{'help-button'} || $self->{'_opts'}->{'help-label'}) {
$foot .= "[':h'|':help' (Send the [Help] signal)]\n";
}
# $foot .= ("~" x 79)."\n";
# $self->msgbox(title=>'Colon Command Help',text=>$head.$body.$foot);
$self->msgbox(title=>'Colon Command Help',text=>$body.$foot);
}
#: this returns the labels (or ' ') for the "extra", "help" and
#: "cancel" buttons.
sub _BUTTONS {
my $self = shift();
my $cfg = $self->_merge_attrs(@_);
my ($help,$cancel,$extra) = (' ',' ',' ');
$extra = "Extra" if $cfg->{'extra-button'};
$extra = $cfg->{'extra-label'} if $cfg->{'extra-label'};
$extra = "':e'=[".$extra."]" if $extra and $extra ne ' ';
$help = "Help" if $cfg->{'help-button'};
$help = $self->{'help-label'} if $cfg->{'help-label'};
$help = "':h'=[".$help."]" if $help and $help ne ' ';
$cancel = "Cancel" unless $cfg->{'nocancel'};
$cancel = $cfg->{'cancellabel'} if $cfg->{'cancellabel'};
$cancel = "':c'=[".$cancel."]" if $cancel and $cancel ne ' ';
return($help,$cancel,$extra);
}
#: this writes a standard ascii interface to STDOUT. This is intended for use
#: with any non-list native ascii mode widgets.
sub _WRITE_TEXT {
my $self = shift();
my $cfg = $self->_merge_attrs(@_);
my $text = $self->_organize_text($cfg->{'text'}) || " ";
my $backtitle = $cfg->{'backtitle'} || " ";
my $title = $cfg->{'title'} || " ";
format ASCIIPGTXT =
+-----------------------------------------------------------------------------+
| @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< |
$backtitle
+-----------------------------------------------------------------------------+
| |
| +-------------------------------------------------------------------------+ |
| | @|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| | |
$title
| +-------------------------------------------------------------------------+ |
| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | |
$text
| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | |
$text
| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | |
$text
| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | |
$text
| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | |
$text
| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | |
$text
| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | |
$text
| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | |
$text
| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | |
$text
| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | |
$text
| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | |
$text
| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | |
$text
| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | |
$text
| +-------------------------------------------------------------------------+ |
| |
+-----------------------------------------------------------------------------+
.
no strict 'subs';
my $_fh = select();
select(STDERR) unless not $cfg->{'usestderr'};
my $LFMT = $~;
$~ = ASCIIPGTXT;
write();
$~= $LFMT;
select($_fh) unless not $cfg->{'usestderr'};
use strict 'subs';
}
#: very much like _WRITE_TEXT() except that this is specifically for
#: the menu() widget only.
sub _WRITE_MENU {
my $self = shift();
my $cfg = $self->_merge_attrs(@_);
my $text = $self->_organize_text($cfg->{'text'}) || " ";
my $backtitle = $cfg->{'backtitle'} || " ";
my $title = $cfg->{'title'} || " ";
my $menu = $cfg->{'menu'} || [];
my ($help,$cancel,$extra) = $self->_BUTTONS(@_);
format ASCIIPGMNU =
+-----------------------------------------------------------------------------+
| @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< |
$backtitle
+-----------------------------------------------------------------------------+
| |
| +-------------------------------------------------------------------------+ |
| | @|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| | |
$title
| +-------------------------------------------------------------------------+ |
| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | |
$text
| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | |
$text
| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | |
$text
| +-------------------------------------------------------------------------+ |
| @<<<< @<<<<<<<<<<<<<<< @<<<< @<<<<<<<<<<<<<<< @<<<< @<<<<<<<<<<<<<< |
($menu->[0]||' '),($menu->[1]||' '),($menu->[2]||' '),($menu->[3]||' '),($menu->[4]||' '),($menu->[5]||' ')
| @<<<< @<<<<<<<<<<<<<<< @<<<< @<<<<<<<<<<<<<<< @<<<< @<<<<<<<<<<<<<< |
($menu->[6]||' '),($menu->[7]||' '),($menu->[8]||' '),($menu->[9]||' '),($menu->[10]||' '),($menu->[11]||' ')
| @<<<< @<<<<<<<<<<<<<<< @<<<< @<<<<<<<<<<<<<<< @<<<< @<<<<<<<<<<<<<< |
($menu->[12]||' '),($menu->[13]||' '),($menu->[14]||' '),($menu->[15]||' '),($menu->[16]||' '),($menu->[17]||' ')
| @<<<< @<<<<<<<<<<<<<<< @<<<< @<<<<<<<<<<<<<<< @<<<< @<<<<<<<<<<<<<< |
($menu->[18]||' '),($menu->[19]||' '),($menu->[20]||' '),($menu->[21]||' '),($menu->[22]||' '),($menu->[23]||' ')
| @<<<< @<<<<<<<<<<<<<<< @<<<< @<<<<<<<<<<<<<<< @<<<< @<<<<<<<<<<<<<< |
($menu->[24]||' '),($menu->[25]||' '),($menu->[26]||' '),($menu->[27]||' '),($menu->[28]||' '),($menu->[29]||' ')
| @<<<< @<<<<<<<<<<<<<<< @<<<< @<<<<<<<<<<<<<<< @<<<< @<<<<<<<<<<<<<< |
($menu->[30]||' '),($menu->[31]||' '),($menu->[32]||' '),($menu->[33]||' '),($menu->[34]||' '),($menu->[35]||' ')
| @<<<< @<<<<<<<<<<<<<<< @<<<< @<<<<<<<<<<<<<<< @<<<< @<<<<<<<<<<<<<< |
($menu->[36]||' '),($menu->[37]||' '),($menu->[38]||' '),($menu->[39]||' '),($menu->[42]||' '),($menu->[43]||' ')
| @<<<< @<<<<<<<<<<<<<<< @<<<< @<<<<<<<<<<<<<<< @<<<< @<<<<<<<<<<<<<< |
($menu->[42]||' '),($menu->[43]||' '),($menu->[44]||' '),($menu->[45]||' '),($menu->[46]||' '),($menu->[47]||' ')
| @<<<< @<<<<<<<<<<<<<<< @<<<< @<<<<<<<<<<<<<<< @<<<< @<<<<<<<<<<<<<< |
($menu->[48]||' '),($menu->[49]||' '),($menu->[50]||' '),($menu->[51]||' '),($menu->[52]||' '),($menu->[53]||' ')
| @|||||||||||||||||||| @||||||||||||||||||| @||||||||||||||||||| |
$extra,$cancel,$help
| ':?' = [Colon Command Help] |
+-----------------------------------------------------------------------------+
.
no strict 'subs';
my $_fh = select();
select(STDERR) unless not $cfg->{'usestderr'};
my $LFMT = $~;
$~ = ASCIIPGMNU;
write();
$~= $LFMT;
select($_fh) unless not $cfg->{'usestderr'};
use strict 'subs';
}
#: very much like _WRITE_MENU() except that this is specifically for
#: the radiolist() and checklist() widgets only.
sub _WRITE_LIST {
my $self = shift();
my $cfg = $self->_merge_attrs(@_);
my $text = $self->_organize_text($cfg->{'text'}) || " ";
my $backtitle = $cfg->{'backtitle'} || " ";
my $title = $cfg->{'title'} || " ";
my $menu = [];
push(@{$menu},@{$cfg->{'menu'}});
my ($help,$cancel,$extra) = $self->_BUTTONS(@_);
my $m = @{$menu};
if ($cfg->{'wm'}) {
for (my $i = 2; $i < $m; $i += 3) {
if ($menu->[$i] && $menu->[$i] =~ /on/i) { $menu->[$i] = '->'; }
else { $menu->[$i] = ' '; }
}
} else {
my $mark;
for (my $i = 2; $i < $m; $i += 3) {
if (!$mark && $menu->[$i] && $menu->[$i] =~ /on/i) { $menu->[$i] = '->'; $mark = 1; }
else { $menu->[$i] = ' '; }
}
}
format ASCIIPGLST =
+-----------------------------------------------------------------------------+
| @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< |
$backtitle
+-----------------------------------------------------------------------------+
| |
| +-------------------------------------------------------------------------+ |
| | @|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| | |
$title
| +-------------------------------------------------------------------------+ |
| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | |
$text
| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | |
$text
| | ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | |
$text
| +-------------------------------------------------------------------------+ |
|@<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<< |
($menu->[2]||' '),($menu->[0]||' '),($menu->[1]||' '), ($menu->[5]||' '),($menu->[3]||' '),($menu->[4]||' '), ($menu->[8]||' '),($menu->[6]||' '),($menu->[7]||' ')
|@<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<< |
($menu->[11]||' '),($menu->[9]||' '),($menu->[10]||' '), ($menu->[14]||' '),($menu->[12]||' '),($menu->[13]||' '), ($menu->[17]||' '),($menu->[15]||' '),($menu->[16]||' ')
|@<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<< |
($menu->[20]||' '),($menu->[18]||' '),($menu->[19]||' '), ($menu->[23]||' '),($menu->[21]||' '),($menu->[22]||' '), ($menu->[26]||' '),($menu->[24]||' '),($menu->[25]||' ')
|@<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<< |
($menu->[29]||' '),($menu->[27]||' '),($menu->[28]||' '), ($menu->[32]||' '),($menu->[30]||' '),($menu->[31]||' '), ($menu->[35]||' '),($menu->[33]||' '),($menu->[34]||' ')
|@<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<< |
($menu->[38]||' '),($menu->[36]||' '),($menu->[37]||' '), ($menu->[41]||' '),($menu->[39]||' '),($menu->[40]||' '), ($menu->[44]||' '),($menu->[42]||' '),($menu->[43]||' ')
|@<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<< |
($menu->[47]||' '),($menu->[45]||' '),($menu->[46]||' '), ($menu->[50]||' '),($menu->[48]||' '),($menu->[49]||' '), ($menu->[53]||' '),($menu->[51]||' '),($menu->[52]||' ')
|@<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<< |
($menu->[56]||' '),($menu->[54]||' '),($menu->[55]||' '), ($menu->[59]||' '),($menu->[57]||' '),($menu->[58]||' '), ($menu->[62]||' '),($menu->[60]||' '),($menu->[61]||' ')
|@<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<< |
($menu->[65]||' '),($menu->[63]||' '),($menu->[64]||' '), ($menu->[68]||' '),($menu->[66]||' '),($menu->[67]||' '), ($menu->[71]||' '),($menu->[69]||' '),($menu->[70]||' ')
|@<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<< |
($menu->[74]||' '),($menu->[72]||' '),($menu->[73]||' '), ($menu->[77]||' '),($menu->[75]||' '),($menu->[76]||' '), ($menu->[80]||' '),($menu->[78]||' '),($menu->[79]||' ')
|@<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<<< @<<@<<<< @<<<<<<<<<<<<<< |
($menu->[83]||' '),($menu->[81]||' '),($menu->[82]||' '), ($menu->[86]||' '),($menu->[84]||' '),($menu->[85]||' '), ($menu->[89]||' '),($menu->[87]||' '),($menu->[88]||' ')
| @|||||||||||||||||||| @||||||||||||||||||| @||||||||||||||||||| |
$extra,$cancel,$help
| ':?' = [Colon Command Help] |
+-----------------------------------------------------------------------------+
.
no strict 'subs';
my $_fh = select();
select(STDERR) unless not $cfg->{'usestderr'};
my $LFMT = $~;
$~ = ASCIIPGLST;
write();
$~= $LFMT;
select($_fh) unless not $cfg->{'usestderr'};
use strict 'subs';
}
sub _PRINT {
my $self = shift();
my $stderr = shift();
if ($stderr) {
print STDERR @_;
} else {
print STDOUT @_;
}
}
#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
#: Public Methods
#:
#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#: Ask a binary question (Yes/No)
sub yesno {
my $self = shift();
my $caller = (caller(1))[3] || 'main';
$caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }
my $args = $self->_pre($caller,@_);
my ($YN,$RESP) = ('Yes|no','YES_OR_NO');
$YN = "yes|No" if $self->{'defaultno'};
while ($RESP !~ /^(y|yes|n|no)$/i) {
$self->_clear($args->{'clear'});
$self->_WRITE_TEXT(@_,text=>$args->{'text'});
$self->_PRINT($args->{'usestderr'},"(".$YN."): ");
chomp($RESP = <STDIN>);
if (!$RESP && $args->{'defaultno'}) { $RESP = "no"; }
elsif (!$RESP && !$args->{'defaultno'}) { $RESP = "yes"; }
if ($RESP =~ /^(y|yes)$/i) {
$self->ra("YES");
$self->rs("YES");
$self->rv('null');
} else {
$self->ra("NO");
$self->rs("NO");
$self->rv(1);
}
}
$self->_post($args);
return(1) if $self->state() eq "OK";
return(0);
}
#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#: Text entry
sub inputbox {
my $self = shift();
my $caller = (caller(1))[3] || 'main';
$caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }
my $args = $self->_pre($caller,@_);
my $length = $args->{'maxinput'} + 1;
my $text = $args->{'text'};
my $string;
chomp($text);
while ($length > $args->{'maxinput'}) {
$self->_clear($args->{'clear'});
$self->_WRITE_TEXT(@_,'text'=>$args->{'text'});
$self->_PRINT($args->{'usestderr'},"input: ");
chomp($string = <STDIN>);
if ($args->{'maxinput'}) {
$length = length($string);
} else {
$length = 0;
}
if ($length > $args->{'maxinput'}) {
$self->_PRINT($args->{'usestderr'},"error: too many charaters input,".
" the maximum is: ".$args->{'maxinput'}."\n");
}
}
$self->rv('null');
$self->ra($string);
$self->rs($string);
$self->_post($args);
return($string);
}
#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#: Password entry
sub password {
my $self = shift();
my $caller = (caller(1))[3] || 'main';
$caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }
my $args = $self->_pre($caller,@_);
croak("The UI::Dialog::Backend::ASCII password widget depends on the stty ".
"binary. This was not found or is not executable.")
unless -x $args->{'stty'};
my ($length,$key) = ($args->{'maxinput'} + 1,'');
my $string;
my $text = $args->{'text'};
chomp($text);
my $ENV_PATH = $ENV{'PATH'};
$ENV{'PATH'} = "";
while ($length > $args->{'maxinput'}) {
$self->_clear($args->{'clear'});
$self->_WRITE_TEXT(@_,'text'=>$args->{'text'});
$self->_PRINT($args->{'usestderr'},"input: ");
if ($self->_is_bsd()) { system "$args->{'stty'} cbreak </dev/tty >/dev/tty 2>&1"; }
else { system $args->{'stty'}, '-icanon', 'eol', "\001"; }
while ($key = getc(STDIN)) {
last if $key =~ /\n/;
if ($key =~ /^\x1b$/) {
#this could be the DELETE key (not BS or ^H)
# ^[[3~ or \x1b\x5b\x33\x7e (aka: ESC + [ + 3 + ~)
my $key2 = getc(STDIN);
if ($key2 =~ /^\x5b$/) {
my $key3 = getc(STDIN);
if ($key3 =~ /^\x33$/) {
my $key4 = getc(STDIN);
if ($key4 =~ /^\x7e$/) {
chop($string);
# go back five spaces and print five spaces (erase ^[[3~)
# go back five spaces again (backtrack),
# go back one space, print a space and go back (erase *)
if ($args->{'usestderr'}) {
print STDERR "\b\b\b\b\b"." "."\b\b\b\b\b"."\b \b";
} else {
print STDOUT "\b\b\b\b\b"." "."\b\b\b\b\b"."\b \b";
}
} else {
$key = $key.$key2.$key3.$key4;
}
} else {
$key = $key.$key2.$key3;
}
} else {
$key = $key.$key2;
}
} elsif ($key =~ /^(?:\x08|\x7f)$/) {
# this is either a BS or ^H
chop($string);
# go back two spaces and print two spaces (erase ^H)
# go back two spaces again (backtrack),
# go back one space, print a space and go back (erase *)
if ($args->{'usestderr'}) {
print STDERR "\b\b"." "."\b\b"."\b \b";
} else {
print STDOUT "\b\b"." "."\b\b"."\b \b";
}
} else {
if ($args->{'usestderr'}) {
print STDERR "\b*";
} else {
print STDOUT "\b*";
}
$string .= $key;
}
}
if ($self->_is_bsd()) { system "$args->{'stty'} -cbreak </dev/tty >/dev/tty 2>&1"; }
else { system $args->{'stty'}, 'icanon', 'eol', '^@'; }
if ($args->{'maxinput'}) { $length = length($string); }
else { $length = 0; }
if ($length > $args->{'maxinput'}) {
$self->_PRINT($args->{'usestderr'},"error: too many charaters input,".
" the maximum is: ".$args->{'maxinput'}."\n");
}
}
$ENV{'PATH'} = $ENV_PATH;
$self->rv('null');
$self->ra($string);
$self->rs($string);
$self->_post($args);
return($string);
}
#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#: Information box
sub infobox {
my $self = shift();
my $caller = (caller(1))[3] || 'main';
$caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }
my $args = $self->_pre($caller,@_);
$self->_WRITE_TEXT(@_,'text'=>$args->{'text'});
$self->_PRINT($args->{'usestderr'});
my $s = int(($args->{'wait'}) ? $args->{'wait'} :
($args->{'timeout'}) ? ($args->{'timeout'} / 1000.0) : 1.0);
sleep($s);
$self->rv('null');
$self->ra('null');
$self->rs('null');
$self->_post($args);
return(1);
}
#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#: Message box
sub msgbox {
my $self = shift();
my $caller = (caller(1))[3] || 'main';
$caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }
my $args = $self->_pre($caller,@_);
$self->_WRITE_TEXT(@_,'text'=>$args->{'text'});
$self->_PRINT($args->{'usestderr'},(" " x 25)."[ Press Enter to Continue ]");
my $junk = <STDIN>;
$self->rv('null');
$self->ra('null');
$self->rs('null');
$self->_post($args);
return(1);
}
#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#: Text box
sub textbox {
my $self = shift();
my $caller = (caller(1))[3] || 'main';
$caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }
my $args = $self->_pre($caller,@_);
my $rv = 0;
if (-r $args->{'path'}) {
my $ENV_PATH = $ENV{'PATH'};
$ENV{'PATH'} = "";
if ($ENV{'PAGER'} && -x $ENV{'PAGER'}) {
system($ENV{'PAGER'}." ".$args->{'path'});
$rv = $? >> 8;
} elsif (-x $args->{'pager'}) {
system($args->{'pager'}." ".$args->{'path'});
$rv = $? >> 8;
} else {
open(ATBFILE,"<".$args->{'path'});
local $/;
my $data = <ATBFILE>;
close(ATBFILE);
$self->_PRINT($args->{'usestderr'},$data);
}
$ENV{'PATH'} = $ENV_PATH;
} else {
return($self->msgbox('title'=>'error','text'=>$args->{'path'}.' is not a readable text file.'));
}
$self->rv($rv||'null');
$self->ra('null');
$self->rs('null');
$self->_post($args);
return($rv);
}
#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#: A simple menu
sub menu {
my $self = shift();
my $caller = (caller(1))[3] || 'main';
$caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }
my $args = $self->_pre($caller,@_);
$args->{'menu'} = $args->{'list'} if ref($args->{'list'}) eq "ARRAY";
my $string;
my $rs = '';
my $m;
$m = @{$args->{'menu'}} if ref($args->{'menu'}) eq "ARRAY";
my ($valid,$menu,$realm) = ([],[],[]);
push(@{$menu},@{$args->{'menu'}}) if ref($args->{'menu'}) eq "ARRAY";
for (my $i = 0; $i < $m; $i += 2) { push(@{$valid},$menu->[$i]); }
if (@{$menu} >= 60) {
my $c = 0;
while (@{$menu}) {
$realm->[$c] = [];
for (my $i = 0; $i < 60; $i++) {
push(@{$realm->[$c]},shift(@{$menu}));
}
$c++;
}
} else {
$realm->[0] = [];
push(@{$realm->[0]},@{$menu});
}
my $pg = 1;
while (!$rs) {
$self->_WRITE_MENU(@_,'text'=>$args->{'text'},
'menu'=>$realm->[($pg - 1||0)]);
$self->_PRINT($args->{'usestderr'},"(".$pg."/".@{$realm}."): ");
chomp($rs = <STDIN>);
if ($rs =~ /^:\?$/i) {
$self->_clear($args->{'clear'});
$self->_WRITE_HELP_TEXT();
undef($rs);
next;
} elsif ($rs =~ /^:(esc|escape)$/i) {
$self->_clear($args->{'clear'});
undef($rs);
$self->rv(255);
return(0);
} elsif (($args->{'extra-button'} || $args->{'extra-label'}) && $rs =~ /^:(e|extra)$/i) {
$self->rv(3);
return('EXTRA');
} elsif ($args->{'help-button'} && $rs =~ /^:(h|help)$/i) {
$self->_clear($args->{'clear'});
undef($rs);
$self->rv(2);
return($self->state());
} elsif (!$args->{'nocancel'} && $rs =~ /^:(c|cancel)$/i) {
$self->_clear($args->{'clear'});
undef($rs);
$self->rv(1);
return($self->state());
} elsif ($rs =~ /^:pg\s*(\d+)$/i) {
my $p = $1;
if ($p <= @{$realm} && $p > 0) { $pg = $p; }
undef($rs);
} elsif ($rs =~ /^:(n|next)$/i) {
if ($pg < @{$realm}) { $pg++; }
else { $pg = 1; }
undef($rs);
} elsif ($rs =~ /^:(p|prev)$/i) {
if ($pg > 1) { $pg--; }
else { $pg = @{$realm}; }
undef($rs);
} else {
if (@_ = grep { /^\Q$rs\E$/i } @{$valid}) { $rs = $_[0]; }
else { undef($rs); }
}
$self->_clear($args->{'clear'});
}
$self->rv('null');
$self->ra($rs);
$self->rs($rs);
$self->_post($args);
return($rs);
}
#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#: A multi-selectable list
sub checklist {
my $self = shift();
my $caller = (caller(1))[3] || 'main';
$caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }
my $args = $self->_pre($caller,@_);
my $menulist = ($args->{'menu'} || $args->{'list'});
my $menufix = [];
if (ref($menulist) eq "ARRAY") {
#: flatten our multidimensional array
foreach my $item (@$menulist) {
if (ref($item) eq "ARRAY") {
pop(@{$item}) if @$item == 3;
push(@$menufix,@{$item});
} else {
push(@$menufix,$item);
}
}
}
$args->{'menu'} = $menufix;
my $ra = [];
my $rs = '';
my $m;
$m = @{$args->{'menu'}} if ref($args->{'menu'}) eq "ARRAY";
my ($valid,$menu,$realm) = ([],[],[]);
push(@{$menu},@{$args->{'menu'}}) if ref($args->{'menu'}) eq "ARRAY";
for (my $i = 0; $i < $m; $i += 3) { push(@{$valid},$menu->[$i]); }
if (@{$menu} >= 90) {
my $c = 0;
while (@{$menu}) {
$realm->[$c] = [];
for (my $i = 0; $i < 90; $i++) {
push(@{$realm->[$c]},shift(@{$menu}));
}
$c++;
}
} else {
$realm->[0] = [];
push(@{$realm->[0]},@{$menu});
}
my $go = "GO";
my $pg = 1;
while ($go) {
$self->_WRITE_LIST(@_,'wm'=>'check','text'=>$args->{'text'},'menu'=>$realm->[($pg - 1||0)]);
$self->_PRINT($args->{'usestderr'},"(".$pg."/".@{$realm}."): ");
chomp($rs = <STDIN>);
if ($rs =~ /^:\?$/i) {
$self->_clear($args->{'clear'});
$self->_WRITE_HELP_TEXT();
undef($rs);
next;
} elsif ($rs =~ /^:(esc|escape)$/i) {
$self->_clear($args->{'clear'});
undef($rs);
$self->rv(255);
return($self->state());
} elsif (($args->{'extra-button'} || $args->{'extra-label'}) && $rs =~ /^:(e|extra)$/i) {
$self->_clear($args->{'clear'});
$self->rv(3);
return($self->state());
} elsif (($args->{'help-button'} || $args->{'help-label'}) && $rs =~ /^:(h|help)$/i) {
$self->_clear($args->{'clear'});
undef($rs);
$self->rv(2);
return($self->rv());
} elsif (!$args->{'nocancel'} && $rs =~ /^:(c|cancel)$/i) {
$self->_clear($args->{'clear'});
undef($rs);
$self->rv(1);
return($self->state());
} elsif ($rs =~ /^:pg\s*(\d+)$/i) {
my $p = $1;
if ($p <= @{$realm} && $p > 0) { $pg = $p; }
} elsif ($rs =~ /^:(n|next)$/i) {
if ($pg < @{$realm}) { $pg++; }
else { $pg = 1; }
} elsif ($rs =~ /^:(p|prev)$/i) {
if ($pg > 1) { $pg--; }
else { $pg = @{$realm}; }
} else {
my @opts = split(/\,\s|\,|\s/,$rs);
my @good;
foreach my $opt (@opts) {
if (@_ = grep { /^\Q$opt\E$/i } @{$valid}) { push(@good,$_[0]); }
}
if (@opts == @good) {
undef($go);
$ra = [];
push(@{$ra},@good);
}
}
$self->_clear($args->{'clear'});
undef($rs);
}
$self->rv('null');
$self->ra($ra);
$self->rs(join("\n",@$ra));
$self->_post($args);
return(@{$ra});
}
#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#: A radio button based list. very much like the menu widget.
sub radiolist {
my $self = shift();
my $caller = (caller(1))[3] || 'main';
$caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }
my $args = $self->_pre($caller,@_);
my $menulist = ($args->{'menu'} || $args->{'list'});
my $menufix = [];
if (ref($menulist) eq "ARRAY") {
#: flatten our multidimensional array
foreach my $item (@$menulist) {
if (ref($item) eq "ARRAY") {
pop(@{$item}) if @$item == 3;
push(@$menufix,@{$item});
} else {
push(@$menufix,$item);
}
}
}
$args->{'menu'} = $menufix;
my $rs = '';
my $m;
$m = @{$args->{'menu'}} if ref($args->{'menu'}) eq "ARRAY";
my ($valid,$menu,$realm) = ([],[],[]);
push(@{$menu},@{$args->{'menu'}}) if ref($args->{'menu'}) eq "ARRAY";
for (my $i = 0; $i < $m; $i += 3) { push(@{$valid},$menu->[$i]); }
if (@{$menu} >= 90) {
my $c = 0;
while (@{$menu}) {
$realm->[$c] = [];
for (my $i = 0; $i < 90; $i++) {
push(@{$realm->[$c]},shift(@{$menu}));
}
$c++;
}
} else {
$realm->[0] = [];
push(@{$realm->[0]},@{$menu});
}
my $pg = 1;
while (!$rs) {
$self->_WRITE_LIST(@_,'text'=>$args->{'text'},'menu'=>$realm->[($pg - 1||0)]);
$self->_PRINT($args->{'usestderr'},"(".$pg."/".@{$realm}."): ");
chomp($rs = <STDIN>);
if ($rs =~ /^:\?$/i) {
$self->_clear($args->{'clear'});
$self->_WRITE_HELP_TEXT();
undef($rs);
next;
} elsif ($rs =~ /^:(esc|escape)$/i) {
$self->_clear($args->{'clear'});
undef($rs);
$self->rv(255);
return($self->rv());
} elsif (($args->{'extra-button'} || $args->{'extra-label'}) && $rs =~ /^:(e|extra)$/i) {
$self->rv(3);
return($self->state());
} elsif (($args->{'help-button'} || $args->{'help-label'}) && $rs =~ /^:(h|help)$/i) {
$self->_clear($args->{'clear'});
undef($rs);
$self->rv(2);
return($self->state());
} elsif (!$args->{'nocancel'} && $rs =~ /^:(c|cancel)$/i) {
$self->_clear($args->{'clear'});
undef($rs);
$self->rv(1);
return($self->state());
} elsif ($rs =~ /^:pg\s*(\d+)$/i) {
my $p = $1;
if ($p <= @{$realm} && $p > 0) { $pg = $p; }
undef($rs);
} elsif ($rs =~ /^:(n|next)$/i) {
if ($pg < @{$realm}) { $pg++; }
else { $pg = 1; }
undef($rs);
} elsif ($rs =~ /^:(p|prev)$/i) {
if ($pg > 1) { $pg--; }
else { $pg = @{$realm}; }
undef($rs);
} else {
if (@_ = grep { /^\Q$rs\E$/i } @{$valid}) { $rs = $_[0]; }
else { undef($rs); }
}
$self->_clear($args->{'clear'});
}
$self->rv('null');
$self->ra($rs);
$self->rs($rs);
$self->_post($args);
return($rs);
}
#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#: Simple ASCII progress indicator :)
sub spinner {
my $self = shift();
if (!$self->{'__SPIN'} || $self->{'__SPIN'} == 1) { $self->{'__SPIN'} = 2; return("\b|"); }
elsif ($self->{'__SPIN'} == 2) { $self->{'__SPIN'} = 3; return("\b/"); }
elsif ($self->{'__SPIN'} == 3) { $self->{'__SPIN'} = 4; return("\b-"); }
elsif ($self->{'__SPIN'} == 4) { $self->{'__SPIN'} = 1; return("\b\\"); }
}
#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#: Simple ASCII meter bar
# the idea of a "true" dialog like gauge widget with ASCII is not that bad and
# as such, I've named these methods differently so as to keep the namespace
# open for gauge_*() widgets.
sub draw_gauge {
my $self = shift();
my $args = $self->_merge_attrs(@_);
my $length = $args->{'length'} || $args->{'width'} || 74;
my $bar = ($args->{'bar'} || "-") x $length;
my $current = $args->{'current'} || 0;
my $total = $args->{'total'} || 0;
my $percent = (($current && $total) ? int($current / ($total / 100)) :
($args->{'percent'} || '0'));
$percent = int(($percent <= 100 && $percent >= 0) ? $percent : 0 );
my $perc = int((($length / 100) * $percent));
substr($bar,($perc||0),1,($args->{'mark'}||"|"));
my $text = (($percent =~ /^\d$/) ? " " :
($percent =~ /^\d\d$/) ? " " : "").$percent."% ".$bar;
$self->_PRINT($args->{'usestderr'},(($args->{'noCR'} && not $args->{'CR'}) ? "" : "\x0D").$text);
return($percent||1);
}
sub end_gauge {
my $self = shift();
my $args = $self->_merge_attrs(@_);
$self->_PRINT($args->{'usestderr'},"\n");
}
1;