package Script::Toolbox::Util::Menues;
use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
#use Script::Toolbox::Util qw(Log);
require Exporter;
@ISA = qw(Exporter);
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
@EXPORT = qw(
);
#$VERSION = '0.03';
# Preloaded methods go here.
#-----------------------------------------------------------------------------
# {'menueName>' =>[{label=>,value=>,jump=>,argv=>},...]}
#-----------------------------------------------------------------------------
sub new
{
my $classname = shift;
my $self = {};
bless( $self, $classname );
$self->_init( @_ );
return $self;
}
#-----------------------------------------------------------------------------
# {'<menueName>' =>[{label=>,value=>,jump=>,argv=>},...]}
#-----------------------------------------------------------------------------
sub _init
{
my ($self, $newDef) = @_;
$self->{'def'} = {};
return if( ref $newDef ne 'HASH' );
$self->addMenue($newDef);
}
#------------------------------------------------------------------------------
#------------------------------------------------------------------------------
sub _getHead($){
my ($self,$def) = @_;
my $s = '';
foreach my $k ( @{$def} ) {
next if( ! defined $k->{'header'} );
$s .= sprintf "%s", $k->{'header'};
}
return $s ne '' ? $s : undef;
}
#------------------------------------------------------------------------------
#------------------------------------------------------------------------------
sub _getFoot($){
my ($self,$def) = @_;
my $s = '';
foreach my $k ( @{$def} ) {
next if( ! defined $k->{'footer'} );
$s .= sprintf "%s", $k->{'footer'};
}
return $s ne '' ? $s : undef;
}
#------------------------------------------------------------------------------
#------------------------------------------------------------------------------
sub _resolveSubmenue($){
my ($self,$opt) = @_;
return if( !defined $opt->{'jump'} );
return if( ref \$opt->{'jump'} ne 'SCALAR' );
my $subName = $opt->{'jump'};
return if( !defined $self->{'def'}{$subName} );
$opt->{'jump'} = \&Script::Toolbox::Util::Menues::run;
$opt->{'argv'} = [$self,$subName];
return;
}
#------------------------------------------------------------------------------
#------------------------------------------------------------------------------
sub _getOpts($){
my ($self,$def) = @_;
my @s;
foreach my $k ( @{$def} ) {
next if( ! defined $k->{'label'} );
$self->_resolveSubmenue($k);
push @s, $k;
}
return \@s;
}
#------------------------------------------------------------------------------
# <menueName>, [{label=>,value=>,jump=>,argv=>},...]}
#------------------------------------------------------------------------------
sub addMenue($){
my ($self,$newDef) = @_;
return if( ref $newDef ne 'HASH' );
foreach my $name ( keys %{$newDef} ){
my $def = $newDef->{$name};
$self->{'def'}{$name}{'head'} = $self->_getHead($def);
$self->{'def'}{$name}{'foot'} = $self->_getFoot($def);
$self->{'def'}{$name}{'opts'} = $self->_getOpts($def);
}
return;
}
#------------------------------------------------------------------------------
# <menueName>, <HeaderString>
#------------------------------------------------------------------------------
sub setHeader($$){
my ($self,$name,$head) = @_;
$self->{'def'}{$name}{'head'} = $head;
return;
}
#------------------------------------------------------------------------------
# <menueName>, <HeaderString>
#------------------------------------------------------------------------------
sub setAutoHeader($){
my ($self,$name) = @_;
if( defined $name) {
$self->{'def'}{$name}{'autohead'} = 1;
return;
}
foreach my $n (keys %{$self->{'def'}} ){
$self->{'def'}{$n}{'autohead'} = 1;
}
}
#------------------------------------------------------------------------------
#------------------------------------------------------------------------------
sub _delAutoHead($){
my ($ah) = @_;
delete $ah->{'autohead'} if( defined $ah->{'autohead'} );
}
#------------------------------------------------------------------------------
# <menueName>, <HeaderString>
#------------------------------------------------------------------------------
sub delAutoHeader($){
my ($self,$name) = @_;
if( defined $name) {
_delAutoHead( $self->{'def'}{$name} );
return;
}
foreach my $n (keys %{$self->{'def'}} ){
_delAutoHead( $self->{'def'}{$n} );
}
}
#------------------------------------------------------------------------------
# <menueName>, <HeaderString>
#------------------------------------------------------------------------------
sub getHeader($){
my ($self,$name) = @_;
my $autoHead = $self->{'def'}{$name}{'autohead'};
my $H;
my $h = $self->{'def'}{$name}{'head'};
$h = "Menue: $name" if(!defined $h && defined $autoHead);
$H = {'header' => $h} if( defined $h );
return $H;
}
#------------------------------------------------------------------------------
# <menueName>, <FooterString>
#------------------------------------------------------------------------------
sub setFooter($$){
my ($self,$name,$foot) = @_;
$self->{'def'}{$name}{'foot'} = $foot;
return;
}
#------------------------------------------------------------------------------
# <menueName>, <FooterString>
#------------------------------------------------------------------------------
sub getFooter($){
my ($self,$name) = @_;
my $foot = $self->{'def'}{$name}{'foot'} ;
return {'footer'=> $foot} if(defined $foot);
return undef;
}
#------------------------------------------------------------------------------
# <menueName>, {label=>,value=>,jump=>,argv=>}
#------------------------------------------------------------------------------
sub addOption($$){
my ($self,$name,$opt) = @_;
$self->{'def'}{$name}{'opts'} = [] if( ! defined $self->{'def'}{$name}{'opts'} );
push @{$self->{'def'}{$name}{'opts'}}, $opt;
return;
}
#------------------------------------------------------------------------------
#------------------------------------------------------------------------------
sub _getParams($){
my ($self,$name) = @_;
my @p;
my $s = $self->getHeader($name); push @p, $s if( defined $s );
$s = $self->getFooter($name); push @p, $s if( defined $s );
push @p, {'label'=>'RETURN'};
map {
push @p, $_;
} @{$self->{'def'}{$name}{'opts'}};
return \@p;
}
#------------------------------------------------------------------------------
# Run the named menue as long as $cnt is true. $cnt will be decremented by each
# loop. That means if $cnt starts with 0 we have an endless loop.
# Return the number of the last selected option.
# The option 'RETURN' will be created automaticly and has option number 0 by
# default.
#------------------------------------------------------------------------------
sub run($$){
my ($self,$name,$cnt) = @_;
return if( ! defined $self->{'def'}{$name} );
$cnt = 1 if( ! defined $cnt);
$cnt = 1 if( $cnt !~ /^[-]?\d+$/ );
my $o; my $m;
while($cnt--) {
my $p = $self->_getParams($name);
($o,$m) = Script::Toolbox::Util::Menue($p);
$self->{'def'}{$name}{'selected'}{'num'} = $o;
$self->{'def'}{$name}{'selected'}{'opt'} = $m->[$o];
return $o if( $o == 0 );
}
return $o;
}
#------------------------------------------------------------------------------
#------------------------------------------------------------------------------
sub currNumber($){
my ($self,$name) = @_;
return $self->{'def'}{$name}{'selected'}{'num'};
}
#------------------------------------------------------------------------------
#------------------------------------------------------------------------------
sub currLabel($){
my ($self,$name) = @_;
return $self->{'def'}{$name}{'selected'}{'opt'}{'label'};
}
#------------------------------------------------------------------------------
#------------------------------------------------------------------------------
sub currValue($){
my ($self,$name) = @_;
return $self->{'def'}{$name}{'selected'}{'opt'}{'value'};
}
#------------------------------------------------------------------------------
#------------------------------------------------------------------------------
sub currJump($){
my ($self,$name) = @_;
my $call = $self->{'def'}{$name}{'selected'}{'opt'}{'jump'};
my $args = $self->{'def'}{$name}{'selected'}{'opt'}{'argv'};
$call->($args) if( ref $call eq 'CODE');
return;
}
1;
__END__
=head1 NAME
Script::Toolbox::Util::Menues - see documentaion of Script::Toolbox
=cut