Term-Menus
view release on metacpan or search on metacpan
lib/Term/Menus.pm view on Meta::CPAN
#### ###
#####################################################################
###
our $fa_conf=['Distro/fa_conf.pm', #<== Change Location Here ###
"From $INC{'Term/Menus.pm'}, Line: ".($vlin+30)]; ###
###
#####################################################################
#####################################################################
#### ###
#### DEFAULT MODULE OF Net::FullAuto $fa_host IS: ###
#### ###
#### ==> Distro/fa_host.pm <== If you want a different ###
#### ###
#### module to be the default, change $fa_host variable below or ###
#### set the $fa_hosts_config variable in the BEGIN { } block ###
#### of the top level script invoking Net::FullAuto. (Advised) ###
#### ###
#####################################################################
###
our $fa_host=['Distro/fa_host.pm', #<== Change Location Here ###
"From $INC{'Term/Menus.pm'}, Line: ".($vlin+47)]; ###
###
#####################################################################
#####################################################################
#### ###
#### DEFAULT MODULE OF Net::FullAuto $fa_menu IS: ###
#### ###
#### ==> Distro/fa_menu_demo.pm <== If you want a different ###
#### ###
#### module to be the default, change $fa_menu variable below or ###
#### set the $fa_menu variable in the BEGIN { } block ###
#### of the top level script invoking Net::FullAuto. (Advised) ###
#### ###
#####################################################################
###
our $fa_menu=['Distro/fa_menu_demo.pm', #<== Change Location Here ###
"From $INC{'Term/Menus.pm'}, Line ".($vlin+81)]; ###
###
#####################################################################
our $fullauto=0;$new_user_flag=1;
if (defined caller(2) && -1<index caller(2),'FullAuto') {
$fullauto=1;
my $default_modules='';
unless ($main::fa_code && $main::fa_conf && $main::fa_host
&& $main::fa_menu) {
unless (exists $INC{'Net/FullAuto.pm'}) {
foreach my $fpath (@INC) {
my $f=$fpath;
if (-e $f.'/Net/FullAuto.pm') {
$INC{'Net/FullAuto.pm'}=$f.'/Net/FullAuto.pm';
last;
}
}
}
my $fa_path=$INC{'Net/FullAuto.pm'};
my $progname=substr($0,(rindex $0,'/')+1,-3);
substr($fa_path,-3)='';
my $username=getlogin || getpwuid($<);
if (-f $fa_path.'/fa_global.pm') {
if (-r $fa_path.'/fa_global.pm') {
{
no strict 'subs';
require $fa_path.'/fa_global.pm';
$fa_global::berkeley_db_path||='';
$fa_global::FA_Sudo||={};
if (exists $fa_global::FA_Sudo->{$username}) {
$username=$fa_global::FA_Sudo->{$username};
}
if ($fa_global::berkeley_db_path &&
-d $fa_global::berkeley_db_path.'Defaults') {
BEGIN { $Term::Menus::facall=caller(2);
$Term::Menus::facall||='' };
use if (-1<index $Term::Menus::facall,'FullAuto'),
"BerkeleyDB";
my $dbenv = BerkeleyDB::Env->new(
-Home => $fa_global::berkeley_db_path.'Defaults',
-Flags => DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL
) or die(
"cannot open environment for DB: ".
$BerkeleyDB::Error."\n",'','');
my $kind=(grep { /^--test$/ } @ARGV)?'test':'prod';
my $bdb = BerkeleyDB::Btree->new(
-Filename => "${progname}_${kind}_defaults.db",
-Flags => DB_CREATE,
-Env => $dbenv
);
unless ($BerkeleyDB::Error=~/Successful/) {
$bdb = BerkeleyDB::Btree->new(
-Filename => "${progname}_${kind}_defaults.db",
-Flags => DB_CREATE|DB_RECOVER_FATAL,
-Env => $dbenv
);
unless ($BerkeleyDB::Error=~/Successful/) {
die "Cannot Open DB ${progname}_${kind}_defaults.db:".
" $BerkeleyDB::Error\n";
}
}
if (exists $ENV{'SSH_CONNECTION'} &&
exists $ENV{'USER'} && ($ENV{'USER'}
ne $username)) {
$username=$ENV{'USER'};
} elsif ($username eq 'SYSTEM' &&
exists $ENV{'IWUSER'} && ($ENV{'IWUSER'}
ne $username)) {
my $login_flag=0;
foreach (@ARGV) {
my $argv=$_;
if ($login_flag) {
$username=$argv;
last;
} elsif (lc($argv) eq '--login') {
$login_flag=1;
}
}
$username=$ENV{'IWUSER'} unless $login_flag;
} elsif (grep { /--login/ } @ARGV) {
my $login_flag=0;
foreach (@ARGV) {
lib/Term/Menus.pm view on Meta::CPAN
$save_defaults_for_user_flag=1;
next;
} else { next }
}
unless ($Term::Menus::filechk->(
$default_modules->{$mod})) {
delete $default_modules->{$mod};
next;
}
$save_defaults_for_user_flag=1;
}
if ($save_defaults_for_user_flag) {
my $def_modules=Data::Dump::Streamer::Dump(
$default_modules)->Out();
my $status=$bdb->db_put(
$username,$def_modules) if $bdb;
} else {
my $status=$bdb->db_del(
$username) if $bdb;
}
}
undef $bdb;
$dbenv->close();
undef $dbenv;
unless (keys %{$default_modules}) {
$default_modules->{'set'}='none';
$default_modules->{'fa_code'}=
'Net/FullAuto/Distro/fa_code_demo.pm';
$default_modules->{'fa_conf'}=
'Net/FullAuto/Distro/fa_conf.pm';
$default_modules->{'fa_host'}=
'Net/FullAuto/Distro/fa_host.pm';
$default_modules->{'fa_menu'}=
'Net/FullAuto/Distro/fa_menu_demo.pm';
} elsif (exists $default_modules->{'set'} &&
$default_modules->{'set'} ne 'none') {
$new_user_flag=0;
my $setname=$default_modules->{'set'};
my $stenv = BerkeleyDB::Env->new(
-Home => $fa_global::berkeley_db_path.'Sets',
-Flags => DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL
) or die(
"cannot open environment for DB: ".
$BerkeleyDB::Error."\n",'','');
my $std = BerkeleyDB::Btree->new(
-Filename => "${progname}_sets.db",
-Flags => DB_CREATE,
-Env => $stenv
);
unless ($BerkeleyDB::Error=~/Successful/) {
$std = BerkeleyDB::Btree->new(
-Filename => "${progname}_sets.db",
-Flags => DB_CREATE|DB_RECOVER_FATAL,
-Env => $stenv
);
unless ($BerkeleyDB::Error=~/Successful/) {
die "Cannot Open DB ${progname}_sets.db:".
" $BerkeleyDB::Error\n";
}
}
#my $username=getlogin || getpwuid($<);
my $set='';
my $status=$std->db_get(
$username,$set);
$set||='';
$set=~s/\$HASH\d*\s*=\s*//s
if -1<index $set,'$HASH';
$set=eval $set;
$set||={};
undef $std;
$stenv->close();
undef $stenv;
$fa_code=[$set->{$setname}->{'fa_code'},
"From Default Set $setname ".
"(Change with fa --set)"];
$fa_conf=[$set->{$setname}->{'fa_conf'},
"From Default Set $setname ".
"(Change with fa --set)"];
$fa_host=[$set->{$setname}->{'fa_host'},
"From Default Set $setname ".
"(Change with fa --set)"];
$fa_menu=[$set->{$setname}->{'fa_menu'},
"From Default Set $setname ".
"(Change with fa --set)"];
} else {
$new_user_flag=0;
if (exists $default_modules->{'fa_code'}) {
$fa_code=[$default_modules->{'fa_code'},
"From Default Setting ".
"(Change with fa --defaults)"];
}
if (exists $default_modules->{'fa_conf'}) {
$fa_conf=[$default_modules->{'fa_conf'},
"From Default Setting ".
"(Change with fa --defaults)"];
}
if (exists $default_modules->{'fa_host'}) {
$fa_host=[$default_modules->{'fa_host'},
"From Default Setting ".
"(Change with fa --defaults)"];
}
if (exists $default_modules->{'fa_menu'}) {
$fa_menu=[$default_modules->{'fa_menu'},
"From Default Setting ".
"(Change with fa --defaults)"];
}
}
}
}
} else {
warn("WARNING: Cannot read defaults file $fa_path/fa_global.pm".
" - permission denied (Hint: Perhaps you need to 'Run as ".
"administrator'?)");
}
}
my @A=();my %A=();
push @A,@ARGV;
my $acnt=0;
foreach my $a (@A) {
$acnt++;
my $aa=$a;
if (-1<index $aa,'--fa_') {
my $k=unpack('x5a*',$aa);
my $v=$A[$acnt]||'';
unless (-1<index $v, '--fa_') {
$A{$k}=$v;
} else {
@A=();
last;
}
} elsif (-1<index $aa,'--set') {
my $v=$A[$acnt]||'';
unless (-1<index $v, '--') {
$A{set}=$v;
} else {
@A=();
last;
}
}
}
foreach my $e (('set','code','conf','host','maps','menu')) {
if (exists $A{$e}) {
$new_user_flag=0;
if ($e eq 'set') {
no strict 'subs';
my $setname=$A{$e};
my $fa_path=$INC{'Net/FullAuto.pm'};
my $progname=substr($0,(rindex $0,'/')+1,-3);
substr($fa_path,-3)='';
if (-f $fa_path.'/fa_global.pm') {
my $stenv = BerkeleyDB::Env->new(
-Home => $fa_global::berkeley_db_path.'Sets',
-Flags => DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL
) or die(
"cannot open environment for DB: ".
$BerkeleyDB::Error."\n",'','');
my $std = BerkeleyDB::Btree->new(
-Filename => "${progname}_sets.db",
-Flags => DB_CREATE,
-Env => $stenv
);
unless ($BerkeleyDB::Error=~/Successful/) {
$std = BerkeleyDB::Btree->new(
-Filename => "${progname}_sets.db",
-Flags => DB_CREATE|DB_RECOVER_FATAL,
-Env => $stenv
);
unless ($BerkeleyDB::Error=~/Successful/) {
die "Cannot Open DB ${progname}_sets.db:".
" $BerkeleyDB::Error\n";
}
}
#my $username=getlogin || getpwuid($<);
my $set='';
my $status=$std->db_get(
$username,$set);
$set||='';
$set=~s/\$HASH\d*\s*=\s*//s
if -1<index $set,'$HASH';
$set=eval $set;
$set||={};
undef $std;
$stenv->close();
undef $stenv;
$fa_code=[$set->{$setname}->{'fa_code'},
"From CMD arg fa --set $setname line ".__LINE__];
$fa_conf=[$set->{$setname}->{'fa_conf'},
"From CMD arg fa --set $setname line ".__LINE__];
$fa_host=[$set->{$setname}->{'fa_host'},
"From CMD arg fa --set $setname line ".__LINE__];
$fa_menu=[$set->{$setname}->{'fa_menu'},
"From CMD arg fa --set $setname line ".__LINE__];
} else {
my $die="\n FATAL ERROR: The Set indicated from".
" the CMD arg:\n\n".
" ==> fa --set $A{$e}n\n".
" does not exist. To create this\n".
" set, run fa --set without any\n".
" other arguments";
die $die;
}
} elsif ($e eq 'code') {
$fa_code=$A{$e};
$fa_code=[$fa_code,
"From CMD arg: fa --fa_code $A{$e}"];
} elsif ($e eq 'menu') {
$fa_menu=$A{$e};
$fa_menu=[$fa_menu,
"From CMD arg: fa --fa_menu $A{$e}"];
} elsif ($e eq 'host') {
$fa_host=$A{$e};
$fa_host=[$fa_host,
"From CMD arg: fa --fa_host $A{$e}"];
} elsif ($e eq 'conf') {
$fa_conf=$A{$e};
$fa_conf=[$fa_conf,
"From CMD arg: fa --fa_conf $A{$e}"];
}
}
my $abspath=abs_path($0)||'';
$abspath=~s/\.exe$//;
$abspath.='.pl';
if (defined $main::fa_code && $main::fa_code) {
$new_user_flag=0;
$fa_code=$main::fa_code;
my $p=abs_path($0)||'';
$fa_code=[$fa_code,
"From \$fa_code variable in $abspath"];
}
if (defined $main::fa_conf && $main::fa_conf) {
$new_user_flag=0;
$fa_conf=$main::fa_conf;
$fa_conf=[$fa_conf,
lib/Term/Menus.pm view on Meta::CPAN
$remainder=$num_pick % $display_this_many_items if $num_pick;
$curscreennum=($start+$remainder==$num_pick)?
$start+$remainder:$start+$choose_num;
if ($curscreennum-$remainder==
$MenuUnit_hash_ref->{Scroll}->[1] &&
$curscreennum==$num_pick) {
$start=$start-$display_this_many_items;
$FullMenu->{$MenuUnit_hash_ref}[11]=$start;
} elsif ($start==$MenuUnit_hash_ref->{Scroll}->[1]) {
if ($display_this_many_items<$num_pick-$start
|| $remainder || (!$remainder &&
(($num_pick==$start+1) ||
($num_pick==$start+$display_this_many_items)))) {
$start=$start-$display_this_many_items;
$FullMenu->{$MenuUnit_hash_ref}[11]=$start;
}
} else { next }
$numbor=$start+$choose_num+1;
$hidedefaults=0;
last;
} elsif (0<=$start-$display_this_many_items) {
$start=$start-$display_this_many_items;
$MenuUnit_hash_ref->{Scroll}->[1]=
$start+$display_this_many_items
if $ikey eq 'PAGEUP' &&
exists $MenuUnit_hash_ref->{Scroll}
&& $MenuUnit_hash_ref->{Scroll};
$FullMenu->{$MenuUnit_hash_ref}[11]=$start;
} else {
$start=$FullMenu->{$MenuUnit_hash_ref}[11]=0;
}
$numbor=$start+$choose_num+1;
$hidedefaults=0;
last;
} elsif ($ikey eq 'END') {
$FullMenu->{$MenuUnit_hash_ref}[11]=$num_pick;
$MenuUnit_hash_ref->{Scroll}->[1]=$num_pick if
$MenuUnit_hash_ref->{Scroll} &&
$MenuUnit_hash_ref->{Scroll};
$hidedefaults=0;
if ($num_pick==$start+$choose_num) {
next;
}
my $remainder=$num_pick % $choose_num;
if ($remainder) {
$start=$num_pick-$remainder;
} else {
$start=$num_pick-$display_this_many_items;
}
last;
} elsif ($ikey eq 'HOME') {
$FullMenu->{$MenuUnit_hash_ref}[11]=0;
$MenuUnit_hash_ref->{Scroll}->[1]=1 if
$MenuUnit_hash_ref->{Scroll} &&
$MenuUnit_hash_ref->{Scroll};
$hidedefaults=0;
$start=0;
last;
} elsif ($numbor && unpack('a1',$numbor) eq '!') {
# SHELLOUT shellout
my $username=getlogin || getpwuid($<);
my $cmd=unpack('x1 a*',$numbor);
print "\n";
unless ($^O eq 'cygwin') {
system("su -l -c$cmd $username");
} else {
system($cmd);
}
print "\nPress ENTER to continue";<STDIN>;
next;
} elsif (((!$ikey || $ikey eq 'ENTER') &&
($numbor=~/^()$/ || $numbor=~/^\n/)) || $numbor=~/^d$/i
|| $ikey eq 'DOWNARROW' || $ikey eq 'PAGEDOWN') {
$ikey||='ENTER';
delete $main::maintain_scroll_flag->{$MenuUnit_hash_ref}
if defined $main::maintain_scroll_flag;
if (($ikey eq 'DOWNARROW' || $numbor=~/^d$/i) &&
exists $MenuUnit_hash_ref->{Scroll}
&& $MenuUnit_hash_ref->{Scroll}) {
my $remainder=0;my $curscreennum=0;
$remainder=$num_pick % $choose_num if $num_pick;
$curscreennum=($start+$remainder==$num_pick)?
$start+$remainder:$start+$choose_num;
$MenuUnit_hash_ref->{Scroll}->[1]++
if $MenuUnit_hash_ref->{Scroll}->[1]!=$num_pick;
if ($curscreennum<$MenuUnit_hash_ref->{Scroll}->[1]) {
if ($display_this_many_items<$num_pick-$start) {
$start=$start+$display_this_many_items;
$FullMenu->{$MenuUnit_hash_ref}[11]=$start;
} else {
$start=$start+$remainder;
$FullMenu->{$MenuUnit_hash_ref}[11]=$num_pick;
}
} else { next }
$hidedefaults=0;
$numbor=$start+$choose_num+1;
last;
} elsif ($ikey eq 'ENTER' && exists $MenuUnit_hash_ref->{Scroll}
&& $MenuUnit_hash_ref->{Scroll} && !$show_banner_only) {
$numbor=$MenuUnit_hash_ref->{Scroll}->[1];
$MenuUnit_hash_ref->{Scroll}->[1]++
if $MenuUnit_hash_ref->{Scroll}->[1]!=$num_pick;
} else {
if ($show_banner_only) {
if (exists $MenuUnit_hash_ref->{Result}) {
$numbor='f';
$picks{'__FA_Banner__'}='';
my $remainder=0;
$remainder=$choose_num % $num_pick if $num_pick;
my $curscreennum=($start+$remainder==$num_pick)?
$start+$remainder:$start+$choose_num;
my $numpick=0;
if ($parent_menu and exists $parent_menu->{Scroll}) {
if (ref $parent_menu->{Scroll} eq 'ARRAY') {
$numpick=$#{[keys %{$FullMenu->{$parent_menu}[2]}]};
if ($curscreennum+$display_this_many_items
<$parent_menu->{Scroll}->[1] &&
$parent_menu->{Scroll}->[1]<$numpick) {
$FullMenu->{$parent_menu}[11]=
$parent_menu->{Scroll}->[1];
}
( run in 2.307 seconds using v1.01-cache-2.11-cpan-2398b32b56e )