view release on metacpan or  search on metacpan

lib/Term/Menus.pm  view on Meta::CPAN

   %email_addresses=%fa_code::email_addresses;
}
our $passwd_file_loc='';
if (defined $fa_code::passwd_file_loc && $fa_code::passwd_file_loc) {
   $passwd_file_loc=$fa_code::passwd_file_loc;
}
our $test=0;
if (defined $fa_code::test && $fa_code::test) {
   $test=$fa_code::test;
}
our $timeout=30;
if (defined $fa_code::timeout && $fa_code::timeout) {
   $timeout=$fa_code::timeout;
}
our $log=0;
if (defined $fa_code::log && $fa_code::log) {
   $log=$fa_code::log;
}
our $tosspass=0;
if (defined $fa_code::tosspass && $fa_code::tosspass) {
   $tosspass=$fa_code::tosspass;
}

##  End  Net::FullAuto  Settings

##############################################################
##############################################################

##  Begin  Term::Menus

our $termwidth=0;
our $termheight=0;
our $padwalker=0;
our $term_input=0;
eval { require Term::ReadKey };
unless ($@) {
   import Term::ReadKey;
   ($termwidth,$termheight)=eval {
      no strict 'subs';
      my ($termwidth,$termheight)=('','');
      my ($stdout_capture,$stderr_capture)=
         Capture::Tiny::capture {
            ($termwidth, $termheight) =
               Term::ReadKey::GetTerminalSize();
            $termwidth||='';$termheight||='';
      }; return $termwidth,$termheight;
   };
   if ($@) {
      $termwidth='';$termheight='';
   }
} else {
   $termwidth='';$termheight='';
}
if ($termwidth) {
   eval { require Term::RawInput };
   unless ($@) {
      $term_input=1;
      import Term::RawInput;
   }
}
eval { require PadWalker };
unless ($@) {
   $padwalker=1;
   import PadWalker;
}
eval { require Devel::Symdump };
unless ($@) {
   #$devel_symdump=1;
   import Devel::Symdump;
}
our $clearpath='';
if ($^O ne 'MSWin32' && $^O ne 'MSWin64') {
   if (-e '/usr/bin/clear') {
      $clearpath='/usr/bin/';
   } elsif (-e '/bin/clear') {
      $clearpath='/bin/';
   } elsif (-e '/usr/local/bin/clear') {
      $clearpath='/usr/local/bin/';
   }
}

our %LookUpMenuName=();
our $MenuMap=[];

our $noclear=1; # set to one to turn off clear for debugging

sub check_for_dupe_menus {

   my $m_flag=0;
   my $s_flag=0;
   foreach my $dir (@INC) {
      if (!$m_flag && -f "$dir/$Term::Menus::fa_menu") {
         $m_flag=1;
         open(FH,"<$dir/$Term::Menus::fa_menu");
         my $line='';my %menudups=();
         while ($line=<FH>) {
            if ($line=~/^[ \t]*\%(.*)\s*=/) {
               if (!exists $menudups{$1}) {
                  $menudups{$1}='';
               } else {
                  my $mcmf=$Term::Menus::fa_menu;my $die='';
                  $die="\n       FATAL ERROR! - Duplicate Hash Blocks:"
                      ."\n              ->  \"%$1\" is defined more than once\n"
                      ."              in the $dir/$mcmf file.\n\n"
                      ."       Hint:  delete or comment-out all duplicates\n\n";
                  if ($Term::Menus::fullauto) {
                     print $die if !$Net::FullAuto::FA_Core::cron;
                     &Net::FullAuto::FA_Core::handle_error($die,'__cleanup__');
                  } else { die $die }
               }
            }
         }
      }
      if (!$s_flag && -f "$dir/$Term::Menus::fa_code") {
         $s_flag=1;
         open(FH,"<$dir/$Term::Menus::fa_code");
         my $line='';my %dups=();
         while ($line=<FH>) {
            if ($line=~/^[ \t]*\%(.*)\s*=/) {
               if (!exists $dups{$1}) {
                  $dups{$1}='';
               } else {
                  my $die="\n       FATAL ERROR! - Duplicate Hash Blocks:"
                         ."\n              ->  \"%$1\" is defined more "

lib/Term/Menus.pm  view on Meta::CPAN

         if (1==$recurse && ref $pick->[$#{$pick}] eq 'HASH') {
            $topmenu=pop @{$pick};
            $savpick=pop @{$pick};
         }
         if (wantarray && 1==$recurse) {
            my @choyce=@{$pick};undef @{$pick};undef $pick;
            return @choyce
         } elsif (ref $pick eq 'ARRAY' && -1<$#{$pick} &&
               $pick->[0]=~/^[{](.*)[}][<]$/) {
            return $pick,$FullMenu,$Selected,$Conveyed,
                       $SavePick,$SaveMMap,$SaveNext,$Persists;
         } elsif (!$picks_from_parent &&
               !(keys %{$MenuUnit_hash_ref->{Select}})) {
            if (ref $topmenu eq 'HASH' && (keys %{$topmenu->{Select}} &&
                  $topmenu->{Select} eq 'Many') || (ref $savpick eq 'HASH' &&
                  exists $topmenu->{Select}->{(keys %{$savpick})[0]})) {
               if (wantarray) {
                  return @{$pick}
               } else {
                  return $pick; 
               }
            } elsif (-1==$#{$pick} &&
                  (ref $topmenu eq 'HASH') &&
                  (grep { /Item_/ } keys %{$topmenu})) {
               return [ $topmenu ];
            } elsif (0==$#{$pick}) {
               return $pick->[0];
            } else {
               return $pick;
            }
         } else {
            if ($picks_from_parent) {
               $pick->[0]=&transform_pmsi($pick->[0],
                  $Conveyed,$SaveMMap,$picks_from_parent);
            }
            return $pick
         }
      } elsif ($pick) { return $pick }
   }

}

sub pw {

   ## pw [p]ad [w]alker
   #print "PWCALLER=",caller,"\n";
   return $_[0]->{Name} if ref $_[0] eq 'HASH'
      && exists $_[0]->{Name};
   my @packages=();
   @packages=@{$_[1]} if defined $_[1] && $_[1];
   my $name='';
   unless (ref $_[0] eq 'HASH') {
      return '';
   } else {
      my $flag=1;
      my $n=0;
      WH: while (1) {
         {
            local $SIG{__DIE__}; # No sigdie handler
            eval {
               $name=PadWalker::var_name($n++,$_[0]);
            };
            if ($@) {
               undef $@;
               my $o=0;
               while (1) {
                  eval {
                     my $vars=PadWalker::peek_our($o++);
                     foreach my $key (keys %{$vars}) {
                        if (ref $vars->{$key} eq 'HASH' &&
                              %{$_[0]} eq %{$vars->{$key}}) {
                           $name=$key;
                           last;
                        } 
                     }
                  };
                  if ($@) {
                     undef $@;
                     my $s=0;
                     unshift @packages, 'main';
                     PK: foreach my $package (@packages) {
                        my $obj=Devel::Symdump->rnew($package);
                        foreach my $hash ($obj->hashes) {
                           next if $hash=~/^_</;
                           next if $hash=~/^Term::Menus::/;
                           next if $hash=~/^Config::/;
                           next if $hash=~/^DynaLoader::/;
                           next if $hash=~/^warnings::/;
                           next if $hash=~/^utf8::/;
                           next if $hash=~/^Carp::/;
                           next if $hash=~/^fields::attr/;
                           next if $hash=~/^Text::Balanced::/;
                           next if $hash=~/^Data::Dump::Streamer/;
                           next if $hash=~/^re::EXPORT_OK/;
                           next if $hash=~/^fa_code::email_addresses/;
                           next if $hash=~/^fa_code::email_defaults/;
                           next if $hash=~/^PadWalker::/;
                           next if $hash=~/^Fcntl::/;
                           next if $hash=~/^B::Utils::/;
                           next if $hash=~/^ExtUtils::/;
                           next if $hash=~/^Exporter::/;
                           next if $hash=~/^Moo::/;
                           next if $hash=~/^overload::/;
                           next if $hash=~/^Term::ReadKey::/;
                           next if $hash=~/^main::INC/;
                           next if $hash=~/^main::SIG/;
                           next if $hash=~/^main::ENV/;
                           next if $hash=~/^main[:][^\w]*$/;
                           next if $hash=~/^main::[@]$/;
                           next if $hash=~/^Net::FullAuto::FA_Core::makeplan/;
                           next if $hash=~
                              /^Net::FullAuto::FA_Core::admin_menus/;
                           my %test=eval "%$hash";
                           $name=$hash if %test eq %{$_[0]};
                           last PK if $name;
                        }
                     }
                     $name||='';
                     $name=~s/^.*::(.*)$/$1/;
                     last WH;
                  }
                  last WH if $name;
               }
            }
            last if $name;
         };
      }
      $name||='';
      $name=~s/^%//;
      return $name if $name;
   }
}

sub list_module {
   my @modules = @_;
   my @result=();
   no strict 'refs';
   foreach my $module (@modules) {
      $module=~s/\.pm$//;
      push @result,grep { defined &{"$module\::$_"} } keys %{"$module\::"};
   }
   return @result;
}

sub test_hashref {

   my $hashref_to_test=$_[0];
   if (ref $hashref_to_test eq 'HASH') {
      if (grep { /Item_/ } keys %{$hashref_to_test}) {
         return 1;
      } elsif (exists $hashref_to_test->{Input} &&
            $hashref_to_test->{Input}) {
         return 1; 
      } elsif (!grep { /Item_/ } keys %{$hashref_to_test} 
            && grep { /Banner/ } keys %{$hashref_to_test}) {
         return 1;
      } else {