package Term::Menus; # Menus.pm # # Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 # by Brian M. Kelly. # # You may distribute under the terms of the GNU General # Public License, as specified in the LICENSE file. # (http://www.opensource.org/licenses/gpl-license.php). # # http://www.fullautosoftware.net/ ## See user documentation at the end of this file. Search for =head use 5.002; ## Module export. use vars qw(@EXPORT); @EXPORT = qw(pick Menu); ## Module import. use Exporter (); our @ISA = qw(Exporter); $VERSION = '1.29'; BEGIN { our $menu_cfg_file=''; our $fullauto=0; if (defined $main::menu_cfg) { if (-1 use sales_sub; # our $sub_module='usr_code.pm' --> our $sub_module='sales_sub.pm'; # # Continue for the remainder of the section ... BEGIN { our $sub_module=''; if (defined $main::usr_code) { if (-1) { if ($line=~/^[ \t]*\%(.*)\s*=/) { if (!exists $menudups{$1}) { $menudups{$1}=''; } else { my $die="\n FATAL ERROR! - Duplicate Hash Blocks:" ."\n -> \"%$1\" is defined more than once\n" ." in the $dir/$menu_cfg_file file.\n\n" ." Hint: delete or comment-out all duplicates\n\n"; if ($fullauto) { print $die if !$Net::FullAuto::FA_lib::cron; &Net::FullAuto::FA_lib::handle_error($die,'__cleanup__'); } else { die $die } } } } } if (!$s_flag && -f "$dir/$sub_module") { $s_flag=1; open(FH,"<$dir/$sub_module"); my $line='';my %dups=(); while ($line=) { if ($line=~/^[ \t]*\%(.*)\s*=/) { if (!exists $dups{$1}) { $dups{$1}=''; } else { my $die="\n FATAL ERROR! - Duplicate Hash Blocks:" ."\n -> \"%$1\" is defined more " ."than once\n in the $dir/" ."$sub_module file.\n\n Hint: delete " ."or comment-out all duplicates\n\n"; if ($fullauto) { print $die if !$Net::FullAuto::FA_lib::cron; &Net::FullAuto::FA_lib::handle_error($die,'__cleanup__'); } else { die $die } #print $die;exit; } } } } } if ($fullauto) { no strict 'refs'; foreach my $symname (keys %Term::Menus::) { if (eval "\\%$symname") { my $hashref=eval "\\%$symname"; HF: foreach my $key (keys %{$hashref}) { if (ref ${$hashref}{$key} eq 'HASH') { foreach my $ky (keys %{${$hashref}{$key}}) { if (lc($ky) eq 'text') { $LookUpMenuName{$hashref}="$symname"; last HF; } } } } } } } { use Sys::Hostname; our $local_hostname=hostname; } # Set clear our $clear=''; $clear=$Net::FullAuto::FA_lib::clear if defined $Net::FullAuto::FA_lib::clear; $clear.="\n" if $clear; my $count=0; our $blanklines=''; while ($count++!=30) { $blanklines.="\n" } our $OS=$^O; our $parent_menu=''; sub fa_login { my $usr_code='';my $menu_args='';$to='';my $die=''; my $start_menu_ref=''; eval { ($usr_code,$menu_args,$to,$die)= &Net::FullAuto::FA_lib::fa_login(@_); $start_menu_ref=$menu_cfg::start_menu_ref; $to||=0; $timeout=$to if $to; if ($usr_code) { &run_sub($usr_code,$menu_args); } elsif (ref $start_menu_ref eq 'HASH') { if (!exists $LookUpMenuName{$start_menu_ref}) { my $die="\n FATAL ERROR! - The top level menu," ." indicated\n by the " ."\$start_menu_ref variable in\n " ." the menu_cfg.pm file, is NOT\n" ." EXPORTED\n\n Hint: " ."\@EXPORT = qw( %Menu_1 %Menu_2 ... )\;" ."\n\n\tour \$start_menu_ref=\\%Menu_1\;" ."\n\n \[ Menu_1 is example - " ."name you choose is optional \]\n"; &Net::FullAuto::FA_lib::handle_error($die); } &Menu($start_menu_ref); } elsif ($start_menu_ref) { my $die="\n FATAL ERROR! - The top level menu " ."block indicated\n by the " ."\$start_menu_ref variable in the\n " ." menu_cfg.pm file, does not exist as" ."\n a properly constructed and" ."\\or named hash\n block in the" ." ".__PACKAGE__.".pm file\n\n Hint: " ."our \$start_menu_ref=\\%Menu_1\;\n\n " ."\[ Menu_1 is example - name you choose is" ." optional \]\n\n %Menu_1=\(\n" ." Item_1 => { ... },\n " ."...\n \)\;\n"; &Net::FullAuto::FA_lib::handle_error($die); } else { my $die="\n FATAL ERROR! - The \$start_menu_ref\n" ." variable in the menu_cfg.pm\n" ." file, is not defined or properly" ."\n initialized with the name of " ."the\n menu hash block designated" ." for the\n top level menu.\n\n" ." Hint: our \$start_menu_ref" ."=\\%Menu_1\;\n\n \[ Menu_1 is example - " ."name you choose is optional \]\n\n " ."%Menu_1=\(\n Item_1 => { ... },\n" ." ...\n \)\;\n"; &Net::FullAuto::FA_lib::handle_error($die); } }; if ($@) { my $cmdlin=52; $cmdlin=47 if $usr_code; &Net::FullAuto::FA_lib::handle_error($@,"-$cmdlin",'__cleanup__'); } #print "\n==> DONE!!!!!!!!!" if !$Net::FullAuto::FA_lib::cron && # !$Net::FullAuto::FA_lib::stdio; &Net::FullAuto::FA_lib::cleanup(1); } sub run_sub { my $usr_code=$_[0]; my $menu_args= (defined $_[1]) ? $_[1] : ''; my $subfile=substr($sub_module,0,-3).'::'; my $return= eval "\&$subfile$usr_code\(\@{\$menu_args}\)"; &Net::FullAuto::FA_lib::handle_error($@,'-1') if $@; return $return; } sub get_all_hosts { return Net::FullAuto::FA_lib::get_all_hosts(@_); } sub Menu { #print "MENUCALLER=",(caller)[0]," and ",__PACKAGE__,"\n";; #print "MENUCALLER=",caller,"\n";; my $MenuUnit_hash_ref=$_[0]; my $picks_from_parent=$_[1]; my $recurse = (defined $_[2]) ? $_[2] : 0; my $FullMenu= (defined $_[3]) ? $_[3] : {}; my $Selected= (defined $_[4]) ? $_[4] : {}; my $Conveyed= (defined $_[5]) ? $_[5] : {}; my $SavePick= (defined $_[6]) ? $_[6] : {}; my $SaveLast= (defined $_[7]) ? $_[7] : {}; my $SaveNext= (defined $_[8]) ? $_[8] : {}; my $parent_menu= (defined $_[9]) ? $_[9] : ''; my $no_wantarray=0; if ((defined $_[10] && $_[10]) || ((caller)[0] ne __PACKAGE__ && !wantarray)) { $no_wantarray=1; } if (defined $_[11] && $_[11]) { return '','','','','','','','','','',$_[11]; } my $pmsi_regex=qr/\]p(?:r+evious[-_]*)*m*(?:e+nu[-_]*) *s*(?:e+lected[-_]*)*i*(?:t+ems[-_]*)*\[/xi; my %Items=();my %negate=();my %result=(); my %convey=();my %chosen=();my %default=(); my $picks=[];my $banner='';my $num__=''; my $display_this_many_items=10;my $die_err=''; my $master_substituted='';my $convey=''; my $num=0;my @convey=();my $filtered=0;my $sorted=''; foreach my $key (keys %{$MenuUnit_hash_ref}) { if (4\"" ."\n\t\tElement in ".__PACKAGE__.".pm when the" ."\n\t\t\"Select =>\" Element is set to \'Many\'\n\n"; &Net::FullAuto::FA_lib::handle_error($die) if $fullauto; die $die; } my $con_regex=qr/\]c(o+nvey)*\[/i; if (exists ${$Items{$num}}{Convey}) { if (ref ${$Items{$num}}{Convey} eq 'ARRAY') { #@convey=@{${$Items{$num}}{Convey}}; foreach my $line (@{${$Items{$num}}{Convey}}) { $line=~s/\s?$//s; push @convey, $line; } } elsif (substr(${$Items{$num}}{Convey},0,1) eq '&') { if (defined $picks_from_parent && !ref $picks_from_parent) { ${$Items{$num}}{Convey}=~s/\s?$//s; my $convey=${$Items{$num}}{Convey}; $convey=~s/$pmsi_regex/$picks_from_parent/; @convey=eval $convey; } } elsif (${$Items{$num}}{Convey}=~/$pmsi_regex/) { ${$Items{$num}}{Convey}=~s/\s?$//s; my $convey=${$Items{$num}}{Convey}; $convey=~s/$pmsi_regex/$picks_from_parent/; push @convey, $convey; } else { ${$Items{$num}}{Convey}=~s/\s?$//s; push @convey, ${$Items{$num}}{Convey}; } foreach my $item (@convey) { my $text=${$Items{$num}}{Text}; $text=~s/$con_regex/$item/g; if ($text=~/$pmsi_regex\{([^}]+)\}/) { my $parse_text=$text; while ($parse_text=~m/($pmsi_regex)\{([^}]+)\}/g) { my @nums=();my $one=$1; my $two=$2; my $menubasename=substr($two,0,(index $two,'_')); if (-1; # "pick" --> This function presents the user with # with a list of items from which to choose. my @pickone=@{$_[0]}; my $banner=defined $_[1] ? $_[1] : "\n Please Pick an Item :"; my $display_this_many_items=defined $_[2] ? $_[2] : 10; my $log_handle= (defined $_[3]) ? $_[3] : ''; # Used Only With Cascasding Menus (Optional) my $MenuUnit_hash_ref= (defined $_[4]) ? $_[4] : ''; my $recurse_level= (defined $_[5]) ? $_[5] : 1; my $picks_from_parent= (defined $_[6]) ? $_[6] : ''; my $parent_menu= (defined $_[7]) ? $_[7] : ''; my $menu_cfg_file= (defined $_[8]) ? $_[8] : ''; my $FullMenu= (defined $_[9]) ? $_[9] : {}; my $Selected= (defined $_[10]) ? $_[10] : {}; my $Conveyed= (defined $_[11]) ? $_[11] : {}; my $SavePick= (defined $_[12]) ? $_[12] : {}; my $SaveLast= (defined $_[13]) ? $_[13] : {}; my $SaveNext= (defined $_[14]) ? $_[14] : {}; my $LookUpMenuName= (defined $_[15]) ? $_[15] : {}; my $Convey_contents= (defined $_[16]) ? $_[16] : []; my $no_wantarray= (defined $_[17]) ? $_[17] : 0; my %items=();my %picks=();my %negate=(); my %exclude=();my %include=();my %default=(); if ($SavePick && exists ${$SavePick}{$MenuUnit_hash_ref}) { %picks=%{${$SavePick}{$MenuUnit_hash_ref}}; } my $num_pick=$#pickone+1; my $caller=(caller(1))[3]; print $blanklines; if ($OS ne 'cygwin') { if ($clear) { print $clear; } elsif ($OS eq 'MSWin32') { system("cmd /c cls"); print "\n"; } else { print `clear`."\n"; } } my $numbor=0; # Number of Item Selected my $return_from_child_menu=0; my $choose_num=''; my $convey=''; my $menu_output=''; my $hidedefaults=0; my $start=0; sub delete_Selected { my $Selected=$_[2]; my $SavePick=$_[3]; my $SaveNext=$_[4]; if ($_[1]) { my $result=${$Selected}{$_[0]}{$_[1]}; delete ${$Selected}{$_[0]}{$_[1]}; delete ${$SavePick}{$_[0]}{$_[1]}; #delete ${$SaveNext}{$_[0]}; if ($result) { &delete_Selected($result,'', $Selected,$SavePick,$SaveNext); } delete ${$SaveNext}{$_[0]}; } else { if (keys %{${$Selected}{$_[0]}}) { foreach my $key (keys %{${$Selected}{$_[0]}}) { delete ${$Selected}{$_[0]}{$key}; delete ${$SavePick}{$_[0]}{$key}; delete ${$SaveNext}{$_[0]}; } } else { foreach my $key (keys %{${$SavePick}{$_[0]}}) { delete ${$SavePick}{$_[0]}{$key}; delete ${$SaveNext}{$_[0]}; } } } delete ${$SaveNext}{$_[0]}; return $SaveNext; } sub find_Selected { my $Selected=$_[2]; if ($_[1]) { my $result=${$Selected}{$_[0]}{$_[1]}; if (substr($result,0,1) eq '&') { return 0; } else { return &find_Selected($result,'',$Selected); } } else { if (keys %{${$Selected}{$_[0]}}) { foreach my $key (keys %{${$Selected}{$_[0]}}) { my $result=${$Selected}{$_[0]}{$key}; return '+' if substr($result,0,1) eq '&'; my $output=find_Selected($result,'',$Selected); return '+' if $output eq '+'; } } } } sub get_subs_from_menu { my $Selected=$_[0]; my @subs=(); foreach my $key (keys %{$Selected}) { foreach my $item (keys %{${$Selected}{$key}}) { if (substr(${$Selected}{$key}{$item},0,1) eq '&') { push @subs, ${$Selected}{$key}{$item}; } } } return @subs; } my $get_result = sub { # $_[0] => $MenuUnit_hash_ref # $_[1] => \@pickone # $_[2] => $numbor # $_[3] => $picks_from_parent my $convey='';my $result=''; my $send_all=0;my $all_convey=''; my $FullMenu=$_[4]; my $Conveyed=$_[5]; my $Selected=$_[6]; my $SaveNext=$_[7]; my $parent_menu=$_[8]; my $menu_cfg_file=$_[9]; my $Convey_contents=$_[10]; ${$LookUpMenuName}{$_[0]}=${$_[0]}{'Label'} unless exists ${$LookUpMenuName}{$_[0]}; if (exists ${$FullMenu}{$_[0]}[3]{${$_[1]}[$_[2]-1]}) { if (exists ${$_[0]}{${$FullMenu}{$_[0]} [4]{${$_[1]}[$_[2]-1]}}{Convey}) { $convey=${${$FullMenu}{$_[0]}[3]} {${$_[1]}[$_[2]-1]}[0]; if (keys %{${$Selected}{$_[0]}}) { my $get_convey=''; foreach my $item (keys %{${$Selected}{$_[0]}}) { $get_convey.='"'.${${$FullMenu}{$_[0]}[3]} {${$_[1]}[$item-1]}[0].'",' } $get_convey.="\"$convey\""; $all_convey="[ $get_convey ]"; } $convey='SKIP' if $convey eq ''; } if (exists ${$_[0]}{${$FullMenu}{$_[0]} [4]{${$_[1]}[$_[2]-1]}}{Convey}) { ${$Conveyed}{${$LookUpMenuName}{$_[0]}}=$convey; $parent_menu=${$LookUpMenuName}{$_[0]}; if (ref ${$_[0]}{${$FullMenu}{$_[0]} [4]{${$_[1]}[$_[2]-1]}}{'Result'} eq 'HASH') { if (exists ${$_[0]}{${$FullMenu}{$_[0]} [4]{${$_[1]}[$_[2]-1]}}{'Result'}{'Label'}) { $LookUpMenuName{${$_[0]}{${$FullMenu}{$_[0]} [4]{${$_[1]}[$_[2]-1]}}{'Result'}}= ${$_[0]}{${$FullMenu}{$_[0]} [4]{${$_[1]}[$_[2]-1]}}{'Result'}{'Label'}; $parent_menu=$LookUpMenuName{$_[0]}; } else { my $die="The \"Result =>\" Setting". "\n\t\tFound in the Menu Unit -> ". "${$MenuUnit_hash_ref}{'Label'}\n\t\tis a ". "HASH reference to a Menu Unit\,\n\t\t". "that does NOT EXIST or is NOT EXPORTED". "\n\n\tHint: Make sure the Names of all". "\n\t Menu Hash Blocks in the\n\t". " $menu_cfg_file file are\n\t". " listed in the \@EXPORT list\n\t". " found at the beginning of\n\t". " the $menu_cfg_file file\n\n\t". "our \@EXPORT = qw( %Menu_1 %Menu_2 ... )\;\n"; die $die; } } elsif (unpack('a1', ${$_[0]}{${$FullMenu}{$_[0]} [4]{${$_[1]}[$_[2]-1]}}{'Result'}) ne '&') { } } } else { $convey=$_[3] } if (exists ${$FullMenu}{$_[0]}[2] {${$_[1]}[$_[2]-1]}) { my $ret_regex=qr/\]r(e+turn)*\[/i; my $test_result=substr(${$FullMenu}{$_[0]} [2]{${$_[1]}[$_[2]-1]},0,1); if ((ref ${$FullMenu}{$_[0]}[2] {${$_[1]}[$_[2]-1]} eq 'HASH' && exists ${$FullMenu}{$_[0]}[2] {${$_[1]}[$_[2]-1]}{Item_1}) || substr(${$FullMenu}{$_[0]} [2]{${$_[1]}[$_[2]-1]},0,1) eq '&' || ${$FullMenu}{$_[0]}[2]{${$_[1]}[$_[2]-1]} =~/$ret_regex/) { $result=${$FullMenu}{$_[0]}[2] {${$_[1]}[$_[2]-1]}; my $con_regex=qr/\]c(o+nvey)*\[/i; my $sicm_regex= qr/\]s(e+lected[-_]*)*i*(t+ems[-_]*) *c*(u+rrent[-_]*)*m*(e+nu[-_]*)*a*(l+l)*\[/xi; my $pmsi_regex=qr/\]p(r+evious[-_]*)*m*(e+nu[-_]*) *s*(e+lected[-_]*)*i*(t+ems[-_]*)*\[/xi; if (ref $result eq 'HASH' && !exists ${$LookUpMenuName}{$result}) { if (exists ${$result}{'Label'}) { $LookUpMenuName{$result}=${$result}{'Label'}; } else { my $die="The \"Result =>\" Setting". "\n\t\tFound in the Menu Unit -> ". "${$MenuUnit_hash_ref}{'Label'}\n\t\tis a ". "HASH reference to a Menu Unit\,\n\t\t". "that does NOT EXIST or is NOT EXPORTED". "\n\n\tHint: Make sure the Names of all". "\n\t Menu Hash Blocks in the\n\t". " $menu_cfg_file file are\n\t". " listed in the \@EXPORT list\n\t". " found at the beginning of\n\t". " the $menu_cfg_file file\n\n\t". "our \@EXPORT = qw( %Menu_1 %Menu_2 ... )\;\n"; die $die; } } if ($result=~/$con_regex|$pmsi_regex|$sicm_regex/) { my $one=''; while ($result=~m/($sicm_regex)/g) { next if $1 eq $one; $one=$1; $send_all=1 if -1\" Element is "; $die.="set to\n\t\t\'Many\' in Menu Block "; $die.='%'.${$LookUpMenuName}{$_[0]}."\n\n"; &Net::FullAuto::FA_lib::handle_error($die) if $fullauto; die $die; } } else { $result=~s/$esc_one/$convey/g; } } $result=~s/$esc_one/${$_[1]}[$_[2]-1]/g; } $one=''; while ($result=~m/($pmsi_regex)/g) { next if $1 eq $one; $one=$1; my $esc_one=$one; $esc_one=~s/\]/\\\]/;$esc_one=~s/\[/\\\[/; while ($result=~m/$esc_one\{[^}]+\}/) { my $convey_ed=${$Conveyed}{$1}; $result=~s/$esc_one\{([^}]+)\}/${$Conveyed}{$1}/e; } my $pp=$picks_from_parent; $pp="\"$pp\"" if $pp=~/\s/s; $result=~s/$esc_one/$pp/g; } $one=''; while ($result=~m/($con_regex)/g) { next if $1 eq $one; $one=$1; my $esc_one=$one; $esc_one=~s/\]/\\\]/;$esc_one=~s/\[/\\\[/; $result=~s/\"$esc_one\"/$Convey_contents/g; } } elsif (substr($result,0,1) eq '&') { my $subname='&'.substr($sub_module,0,-3) .'::'.substr($result,1); if (!eval "defined $subname") { my $die="The \"Result =>\" Setting"; $die.="\n\t\t-> " . ${$FullMenu}{$_[0]} [2]{${$_[1]}[$_[2]-1]}; $die.="\n\t\tFound in the Menu Unit -> "; $die.="${$LookUpMenuName}{$_[0]}\n\t\t"; $die.="Specifies a Subroutine\,"; $die.=" $result that Does NOT Exist\n\t\tin the "; $die.=" User Subroutines File $sub_module"; $die.=".\n"; if (defined $log_handle && -1/) { if ($convey ne 'SKIP') { $result=~s/Convey\s*=\>/$convey/g; } else { $result=~s/Convey\s*=\>/${$_[1]}[$_[2]-1]/g; } } if ($result=~/Text\s*=\>/) { $result=~s/Text\s*=\>/${$_[1]}[$_[2]-1]/g; } } else { my $die="\n FATAL ERROR! - The \"Result =>\" Setting" ."\n -> " . ${$FullMenu}{$_[0]} [2]{${$_[1]}[$_[2]-1]} ."\n Found in the Menu Unit -> " ."$_[0]\n is not a Menu Unit\," ." and Because it Does Not Have\n " ."an \"&\" as the Lead Character, $0\n" ." Cannot Determine " ."if it is a Valid SubRoutine.\n\n"; die $die; #if ($fullauto) { # print $die if !$Net::FullAuto::FA_lib::cron; # &Net::FullAuto::FA_lib::handle_error($die); #} else { die $die } } } chomp($_[2]); if ($send_all && keys %{${$Selected}{$_[0]}}) { foreach my $item (keys %{${$Selected}{$_[0]}}) { ${$Selected}{$_[0]}{$item}=''; } } ${$Selected}{$_[0]}{$_[2]}=$result; if (ref ${$_[0]}{${$FullMenu}{$_[0]} [4]{${$_[1]}[$_[2]-1]}}{'Result'} eq 'HASH') { if (exists ${$_[0]}{${$FullMenu}{$_[0]} [4]{${$_[1]}[$_[2]-1]}}{'Result'}{'Label'}) { ${$SaveNext}{$_[0]}= ${${$FullMenu}{$_[0]}[2]} {${$_[1]}[$_[2]-1]}; } else { my $die="The \"Result =>\" Setting". "\n\t\tFound in the Menu Unit -> ". "${$MenuUnit_hash_ref}{'Label'}\n\t\tis a ". "HASH reference to a Menu Unit\,\n\t\t". "that does NOT EXIST or is NOT EXPORTED". "\n\n\tHint: Make sure the Names of all". "\n\t Menu Hash Blocks in the\n\t". " $menu_cfg_file file are\n\t". " listed in the \@EXPORT list\n\t". " found at the beginning of\n\t". " the $menu_cfg_file file\n\n\t". "our \@EXPORT = qw( %Menu_1 %Menu_2 ... )\;\n"; die $die; } } return $FullMenu,$Conveyed,$SaveNext,$Selected,$convey,$parent_menu; }; my $sum_menu=0;my $filtered_menu=0; while (1) { if ($num_pick-$start<=$display_this_many_items) { $choose_num=$num_pick-$start; } else { $choose_num=$display_this_many_items } $numbor=$start+$choose_num+1;my $done=0;my $savechk=0;my %pn=(); my $sorted_flag=0; while ($numbor<=$start || $start+$choose_num < $numbor) { my $menu_text='';my $pn=''; $menu_text.=$banner if defined $banner; $menu_text.="\n\n"; my $picknum=$start+1; my $numlist=$choose_num; my $mark=' ';my $mark_flg=0;my $prev_menu=0; while (0 < $numlist) { if (exists $picks{$picknum}) { $mark_flg=1; if ($return_from_child_menu) { $mark=$picks{$picknum}=$return_from_child_menu; $prev_menu=$picknum; } else { $mark=$picks{$picknum} } if ($picks{$picknum} ne '+' && $picks{$picknum} ne '-') { $mark_flg=1;$mark='*'; if (exists ${$FullMenu}{$MenuUnit_hash_ref}[2] {$pickone[$picknum-1]}{Item_1}) { if (exists ${$FullMenu}{$MenuUnit_hash_ref}[3] {$pickone[$picknum-1]}) { $convey=${${$FullMenu}{$MenuUnit_hash_ref}[3] {$pickone[$picknum-1]}}[0]; } else { $convey=$pickone[$picknum-1] } eval { ($menu_output,$FullMenu,$Selected,$Conveyed,$SavePick, $SaveLast,$SaveNext)=&Menu(${$FullMenu} {$MenuUnit_hash_ref}[2] {$pickone[$picknum-1]},$convey, $recurse_level,$FullMenu, $Selected,$Conveyed,$SavePick, $SaveLast,$SaveNext,$MenuUnit_hash_ref, $no_wantarray); }; die $@ if $@; chomp($menu_output) if !(ref $menu_output); if ($menu_output eq '-') { $picks{$picknum}='-';$mark='-'; } elsif ($menu_output eq '+') { $picks{$picknum}='+';$mark='+'; } elsif ($menu_output eq 'DONE_SUB') { return 'DONE_SUB'; } elsif ($menu_output eq 'DONE') { if (1==$recurse_level) { my $subfile=substr($sub_module,0,-3).'::'; foreach my $sub (&get_subs_from_menu($Selected)) { $sub=unpack('x1 a*',$sub); eval { unless (defined eval "$subfile$sub") { if ($@) { if ($fullauto) { &Net::FullAuto::FA_lib::handle_error( $@,'-1'); } else { die $@ } } #### TEST FOR UNDEF SUB - ADD MORE #### ERROR INFO } }; if ($@) { #&Net::FullAuto::FA_lib::handle_error($@,'-5') # if $fullauto; die $@; } } return 'DONE_SUB'; } else { return 'DONE' } } elsif ($menu_output) { return $menu_output; } else { $picks{$picknum}='+';$mark='+' } } else { $picks{$picknum}='*'; } } } else { $mark=' ' } if (!$hidedefaults && ${$FullMenu}{$MenuUnit_hash_ref}[5] {$pickone[$picknum-1]} && (${$FullMenu} {$MenuUnit_hash_ref}[5]{$pickone[$picknum-1]} eq '*' || $pickone[$picknum-1]=~ /${$FullMenu}{$MenuUnit_hash_ref}[5]{$pickone[$picknum-1]}/ )) { $picks{$picknum}='*';$mark='*';$mark_flg=1; } $pn=$picknum; if (${$FullMenu}{$MenuUnit_hash_ref}[6]{$pickone[$picknum-1]} && ${$FullMenu}{$MenuUnit_hash_ref}[6]{$pickone[$picknum-1]} ne '_ZERO_') { $pn=${$FullMenu}{$MenuUnit_hash_ref}[6]{$pickone[$picknum-1]}; $mark=${$SavePick}{$parent_menu}{$pn}||' '; if (${$FullMenu}{$MenuUnit_hash_ref}[7]) { $filtered_menu=1; } else { $sum_menu=1; } } $pn{$pn}=''; $menu_text.=" $mark $pn. \t$pickone[$picknum-1]\n"; if ($mark eq ' ' || (exists $picks{$picknum} || exists $picks{$pn})) { ${$_[0]}[$pn-1]=$pickone[$picknum-1]; #$picknum++; } $picknum++; $numlist--; } $hidedefaults=1; print $blanklines; if ($OS ne 'cygwin') { if ($clear) { print $clear; } elsif ($OS eq 'MSWin32') { system("cmd /c cls"); print "\n"; } else { print `clear`."\n"; } } print $menu_text; if (wantarray && !$no_wantarray && (exists ${$MenuUnit_hash_ref}{Select} && ${$MenuUnit_hash_ref}{Select} eq 'Many')) { print "\n";my $ch=0; unless (keys %{${$FullMenu}{$MenuUnit_hash_ref}[1]}) { print " a. Select All.";$ch=1; } if ($mark_flg==1) { print " c. Clear All.";print "\n" if $ch; } print " f. Finish.\n"; } if ($display_this_many_items<$num_pick) { print "\n $num_pick Total Choices\n", "\n Press ENTER \(or \"d\"\) to scroll downward\n", "\n OR \"u\" to scroll upward \(Press \"q\" to quit\)\n"; } else { print"\n \(Press \"q\" to quit\)\n" } print"\n PLEASE ENTER A CHOICE: "; $numbor=;$pn=$numbor;chomp $pn; if ($numbor=~/^f$/i && wantarray && !$no_wantarray && (exists ${$MenuUnit_hash_ref}{Select} && ${$MenuUnit_hash_ref}{Select} eq 'Many')) { my $choice='';my @keys=(); @keys=keys %picks; if (-1==$#keys) { @keys=keys %{${$SavePick}{$parent_menu}}; if (-1==$#keys) { ### DO CONDITIONAL FOR THIS!!!!!!!!!!!!!!!!! print $blanklines; if ($OS ne 'cygwin') { if ($clear) { print $clear; } elsif ($OS eq 'MSWin32') { system("cmd /c cls"); print "\n"; } else { print `clear`."\n"; } } print "\n\n Attention USER! :\n\n ", "You have selected \"f\" to finish your\n", " selections, BUT -> You have not actually\n", " selected anything!\n\n Do you wish ", "to quit or re-attempt selecting?\n\n ", "Press \"q\" to quit or ENTER to continue ... "; $choice=; chomp($choice); next if lc($choice) ne 'q'; return ']quit[' } } my $ret_regex=qr/\]?r(e+turn)*\[?/i; my $return_values=0; sub numerically { $a <=> $b } my @sortedpicks=(); if ($sum_menu || $filtered_menu) { @sortedpicks=sort numerically keys %{${$SavePick}{$parent_menu}}; } else { @sortedpicks=sort numerically keys %picks; } foreach my $pk (@sortedpicks) { $return_values=1 if !exists ${$FullMenu}{$MenuUnit_hash_ref}[2]{${$_[0]}[$pk-1]} || !keys %{${$FullMenu}{$MenuUnit_hash_ref}[2]{${$_[0]}[$pk-1]}} || ${$FullMenu}{$MenuUnit_hash_ref}[2]{${$_[0]}[$pk-1]} =~/$ret_regex/i; #if ($filtered_menu || $sorted) { if (${${$FullMenu}{$parent_menu}[8]}[$pk-1] && !${$_[0]}[$pk-1]) { my $txt=${${$FullMenu}{$parent_menu}[8]}[$pk-1]; if (-1; return \@pickd if $return_values; return 'DONE'; } elsif ($numbor=~/^\s*%(.*)/s) { my $one=$1||''; chomp $one;my @spl=();my $sort_ed=''; if ($one) { } elsif ($sorted && $sorted eq 'forward') { @spl=reverse @pickone;$sort_ed='reverse'; } else { @spl=sort @pickone;$sort_ed='forward' } chomp $numbor; my $cnt=0;my $ct=0;my @splice=(); my %sorts=(); foreach my $line (@pickone) { $cnt++; if (${$FullMenu}{$MenuUnit_hash_ref}[6] {$pickone[$picknum-1]} && ${$FullMenu} {$MenuUnit_hash_ref}[6]{$pickone[$picknum-1]} ne '_ZERO_') { $sort{$line}=${$FullMenu}{$MenuUnit_hash_ref}[6]{$line}; } else { $sort{$line}=$cnt } } $cnt=0;my $chose_n=''; my %chosen=(); if (!$sorted) { %chosen=( Label => 'chosen', Select => 'Many', Banner => ${$MenuUnit_hash_ref}{Banner}, ); my $cnt=0; foreach my $text (@spl) { my $num=$sort{$text}; $cnt++; if (exists $picks{$text}) { $chosen{'Item_'.$cnt}= { Text => $text,Default => '*',__NUM__=>$num }; } else { $chosen{'Item_'.$cnt}= { Text => $text,__NUM__=>$num }; } $chosen{'Item_'.$cnt}{Result}=$result{$text} if exists $result{$text}; $chosen{'Item_'.$cnt}{Convey}=$convey{$text} if exists $convey{$text}; $chosen{'Item_'.$cnt}{Sort}=$sort_ed; } $sorted=$sort_ed; } else { @pickone=reverse @pickone; next; } if (1) { $chose_n=\%chosen; } else { } $LookUpMenuName{$chose_n} =${$chose_n}{'Label'}; %{${$SavePick}{$MenuUnit_hash_ref}}=%picks; ${$SaveLast}{$MenuUnit_hash_ref}=$numbor; eval { ($menu_output,$FullMenu,$Selected,$Conveyed,$SavePick, $SaveLast,$SaveNext)=&Menu($chose_n,$convey, $recurse_level,$FullMenu, $Selected,$Conveyed,$SavePick, $SaveLast,$SaveNext,$MenuUnit_hash_ref, $no_wantarray); }; die $@ if $@; chomp($menu_output) if !(ref $menu_output); if ($menu_output eq '-') { %picks=%{${$SavePick}{$MenuUnit_hash_ref}}; } elsif ($menu_output eq '+') { %picks=%{${$SavePick}{$MenuUnit_hash_ref}}; } elsif ($menu_output eq 'DONE_SUB') { return 'DONE_SUB'; } elsif ($menu_output eq 'DONE') { if (1==$recurse_level) { my $subfile=substr($sub_module,0,-3).'::'; foreach my $sub (&get_subs_from_menu($Selected)) { $sub=unpack('x1 a*',$sub); eval { unless (defined eval "$subfile$sub") { if ($@) { if ($fullauto) { &Net::FullAuto::FA_lib::handle_error($@,'-1'); } else { die $@ } } #### TEST FOR UNDEF SUB - ADD MORE #### ERROR INFO } }; if ($@) { #@&Net::FullAuto::FA_lib::handle_error($@,'-5') # if $fullauto; die $@; } } return 'DONE_SUB'; } else { return 'DONE' } } elsif ($menu_output) { return $menu_output; } else { %picks=%{${$SavePick}{$MenuUnit_hash_ref}} } #print "DO THE SORT\n";; } elsif ($numbor=~/^\*\s*$/s) { if (!exists ${$MenuUnit_hash_ref}{Select} || ${$MenuUnit_hash_ref}{Select} eq 'One') { print "\n ERROR: Cannot Show Multiple Selected Items\n". " When 'Select' is NOT set to 'Many'\n"; sleep 3;next; } my @splice=(); if ($filtered_menu) { foreach my $key (keys %{${$SavePick}{$parent_menu}}) { $picks{$key}='*'; } foreach my $key (keys %picks) { if ($parent_menu) { ${${$SavePick}{$parent_menu}}{$key}='*'; } else { ${${$SavePick}{$MenuUnit_hash_ref}}{$key}='*'; } } } foreach my $pick (sort numerically keys %picks) { push @splice,($pick-1) } foreach $spl (@splice) { if ($parent_menu) { push @spl, ${${$FullMenu}{$parent_menu}[8]}[$spl]; } else { push @spl, ${${$FullMenu}{$MenuUnit_hash_ref}[8]}[$spl]; } } my %chosen=( Label => 'chosen', Select => 'Many', Banner => ${$MenuUnit_hash_ref}{Banner}, ); my $cnt=0; my $hash_ref=$parent_menu||$MenuUnit_hash_ref; foreach my $text (@spl) { my $num=shift @splice; $cnt++; $chosen{'Item_'.$cnt}= { Text => $text,Default => '*',__NUM__=>$num+1 }; $chosen{'Item_'.$cnt}= { Result => $result{$text} } if exists $result{$text}; $chosen{'Item_'.$cnt}= { Convey => $convey{$text} } if exists $convey{$text}; } my $chose_n=\%chosen; $LookUpMenuName{$chose_n} =${$chose_n}{'Label'}; %{${$SavePick}{$MenuUnit_hash_ref}}=%picks; ${$SaveLast}{$MenuUnit_hash_ref}=$numbor; eval { ($menu_output,$FullMenu,$Selected,$Conveyed,$SavePick, $SaveLast,$SaveNext,$ignore1,$ignore2,$ignore3,$die_err) =&Menu($chose_n,$convey, $recurse_level,$FullMenu, $Selected,$Conveyed,$SavePick, $SaveLast,$SaveNext,$MenuUnit_hash_ref, $no_wantarray); }; die $@ if $@; chomp($menu_output) if !(ref $menu_output); if ($menu_output eq '-') { %picks=%{${$SavePick}{$MenuUnit_hash_ref}}; } elsif ($menu_output eq '+') { %picks=%{${$SavePick}{$MenuUnit_hash_ref}}; } elsif ($menu_output eq 'DONE_SUB') { return 'DONE_SUB'; } elsif ($menu_output eq 'DONE') { if (1==$recurse_level) { my $subfile=substr($sub_module,0,-3).'::'; foreach my $sub (&get_subs_from_menu($Selected)) { $sub=unpack('x1 a*',$sub); eval { unless (defined eval "$subfile$sub") { if ($@) { my $die="The \"Result =>\" Setting" ."\n\t\t-> " . ${$FullMenu}{$_[0]} [2]{${$_[1]}[$_[2]-1]} ."\n\t\tFound in the Menu Unit -> " ."${$LookUpMenuName}{$_[0]}\n\t\t" ."Specifies a Subroutine\," ." $result that Does NOT Exist" ."\n\t\tin the User Subroutines " ."File $sub_module\n"; #&Net::FullAuto::FA_lib::handle_error( # $die,'-1'); die $die; #&Net::FullAuto::FA_lib::handle_error($@,'-1'); #} else { die $@ } } #### TEST FOR UNDEF SUB - ADD MORE #### ERROR INFO } }; if ($@) { #&Net::FullAuto::FA_lib::handle_error($@,'-5') # if $fullauto; die $@; } } return 'DONE_SUB'; } else { return 'DONE' } } elsif ($menu_output) { return $menu_output; } else { %picks=%{${$SavePick}{$MenuUnit_hash_ref}} } } elsif ($numbor=~/^\s*\/(.+)$/s) { my $one=$1||''; chomp $one; $one=qr/$one/ if $one; my @spl=(); chomp $numbor; my $cnt=0;my $ct=0;my @splice=(); foreach my $pik (@pickone) { $cnt++; if ($pik=~/$one/s) { push @spl, $pik; $splice[$ct++]=$cnt; } } next if $#spl==-1; my %chosen=( Label => 'chosen', Select => 'Many', Banner => ${$MenuUnit_hash_ref}{Banner}, ); $cnt=0; foreach my $text (@spl) { my $num=$splice[$cnt]; $cnt++; if (exists $picks{$text}) { $chosen{'Item_'.$cnt}= { Text => $text,Default => '*',__NUM__=>$num }; } else { $chosen{'Item_'.$cnt}= { Text => $text,__NUM__=>$num }; } $chosen{'Item_'.$cnt}{Result}=$result{$text} if exists $result{$text}; $chosen{'Item_'.$cnt}{Convey}=$convey{$text} if exists $convey{$text}; $chosen{'Item_'.$cnt}{Filter}=1; } my $chose_n=\%chosen; $LookUpMenuName{$chose_n} =${$chose_n}{'Label'}; %{${$SavePick}{$MenuUnit_hash_ref}}=%picks; ${$SaveLast}{$MenuUnit_hash_ref}=$numbor; eval { ($menu_output,$FullMenu,$Selected,$Conveyed,$SavePick, $SaveLast,$SaveNext)=&Menu($chose_n,$convey, $recurse_level,$FullMenu, $Selected,$Conveyed,$SavePick, $SaveLast,$SaveNext,$MenuUnit_hash_ref, $no_wantarray); }; die $@ if $@; chomp($menu_output) if !(ref $menu_output); if ($menu_output eq '-') { %picks=%{${$SavePick}{$MenuUnit_hash_ref}}; } elsif ($menu_output eq '+') { %picks=%{${$SavePick}{$MenuUnit_hash_ref}}; } elsif ($menu_output eq 'DONE_SUB') { return 'DONE_SUB'; } elsif ($menu_output eq 'DONE') { if (1==$recurse_level) { my $subfile=substr($sub_module,0,-3).'::'; foreach my $sub (&get_subs_from_menu($Selected)) { $sub=unpack('x1 a*',$sub); eval { unless (defined eval "$subfile$sub") { if ($@) { my $die="The \"Result =>\" Setting" ."\n\t\t-> " . ${$FullMenu}{$_[0]} [2]{${$_[1]}[$_[2]-1]} ."\n\t\tFound in the Menu Unit -> " ."${$LookUpMenuName}{$_[0]}\n\t\t" ."Specifies a Subroutine\," ." $result that Does NOT Exist" ."\n\t\tin the User Subroutines " ."File $sub_module\n"; #&Net::FullAuto::FA_lib::handle_error( # $die,'-1'); #&Net::FullAuto::FA_lib::handle_error($@) # if $fullauto; die $die; } #### TEST FOR UNDEF SUB - ADD MORE ERROR INFO } }; if ($@) { if (unpack('a11',$@) eq 'FATAL ERROR') { #if (wantarray && !$no_wantarray) { # return '', $@; #} elsif ($fullauto) { # &Net::FullAuto::FA_lib::handle_error($@,'-10'); #} else { die $@ } die $@; } else { my $die="\n FATAL ERROR! - The Local " ."System $local_hostname Conveyed\n" ." the Following " ."Unrecoverable Error Condition :\n\n" ." $@"; if (defined $log_handle && -1; } elsif (grep { /\+|\*/ } values %picks) { delete ${$SaveLast}{$MenuUnit_hash_ref}; return '+', $FullMenu,$Selected,$Conveyed, $SavePick,$SaveLast,$SaveNext, $parent_menu; } else { delete ${$SaveLast}{$MenuUnit_hash_ref}; return '-', $FullMenu,$Selected,$Conveyed, $SavePick,$SaveLast,$SaveNext, $parent_menu; } last; } elsif ($numbor=~/^\>/ && exists ${$SaveNext}{$MenuUnit_hash_ref}) { if (exists ${$FullMenu}{$MenuUnit_hash_ref}[3] {$pickone[${$SaveLast}{ $MenuUnit_hash_ref}-1]}) { $convey=${${$FullMenu}{$MenuUnit_hash_ref}[3] {$pickone[${$SaveLast}{ $MenuUnit_hash_ref}-1]}}[0]; } else { $convey=$pickone[${$SaveLast}{ $MenuUnit_hash_ref}-1] } eval { ($menu_output,$FullMenu,$Selected,$Conveyed,$SavePick, $SaveLast,$SaveNext,$ignore1,$ignore2,$ignore3,$die_err) =&Menu(${$FullMenu} {$MenuUnit_hash_ref}[2] {$pickone[${$SaveLast}{ $MenuUnit_hash_ref}-1]},$convey, $recurse_level,$FullMenu, $Selected,$Conveyed,$SavePick, $SaveLast,$SaveNext,$MenuUnit_hash_ref, $no_wantarray); }; die $@ if $@; chomp($menu_output) if !(ref $menu_output); if ($menu_output eq 'DONE_SUB') { return 'DONE_SUB'; } elsif ($menu_output eq 'DONE') { if (1==$recurse_level) { my $subfile=substr($sub_module,0,-3).'::'; foreach my $sub (&get_subs_from_menu($Selected)) { $sub=unpack('x1 a*',$sub); eval { unless (defined eval "$subfile$sub") { if ($@) { my $die="The \"Result =>\" Setting" ."\n\t\t-> " . ${$FullMenu}{$_[0]} [2]{${$_[1]}[$_[2]-1]} ."\n\t\tFound in the Menu Unit -> " ."${$LookUpMenuName}{$_[0]}\n\t\t" ."Specifies a Subroutine\," ." $result that Does NOT Exist" ."\n\t\tin the User Subroutines " ."File $sub_module\n"; #&Net::FullAuto::FA_lib::handle_error( # $die,'-1'); #&Net::FullAuto::FA_lib::handle_error($@) # if $fullauto; die $die; } #### TEST FOR UNDEF SUB - ADD MORE ERROR INFO } }; if ($@) { if (unpack('a11',$@) eq 'FATAL ERROR') { #if (wantarray && !$no_wantarray) { # return '', $@; #} elsif ($fullauto) { # &Net::FullAuto::FA_lib::handle_error($@,'-10'); #} else { die $@ } die $@; } else { my $die="\n FATAL ERROR! - The Local " ."System $local_hostname Conveyed\n" ." the Following " ."Unrecoverable Error Condition :\n\n" ." $@"; if (defined $log_handle && -1;%pn=(); #print "ALLLLL=${$FullMenu}{$MenuUnit_hash_ref}[2]{$pickone[$numbor-1]}<==\n"; my $callertest=__PACKAGE__."::Menu"; if (wantarray && !$no_wantarray && (exists ${$MenuUnit_hash_ref}{Select} && ${$MenuUnit_hash_ref}{Select} eq 'Many')) { #print "WHAT IS PNXXXX=$pn and THIS=$picks{$picknum-1} and keys=",(join "\n",keys %{${$SavePick}{$parent_menu}})," and $numbor and SUMMENU=$sum_menu<==\n";; if (exists $picks{$numbor}) { #print "ARE WE HERE??? and ${$SavePick}{$parent_menu}{$numbor}<==\n"; if ($picks{$numbor} eq '*') { delete $picks{$numbor}; delete $items{$numbor}; delete ${$Selected}{$MenuUnit_hash_ref}{$numbor}; delete ${$SavePick}{$parent_menu}{$numbor} if $sum_menu || $filtered_menu; #print "WHAT IS PNXXXX=$pn and THIS=$picks{$picknum-1} and keys=",(join "\n",keys %{${$SavePick}{$parent_menu}})," and NUMBOR=$numbor and SUMMENU=$sum_menu<==\n";; } else { &delete_Selected($MenuUnit_hash_ref,$numbor, $Selected,$SavePick,$SaveNext); $SaveNext=$SaveLast; delete $picks{$numbor}; delete $items{$numbor}; } } elsif (($sum_menu || $filtered_menu) && (exists ${$SavePick}{$parent_menu}{$numbor})) { delete ${$Selected}{$MenuUnit_hash_ref}{$numbor}; delete $picks{$numbor}; delete $items{$numbor}; delete ${$SaveNext}{$MenuUnit_hash_ref}; delete ${$SavePick}{$parent_menu}{$numbor}; } else { $items{$numbor}=${$FullMenu}{$MenuUnit_hash_ref} [4]{$pickone[$numbor-1]}; ${$SavePick}{$parent_menu}{$numbor}='*' if $sum_menu || $filtered_menu; my $skip=0; foreach my $key (keys %picks) { if ($picks{$key} ne '-' && (grep { $items{$numbor} eq $_ } @{$negate{$key}})) { my $warn="\n WARNING! You Cannot Select "; $warn.="Line $numbor while Line $key is Selected!\n"; print "$warn";; $skip=1; } elsif ($picks{$key} eq '-') { delete ${$Selected}{$MenuUnit_hash_ref}{$key}; delete $picks{$key}; delete ${$SaveNext}{$MenuUnit_hash_ref}; } } if ($skip==0) { $picks{$numbor}='*'; $negate{$numbor}= ${${$FullMenu}{$MenuUnit_hash_ref}[1]} {$pickone[$picknum-1]}; %{${$SavePick}{$MenuUnit_hash_ref}}=%picks; ${$SaveLast}{$MenuUnit_hash_ref}=$numbor; } } if ($prev_menu && $prev_menu!=$numbor) { &delete_Selected($MenuUnit_hash_ref,$prev_menu, $Selected,$SavePick,$SaveNext); delete $picks{$prev_menu}; delete $items{$prev_menu}; } } elsif (ref ${$FullMenu}{$MenuUnit_hash_ref}[2] {$pickone[$numbor-1]} eq 'HASH') { if (exists ${$FullMenu}{$MenuUnit_hash_ref}[2] {$pickone[$numbor-1]}{'Label'}) { chomp($numbor); if (exists $picks{$numbor}) { ${$FullMenu}{$MenuUnit_hash_ref}[5]='ERASE'; $hidedefaults=0; $SaveNext=$SaveLast; if ($picks{$numbor} eq '*') { delete $picks{$numbor}; delete $items{$numbor}; delete ${$Selected}{$MenuUnit_hash_ref}{$numbor}; } elsif ($picks{$numbor} ne ' ') { &delete_Selected($MenuUnit_hash_ref,$numbor, $Selected,$SavePick,$SaveNext); delete $picks{$numbor}; delete $items{$numbor}; } } if ($prev_menu && $prev_menu!=$numbor) { ${$FullMenu}{$MenuUnit_hash_ref}[5]='ERASE'; $hidedefaults=0; $SaveNext=$SaveLast; &delete_Selected($MenuUnit_hash_ref,$prev_menu, $Selected,$SavePick,$SaveNext); delete $picks{$prev_menu}; delete $items{$prev_menu}; } ($FullMenu,$Conveyed,$SaveNext,$Selected, $convey,$parent_menu) =$get_result->($MenuUnit_hash_ref, \@pickone,$numbor,$picks_from_parent, $FullMenu,$Conveyed,$Selected, $SaveNext,$parent_menu,$menu_cfg_file, $Convey_contents); $picks{$numbor}='*'; %{${$SavePick}{$MenuUnit_hash_ref}}=%picks; ${$SaveLast}{$MenuUnit_hash_ref}=$numbor; eval { ($menu_output,$FullMenu,$Selected,$Conveyed,$SavePick, $SaveLast,$SaveNext,$parent_menu)=&Menu(${$FullMenu} {$MenuUnit_hash_ref}[2] {$pickone[$numbor-1]},$convey, $recurse_level,$FullMenu, $Selected,$Conveyed,$SavePick, $SaveLast,$SaveNext,$MenuUnit_hash_ref, $no_wantarray); }; die $@ if $@; chomp($menu_output) if !(ref $menu_output); if ($menu_output eq '-') { $return_from_child_menu='-'; } elsif ($menu_output eq '+') { $return_from_child_menu='+'; } elsif ($menu_output eq 'DONE_SUB') { return 'DONE_SUB'; } elsif ($menu_output eq 'DONE' and 1<$recurse_level) { return 'DONE'; } elsif ($menu_output) { return $menu_output; } else { my $subfile=substr($sub_module,0,-3).'::'; foreach my $sub (&get_subs_from_menu($Selected)) { $sub=unpack('x1 a*',$sub); eval { unless (defined eval "$subfile$sub") { if ($@) { my $die="The \"Result =>\" Setting" ."\n\t\t-> " . ${$FullMenu}{$_[0]} [2]{${$_[1]}[$_[2]-1]} ."\n\t\tFound in the Menu Unit -> " ."${$LookUpMenuName}{$_[0]}\n\t\t" ."Specifies a Subroutine\," ." $result that Does NOT Exist" ."\n\t\tin the User Subroutines " ."File $sub_module\n"; #&Net::FullAuto::FA_lib::handle_error( # $die,'-1'); #&Net::FullAuto::FA_lib::handle_error($@) # if $fullauto; die $die; } #### TEST FOR UNDEF SUB - ADD MORE ERROR INFO } }; if ($@) { if (unpack('a11',$@) eq 'FATAL ERROR') { #if (wantarray && !$no_wantarray) { # return '',$@; #} elsif ($fullauto) { # &Net::FullAuto::FA_lib::handle_error($@,'-10'); #} else { die $die } die $@; } else { my $die="\n FATAL ERROR! - The Local " ."System $local_hostname Conveyed\n" ." the Following " ."Unrecoverable Error Condition :\n\n" ." $@"; if (defined $log_handle && -1\" Setting". "\n\t\tFound in the Menu Unit -> ". "${$MenuUnit_hash_ref}{'Label'}\n\t\tis a ". "HASH reference to a Menu Unit\,\n\t\t". "that does NOT EXIST or is NOT EXPORTED". "\n\n\tHint: Make sure the Names of all". "\n\t Menu Hash Blocks in the\n\t". " $menu_cfg_file file are\n\t". " listed in the \@EXPORT list\n\t". " found at the beginning of\n\t". " the $menu_cfg_file file\n\n\t". "our \@EXPORT = qw( %Menu_1 %Menu_2 ... )\;\n"; die $die; } } elsif ($FullMenu && $caller eq $callertest && (exists ${$MenuUnit_hash_ref}{Select} && ${$MenuUnit_hash_ref}{Select} eq 'Many')) { chomp($numbor); if (exists $picks{$numbor}) { if ($picks{$numbor} eq '*') { delete $picks{$numbor}; delete $items{$numbor}; delete ${$Selected}{$MenuUnit_hash_ref}{$numbor}; } else { &delete_Selected($MenuUnit_hash_ref,$numbor, $Selected,$SavePick,$SaveNext); $SaveNext=$SaveLast; delete $picks{$numbor}; delete $items{$numbor}; } last; } if (keys %{${$FullMenu}{$MenuUnit_hash_ref}[2]}) { if (substr(${$FullMenu}{$MenuUnit_hash_ref} [2]{$pickone[$numbor-1]},0,1) ne '&') { my $die="The \"Result =>\" Setting"; $die.="\n\t\t-> " . ${$FullMenu}{$MenuUnit_hash_ref} [2]{$pickone[$numbor-1]}; $die.="\n\t\tFound in the Menu Unit -> "; $die.="$MenuUnit_hash_ref\n\t\tis not a Menu Unit\,"; $die.=" and Because it Does Not Have\n\t\tan \"&\" as"; $die.=" the Lead Character, $0\n\t\tCannot Determine "; $die.="if it is a Valid SubRoutine.\n\n"; #&Net::FullAuto::FA_lib::handle_error($die) if $fullauto; die $die; } if (${$FullMenu}{$MenuUnit_hash_ref}[2] {$pickone[$numbor-1]}) { } ($FullMenu,$Conveyed,$SaveNext,$Selected,$convey,$parent_menu) =$get_result->($MenuUnit_hash_ref, \@pickone,$numbor,$picks_from_parent, $FullMenu,$Conveyed,$Selected, $SaveNext,$parent_menu,$menu_cfg_file, $Convey_contents); ${$SaveLast}{$MenuUnit_hash_ref}=$numbor; my %pick=(); $pick{$numbor}='*'; %{${$SavePick}{$MenuUnit_hash_ref}}=%pick; my $subfile=substr($sub_module,0,-3).'::'; foreach my $sub (&get_subs_from_menu($Selected)) { $sub=unpack('x1 a*',$sub); eval { unless (defined eval "$subfile$sub") { if ($@) { my $die="The \"Result =>\" Setting" ."\n\t\t-> " . ${$FullMenu}{$_[0]} [2]{${$_[1]}[$_[2]-1]} ."\n\t\tFound in the Menu Unit -> " ."${$LookUpMenuName}{$_[0]}\n\t\t" ."Specifies a Subroutine\," ." $result that Does NOT Exist" ."\n\t\tin the User Subroutines " ."File $sub_module\n"; #&Net::FullAuto::FA_lib::handle_error( # $die,'-1'); #&Net::FullAuto::FA_lib::handle_error($@) # if $fullauto; die $die; } #### TEST FOR UNDEF SUB - ADD MORE ERROR INFO } }; if ($@) { if (unpack('a11',$@) eq 'FATAL ERROR') { #if (wantarray && !$no_wantarray) { # return '',$@; #} elsif ($fullauto) { # &Net::FullAuto::FA_lib::handle_error($@,'-10'); #} else { die $die } die $@; } else { my $die="\n FATAL ERROR! - The Local " ."System $local_hostname Conveyed\n" ." the Following " ."Unrecoverable Error Condition :\n\n" ." $@"; if (wantarray && !$no_wantarray) { return '',$die; #} elsif ($fullauto) { # &Net::FullAuto::FA_lib::handle_error($die,'-28'); } else { die $die } } } } } else { $done=1;last } return 'DONE_SUB'; } elsif (keys %{${$FullMenu}{$MenuUnit_hash_ref}[2]}) { if (substr(${$FullMenu}{$MenuUnit_hash_ref} [2]{$pickone[$numbor-1]},0,1) ne '&') { my $die="The \"Result =>\" Setting"; $die.="\n\t\t-> " . ${$FullMenu}{$MenuUnit_hash_ref} [2]{$pickone[$numbor-1]}; $die.="\n\t\tFound in the Menu Unit -> "; $die.="$MenuUnit_hash_ref\n\t\tis not a Menu Unit\,"; $die.=" and Because it Does Not Have\n\t\tan \"&\" as"; $die.=" the Lead Character, $0\n\t\tCannot Determine "; $die.="if it is a Valid SubRoutine.\n\n"; #if (defined $log_handle && # -1($MenuUnit_hash_ref, \@pickone,$numbor,$picks_from_parent, $FullMenu,$Conveyed,$Selected, $SaveNext,$parent_menu,$menu_cfg_file, $Convey_contents); ${$SaveLast}{$MenuUnit_hash_ref}=$numbor; my %pick=(); $pick{$numbor}='*'; %{${$SavePick}{$MenuUnit_hash_ref}}=%pick; my $subfile=substr($sub_module,0,-3).'::'; foreach my $sub (&get_subs_from_menu($Selected)) { $sub=unpack('x1 a*',$sub); eval { unless (defined eval "$subfile$sub") { if ($@) { $die="FATAL ERROR! - " ."The \"Result =>\" Setting" ."\n\t\t-> " . ${$FullMenu} {$MenuUnit_hash_ref}[2] {$pickone[$numbor-1]} ."\n\t\tFound in the Menu Unit -> " .${$LookUpMenuName}{$MenuUnit_hash_ref} ."\n\t\tSpecifies a Subroutine\," ." $result that Does NOT Exist" ."\n\t\tin the User Subroutines " ."File $sub_module\n"; #return $die; #&Net::FullAuto::FA_lib::handle_error( # $die,'-1'); #} #&Net::FullAuto::FA_lib::handle_error($@) # if $fullauto; die $die; } #### TEST FOR UNDEF SUB - ADD MORE ERROR INFO } }; if ($@) { if (unpack('a11',$@) eq 'FATAL ERROR') { die $die; } else { my $die="\n FATAL ERROR! - The Local " ."System $local_hostname Conveyed\n" ." the Following " ."Unrecoverable Error Condition :\n\n" ." $@"; if (defined $log_handle && -1 Term::Menus.ps =head1 NAME Term::Menus - Create Powerful Terminal, Console and CMD Enviroment Menus =head1 SYNOPSIS C see METHODS section below =head1 DESCRIPTION Term::Menus allows you to create powerful Terminal, Console and CMD environment menus. Any perl script used in a Terminal, Console or CMD environment can now include a menu facility that includes sub-menus, forward and backward navigation, single or multiple selection capabilities, dynamic item creation and customized banners. All this power is simple to implement with a straight forward and very intuitive configuration hash structure that mirrors the actual menu architechture needed by the application. A separate configuration file is optional. Term::Menus is cross platform compatible. Term::Menus is a stand-alone - other CPAN modules are not needed for its implementation ( so it's *easy* to install! ;-) ) Term::Menus was initially conceived and designed to work seemlessly with the soon-to-be-released perl based Network Process Automation Utility Moduel called Net::FullAuto - however, it is not itself dependant on other Net::FullAuto components, and will work with *any* perl script/application. Reasons to use this module are: =over 2 =item * You have a list (or array) of items, and wish to present the user a simple CMD enviroment menu to pick a single item and return that item as a scalar (or simple string). Example: use Term::Menus; my @list=('First Item','Second Item','Third Item'); my $banner=" Please Pick an Item:"; my $selection=&pick(\@list,$banner); print "SELECTION = $selection\n"; The user sees ==> Please Pick an Item: 1. First Item 2. Second Item 3. Third Item (Press "q" to quit) PLEASE ENTER A CHOICE: --< 2 >----------------------------------- The user sees ==> SELECTION = Second Item =item * You have a large list of items and need scrolling capability: use Term::Menus; my @list=`ls -1 /bin`; my $banner=" Please Pick an Item:"; my $selection=&pick(\@list,$banner); print "SELECTION = $selection\n"; The user sees ==> Please Pick an Item: 1. arch 2. ash 3. awk 4. basename 5. bash 6. cat 7. chgrp 8. chmod 9. chown 10. cp 93 Total Choices Press ENTER (or "d") to scroll downward OR "u" to scroll upward (Press "q" to quit) PLEASE ENTER A CHOICE: ---------------------------------------- Please Pick an Item: 11. cpio 12. csh 13. cut 14. date 15. dd 16. df 17. echo 18. ed 19. egrep 20. env 93 Total Choices Press ENTER (or "d") to scroll downward OR "u" to scroll upward (Press "q" to quit) PLEASE ENTER A CHOICE: --< 14 >----------------------------------- The user sees ==> SELECTION = date =item * You need to select multiple items and return the selected list: use Term::Menus; my @list=`ls -1 /bin`; my %Menu_1=( Item_1 => { Text => "/bin Utility - ]Convey[", Convey => [ `ls -1 /bin` ], }, Select => 'Many', Banner => "\n Choose a /bin Utility :" ); my @selections=&Menu(\%Menu_1); print "SELECTIONS = @selections\n"; The user sees ==> Choose a /bin Utility : 1. /bin Utility - arch 2. /bin Utility - ash 3. /bin Utility - awk 4. /bin Utility - basename 5. /bin Utility - bash 6. /bin Utility - cat 7. /bin Utility - chgrp 8. /bin Utility - chmod 9. /bin Utility - chown 10. /bin Utility - cp a. Select All. c. Clear All. f. Finish. 93 Total Choices Press ENTER (or "d") to scroll downward OR "u" to scroll upward (Press "q" to quit) PLEASE ENTER A CHOICE: --< 3 >----------------------------------- --< 7 >----------------------------------- The user sees ==> Choose a /bin Utility : 1. /bin Utility - arch 2. /bin Utility - ash * 3. /bin Utility - awk 4. /bin Utility - basename 5. /bin Utility - bash 6. /bin Utility - cat * 7. /bin Utility - chgrp 8. /bin Utility - chmod 9. /bin Utility - chown 10. /bin Utility - cp a. Select All. c. Clear All. f. Finish. 93 Total Choices Press ENTER (or "d") to scroll downward OR "u" to scroll upward (Press "q" to quit) PLEASE ENTER A CHOICE: --< f >----------------------------------- The user sees ==> SELECTIONS = /bin Utility - awk /bin Utility - chgrp =item * You need sub-menus: use Term::Menus; my %Menu_2=( Label => 'Menu_2', Item_1 => { Text => "]Previous[ is a ]Convey[ Utility", Convey => [ 'Good','Bad' ] }, Select => 'One', Banner => "\n Choose an Answer :" ); my %Menu_1=( Label => 'Menu_1', Item_1 => { Text => "/bin/Utility - ]Convey[", Convey => [ `ls -1 /bin` ], Result => \%Menu_2, }, Select => 'One', Banner => "\n Choose a /bin Utility :" ); my @selections=&Menu(\%Menu_1); print "SELECTIONS=@selections\n"; The user sees ==> Choose a /bin Utility : 1. /bin Utility - arch 2. /bin Utility - ash 3. /bin Utility - awk 4. /bin Utility - basename 5. /bin Utility - bash 6. /bin Utility - cat 7. /bin Utility - chgrp 8. /bin Utility - chmod 9. /bin Utility - chown 10. /bin Utility - cp a. Select All. c. Clear All. f. Finish. 93 Total Choices Press ENTER (or "d") to scroll downward OR "u" to scroll upward (Press "q" to quit) PLEASE ENTER A CHOICE: --< 5 >----------------------------------- Choose an Answer : 1. bash is a Good Utility 2. bash is a Bad Utility (Press "q" to quit) PLEASE ENTER A CHOICE: --< 1 >----------------------------------- The user sees ==> SELECTIONS = bash is a Good Utility =item * You want to use a perl subroutine to create the text items or banner: (Note: READ THE COMMENTS embedded in the Menu_2 sample following. The syntax is a bit tricky and MUST be created exactly as described - otherwise it will NOT work!) package current_package_name; # Qualify subroutine calls with # &main:: if not using # a package architechture use Term::Menus; sub create_items { my $previous=shift; my @textlines=(); push @textlines, "$previous is a Good Utility"; push @textlines, "$previous is a Bad Utility"; return @testlines; ## return value must NOT be an array ## not an array reference } sub create_banner { my $previous=shift; return "\n Choose an Answer for $previous :" ## return value MUST be a string for banner } my %Menu_2=( Label => 'Menu_2', Item_1 => { Text => "]Convey[", Convey => "¤t_package_name::create_items(\"]Previous[\")", # IMPORTANT! '&' *must* be used to denote subroutine # as the first character # ¤t_package_name:: qualifier or &main:: # quaifiler MUST be used - otherwise # Term::Menus cannot locate it # embedded quote characters must be escaped # enclosing double quotes MUST be used - this is # a STRING being passed to Term::Menus that will # then be internally eval-ed during runtime # after the macro ]Previous[ is substituted # other macros and values can be passed as # arguments as follows: # (\"]Previous[\",\"AnyString\") }, Select => 'One', Banner => "¤t_package_name::create_banner(\"]Previous[\")", ## or "&main::create_banner(\"]Previous[\")", ## if using in top level script (file does NOT ## have .pm extension) ); my %Menu_1=( Label => 'Menu_1', Item_1 => { Text => "/bin/Utility - ]Convey[", Convey => [ `ls -1 /bin` ], Result => \%Menu_2, }, Select => 'One', Banner => "\n Choose a /bin Utility :" ); my @selections=&Menu(\%Menu_1); print "SELECTIONS=@selections\n"; The user sees ==> Choose a /bin Utility : 1. /bin Utility - arch 2. /bin Utility - ash 3. /bin Utility - awk 4. /bin Utility - basename 5. /bin Utility - bash 6. /bin Utility - cat 7. /bin Utility - chgrp 8. /bin Utility - chmod 9. /bin Utility - chown 10. /bin Utility - cp a. Select All. c. Clear All. f. Finish. 93 Total Choices Press ENTER (or "d") to scroll downward OR "u" to scroll upward (Press "q" to quit) PLEASE ENTER A CHOICE: --< 5 >----------------------------------- Choose an Answer for bash : 1. bash is a Good Utility 2. bash is a Bad Utility (Press "q" to quit) PLEASE ENTER A CHOICE: --< 1 >----------------------------------- The user sees ==> SELECTIONS = bash is a Good Utility =back More examples are in the B section below. Usage questions should be directed to the Usenet newsgroup comp.lang.perl.modules. Contact me, Brian Kelly , if you find any bugs or have suggestions for improvements. =head2 What To Know Before Using =over 2 =item * There are two methods available with Term::Menus - &pick() and &Menu(). C<&Menu()> uses C<&pick()> - you can get the same results using only C<&Menu()>. However, if you need to simply pick one item from a single list - use C<&pick()>. The syntax is simpler, and you'll write less code. ;-) =item * You'll need to be running at least Perl version 5.002 to use this module. This module does not require any libraries that don't already come with a standard Perl distribution. =back =head1 METHODS =over 4 =item B - create a simple menu $pick = &pick ($list|\@list|['list',...],[$Banner]); Where I<$list> is a variable containing a array or list reference. This argument can also be a escaped array (sending a reference) or an anonymous array (which also sends a reference). I<$Banner> is an optional argument sending a customized Banner to top the simple menu - giving instructions, descriptions, etc. The default is "Please Pick an Item:" =item B - create a complex Menu $pick = &Menu ($list|\@list|['list',...],[$Banner]); Where I<$pick> is a variable containing a array or list reference of the pick or picks. @picks = &Menu ($Menu_1|\%Menu_1|{ Label => 'Menu_1' }); Where I<$Menu_1> is a hash reference to the top level Menu Configuration Hash Structure. =back =head2 Menu Configuration Hash Structures =over 4 These are the building blocks of the overall Menu architecture. Each hash structure represents a I. A single menu layer, has only one hash structure defining it. A menu with a single sub-menu will have two hash structures. The menus connect via the C element of an I - C - hash structure in parent menu C<%Menu_1>: my %Menu_2=( Label => 'Menu_2', Item_1 => { Text => "]Previous[ is a ]Convey[ Utility", Convey => [ 'Good','Bad' ] }, Select => 'One', Banner => "\n Choose an Answer :" ); my %Menu_1=( Label => 'Menu_1', Item_1 => { Text => "/bin/Utility - ]Convey[", Convey => [ `ls -1 /bin` ], Result => \%Menu_2, }, Select => 'One', Banner => "\n Choose a /bin Utility :" ); =back =head3 Menu Component Elements Each Menu Configuration Hash Structure consists of elements that define and control it's behavior, appearance, constitution and purpose. An element's syntax is as you would expect it to be in perl - a key string pointing to an assocaited value: C value>. The following items list supported key names and ther associated value types: =over 4 =item B => 'Integer' =item =over 2 =item The I key is an I key that determines the number of Menu Items that will be displayed on each screen. This is useful when the items are multi-lined, or the screen size is bigger or smaller than the default number utilizes in the most practical fashion. The default number is 10. Display => 15, =back =item B