package UI::Dialog::Util::MenuControl; ## Is a menu maker for dialog.
our $VERSION='0.03';
use strict;
use Carp;
use vars qw($VERSION);
# It is an OO class to render a Dialog menu by a tree of array and hashes
# with specific form.
# a shell. It does not use curses and has no large dependencies.
#
#
# SYNOPSIS
# ========
#
#
# use UI::Dialog::Util::MenuControl;
#
# my $tree = {
# title => 'Conditinal behaviour',
# entries => [
# {
# title => 'entry A (prework for B)',
# function => \&doA,
# condition => undef,
# },
# {
# title => 'entry B',
# function => \&doB,
# condition => \&aWasCalled,
# },
# {
# title => 'reset A (undo prework)',
# function => \&resetA,
# condition => \&aWasCalled,
# },
# {
# title => 'has also submenus',
# entries => [
# {
# title => 'sub b 1',
# },
# {
# title => 'sub b 2',
# },
# ]
# },
#
# ],
# };
#
#
#
# my $menu_control = UI::Dialog::Util::MenuControl->new( menu => $tree );
#
# $menu_control->run();
#
# To build a menu, you can nest nodes with the attributes
#
# title
# function a reference to a function.
# condition a reference to a function given a boolean result whether to display the item or not
# entries array ref to further nodes
# context a 'self" for the called function
#
#
# ...
#
# our $objA = Local::UsecaseA->new();
#
#
# my $tree = {
# title => 'Conditinal behaviour',
# entries => [
# {
# title => 'entry B',
# function => \&doB,
# condition => \&Local::UsecaseA::check,
# context => $objA,
# },
#
# ],
# };
#
# In this example an object objA has been loaded before and provides a check() method.
# To run this check method in $objA context, you can tell a context to the node.
#
# What does the absolute same:
#
# my $tree = {
# title => 'Conditinal behaviour',
# entries => [
# {
# title => 'entry B',
# function => \&doB,
# condition => sub{ $objA->check() },
# },
#
# ],
# };
#
#
#
# Please consult the example files for more.
#
#
#
# LICENSE
# =======
# You can redistribute it and/or modify it under the conditions of LGPL.
#
# AUTHOR
# ======
# Andreas Hernitscheck ahernit(AT)cpan.org
# parameters
#
# context context object wich can be used for all called procedures (self)
# backend UI::Dialog Backend engine. E.g. CDialog (default), GDialog, KDialog, ...
# backend_settings Values as hash transfered to backend constructor
# menu Tree structure (see example above)
sub new {
my $pkg = shift;
my $self = bless {}, $pkg;
my $param = { @_ };
if ( not $param->{'menu'} ){ die "needs menu structure as key \'menu\'" };
my $menu = $param->{'menu'};
%{ $self } = %{ $param };
my $bset = $param->{'backend_settings'} || {};
$bset->{'listheight'} ||= 10;
$bset->{'height'} ||= 20;
# if no dialog is given assume console and init now
my $use_backend = $param->{'backend'} || 'CDialog';
my $backend_module = "UI::Dialog::Backend::$use_backend";
#require $backend_module;
eval("require $backend_module");
if ( $@ ){ die $@ };
my $backend = $backend_module->new( %{ $bset } );
$self->dialog( $backend );
# set first node as default
$self->_currentNode( $menu );
return $self;
}
# Main loop method. Will return when the user selected the last exit field.
sub run{
my $self = shift;
while (1){
last if not $self->showMenu();
}
return;
}
# Main control unit, but usually called by run().
# If you call it by yourself, you have to build your own loop around.
sub showMenu {
my $self = shift;
my $dialog = $self->dialog();
my $pos = $self->_currentNode();
my $title = $pos->{'title'};
my $retval = 1;
# node context or global or undef
my $context = $pos->{'context'} || $self->{'context'} || undef;
# prepare entries and remember further refs by
# the selected number
my @list;
my $c = 0;
my $entries = {};
menubuild: foreach my $e ( @{ $pos->{'entries'} } ) {
# context per element entry?
my $context_elem = $e->{'context'};
# you can skip menu entries if a condition is false.
# it is a boolean return of a function. So you can
# use moose's attributes.
if ( exists $e->{'condition'} && defined($e->{'condition'}) ){
if ( not &{$e->{'condition'}}( $context_elem || $context) ){
next menubuild;
}
}
$c++; # is the entry number
push @list, $c, $e->{'title'}; # title shown in the menu
$entries->{ $c } = $e;
}
my $sel = $dialog->menu(
text => $title,
list => \@list,
);
# selection in the menu?
if ( $sel ) {
# does the selected item has a submenu?
if ( $entries->{ $sel }->{'entries'} ){
$self->_currentNode( $entries->{ $sel } );
$self->_currentNode()->{'parent'} = $pos;
$self->showMenu();
}elsif( $entries->{ $sel }->{'function'} ){ # or is it a function call?
&{ $entries->{ $sel }->{'function'} }( $context );
}
}else{
# selected 'cancel' means go to partent if exists or exit app
if ( $pos->{ 'parent' } ) {
$self->_currentNode( $pos->{ 'parent' } );
$self->showMenu();
}else{
$retval = 0;
exit; ## top menu cancel, does an exit
}
}
return $retval;
}
# Points to the current displayed node in the menu tree.
sub _currentNode{
my $self = shift;
my $node = shift;
if ( $node ){
$self->{'current_node'} = $node;
}
return $self->{'current_node'};
}
# Holds the backend dialog system.
sub dialog{
my $self = shift;
my $backend = shift;
if ( $backend ){
$self->{'backend'} = $backend;
}
return $self->{'backend'};
}
1;
#################### pod generated by Pod::Autopod - keep this line to make pod updates possible ####################
=head1 NAME
UI::Dialog::Util::MenuControl - Is a menu maker for dialog
=head1 SYNOPSIS
use UI::Dialog::Util::MenuControl;
my $tree = {
title => 'Conditinal behaviour',
entries => [
{
title => 'entry A (prework for B)',
function => \&doA,
condition => undef,
},
{
title => 'entry B',
function => \&doB,
condition => \&aWasCalled,
},
{
title => 'reset A (undo prework)',
function => \&resetA,
condition => \&aWasCalled,
},
{
title => 'has also submenus',
entries => [
{
title => 'sub b 1',
},
{
title => 'sub b 2',
},
]
},
],
};
my $menu_control = UI::Dialog::Util::MenuControl->new( menu => $tree );
$menu_control->run();
To build a menu, you can nest nodes with the attributes
title
function a reference to a function.
condition a reference to a function given a boolean result whether to display the item or not
entries array ref to further nodes
context a 'self" for the called function
...
our $objA = Local::UsecaseA->new();
my $tree = {
title => 'Conditinal behaviour',
entries => [
{
title => 'entry B',
function => \&doB,
condition => \&Local::UsecaseA::check,
context => $objA,
},
],
};
In this example an object objA has been loaded before and provides a check() method.
To run this check method in $objA context, you can tell a context to the node.
What does the absolute same:
my $tree = {
title => 'Conditinal behaviour',
entries => [
{
title => 'entry B',
function => \&doB,
condition => sub{ $objA->check() },
},
],
};
Please consult the example files for more.
=head1 DESCRIPTION
It is an OO class to render a Dialog menu by a tree of array and hashes
with specific form.
a shell. It does not use curses and has no large dependencies.
=head1 REQUIRES
L<Carp>
=head1 METHODS
=head2 new
$obj = UI::Dialog::Util::MenuControl->new( menu => $tree );
parameters
context context object wich can be used for all called procedures (self)
backend UI::Dialog Backend engine. E.g. CDialog (default), GDialog, KDialog, ...
backend_settings Values as hash transfered to backend constructor
menu Tree structure (see example above)
=head2 dialog
$obj->dialog();
Holds the backend dialog system.
=head2 run
$obj->run();
Main loop method. Will return when the user selected the last exit field.
=head2 showMenu
$obj->showMenu();
Main control unit, but usually called by run().
If you call it by yourself, you have to build your own loop around.
=head1 AUTHOR
Andreas Hernitscheck ahernit(AT)cpan.org
=head1 LICENSE
You can redistribute it and/or modify it under the conditions of LGPL.
=cut