The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
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