our
$VERSION
=
'1.21'
;
our
$FIX
=
'1'
;
sub
brik_properties {
return
{
revision
=>
'$Revision: e86617fa210d $'
,
tags
=> [
qw(main core)
],
attributes
=> {
echo
=> [
qw(0|1)
],
help_show_base_attributes
=> [
qw(0|1)
],
help_show_base_commands
=> [
qw(0|1)
],
help_show_base_all
=> [
qw(0|1)
],
help_show_inherited_attributes
=> [
qw(0|1)
],
help_show_inherited_commands
=> [
qw(0|1)
],
help_show_inherited_all
=> [
qw(0|1)
],
help_show_all
=> [
qw(0|1)
],
comp_show_base_attributes
=> [
qw(0|1)
],
comp_show_base_commands
=> [
qw(0|1)
],
comp_show_base_all
=> [
qw(0|1)
],
comp_show_inherited_attributes
=> [
qw(0|1)
],
comp_show_inherited_commands
=> [
qw(0|1)
],
comp_show_inherited_all
=> [
qw(0|1)
],
comp_show_all
=> [
qw(0|1)
],
show_base_attributes
=> [
qw(0|1)
],
show_base_commands
=> [
qw(0|1)
],
show_base_all
=> [
qw(0|1)
],
show_inherited_attributes
=> [
qw(0|1)
],
show_inherited_commands
=> [
qw(0|1)
],
show_inherited_all
=> [
qw(0|1)
],
show_all
=> [
qw(0|1)
],
aliases_completion
=> [
qw(0|1)
],
ps1
=> [
qw(prompt)
],
},
attributes_default
=> {
echo
=> 1,
help_show_base_attributes
=> 0,
help_show_base_commands
=> 0,
help_show_base_all
=> 0,
help_show_inherited_attributes
=> 0,
help_show_inherited_commands
=> 0,
help_show_inherited_all
=> 0,
help_show_all
=> 0,
comp_show_base_attributes
=> 0,
comp_show_base_commands
=> 0,
comp_show_base_all
=> 0,
comp_show_inherited_attributes
=> 0,
comp_show_inherited_commands
=> 0,
comp_show_inherited_all
=> 0,
comp_show_all
=> 0,
show_base_attributes
=> 0,
show_base_commands
=> 0,
show_base_all
=> 0,
show_inherited_attributes
=> 0,
show_inherited_commands
=> 0,
show_inherited_all
=> 0,
show_all
=> 0,
aliases_completion
=> 0,
},
commands
=> {
splash
=> [ ],
pwd
=> [ ],
get_available_help
=> [ ],
get_help_attributes
=> [
qw(Brik)
],
get_help_commands
=> [
qw(Brik)
],
get_comp_attributes
=> [
qw(Brik)
],
get_comp_commands
=> [
qw(Brik)
],
cmd
=> [
qw(Cmd)
],
cmdloop
=> [ ],
run_use
=> [
qw(Brik)
],
run_help
=> [
qw(Brik)
],
run_set
=> [
qw(Brik Attribute Value)
],
run_get
=> [
qw(Brik)
],
run_run
=> [
qw(Brik Command)
],
run_alias
=> [
qw(alias Cmd)
],
run_cd
=> [
qw(directory)
],
run_code
=> [
qw(Code)
],
run_exit
=> [ ],
},
require_modules
=> {
'Data::Dump'
=> [
qw(dump)
],
'File::HomeDir'
=> [ ],
'Cwd'
=> [ ],
'PPI'
=> [ ],
},
};
}
sub
new {
my
$self
=
shift
->SUPER::new(
@_
);
$self
->Metabrik::new(
@_
);
$self
->brik_set_default_attributes;
my
%h
=
@_
;
for
my
$k
(
keys
%h
) {
$self
->{
$k
} =
$h
{
$k
};
}
return
$self
;
}
sub
brik_init {
my
$self
=
shift
;
$SIG
{INT} =
sub
{
$self
->debug &&
$self
->
log
->debug(
"SIGINT: captured for pid[$$] "
.
($$ ==
$self
->global->pid ?
'(main process)'
:
''
)
);
$self
->_update_prompt;
if
(
$self
->global->exit_on_sigint) {
$self
->run_exit;
}
return
1;
};
my
@path
=
split
(
':'
, (
$ENV
{PATH} ||
''
));
my
%executables
= ();
for
my
$path
(
@path
) {
my
@files
= ();
eval
{
@files
= io(
$path
)->all_files;
};
if
($@) {
chomp
($@);
$self
->debug &&
$self
->
log
->debug(
"brik_init: $path: all_files: $@"
);
next
;
};
for
my
$file
(
@files
) {
if
(
$file
->is_executable) {
my
$filename
=
$file
->filename;
$executables
{
$filename
}++;
$self
->add_handler(
"run_$filename"
);
}
}
}
$self
->{_executables} = \
%executables
;
return
$self
->SUPER::brik_init(
@_
);
}
sub
splash {
my
$self
=
shift
;
my
$con
=
$self
->context;
my
$version
=
$con
->run(
'core::global'
,
'brik_version'
);
my
$available_count
=
keys
%{
$con
->available};
my
$used_count
=
keys
%{
$con
->used};
print
<<EOF
███▄ ▄███▓▓█████▄▄▄█████▓ ▄▄▄ ▄▄▄▄ ██▀███ ██▓ ██ ▄█▀
▓██▒▀█▀ ██▒▓█ ▀▓ ██▒ ▓▒▒████▄ ▓█████▄ ▓██ ▒ ██▒▓██▒ ██▄█▒
▓██ ▓██░▒███ ▒ ▓██░ ▒░▒██ ▀█▄ ▒██▒ ▄██▓██ ░▄█ ▒▒██▒▓███▄░
▒██ ▒██ ▒▓█ ▄░ ▓██▓ ░ ░██▄▄▄▄██ ▒██░█▀ ▒██▀▀█▄ ░██░▓██ █▄
▒██▒ ░██▒░▒████▒ ▒██▒ ░ ▓█ ▓██▒░▓█ ▀█▓░██▓ ▒██▒░██░▒██▒ █▄
░ ▒░ ░ ░░░ ▒░ ░ ▒ ░░ ▒▒ ▓▒█░░▒▓███▀▒░ ▒▓ ░▒▓░░▓ ▒ ▒▒ ▓▒
░ ░ ░ ░ ░ ░ ░ ▒ ▒▒ ░▒░▒ ░ ░▒ ░ ▒░ ▒ ░░ ░▒ ▒░
░ ░ ░ ░ ░ ▒ ░ ░ ░░ ░ ▒ ░░ ░░ ░
░ ░ ░ ░ ░ ░ ░ ░ ░ ░
░
--[ Welcome to Metabrik - Knowledge is in your head, Detail is in the code ]--
--[ Briks available: $available_count ]--
--[ Briks used: $used_count ]--
--[ Version $version ]--
There is a Brik for that.
EOF
;
return
1;
}
sub
pwd {
my
$self
=
shift
;
return
$self
->{path_cwd};
}
sub
get_available_help {
my
$self
=
shift
;
my
@used
=
sort
{
$a
cmp
$b
}
keys
%{
$self
->context->used};
my
@aliases
=
sort
{
$a
cmp
$b
}
keys
%{
$self
->{_aliases}};
my
@commands
=
sort
{
$a
cmp
$b
}
keys
%{
$self
->brik_commands};
@commands
=
grep
(!/^brik_/,
@commands
);
for
(
@aliases
,
@commands
) {
s/^run_//;
}
return
{
briks
=> \
@used
,
aliases
=> \
@aliases
,
commands
=> \
@commands
};
}
our
$AUTOLOAD
;
sub
AUTOLOAD {
my
$self
=
shift
;
my
(
@args
) =
@_
;
$self
->debug &&
$self
->
log
->debug(
"autoload[$AUTOLOAD]"
);
if
(
$AUTOLOAD
!~ /^Metabrik::Core::Shell::run_/) {
return
1;
}
(
my
$command
=
$AUTOLOAD
) =~ s/^Metabrik::Core::Shell:://;
$self
->debug &&
$self
->
log
->debug(
"AUTOLOAD: command[$command] args[@args]"
);
my
$aliases
=
$self
->{_aliases};
if
(
exists
(
$aliases
->{
$command
})) {
my
$cmd
=
$aliases
->{
$command
};
return
$self
->cmd(
join
(
' '
,
$cmd
,
@args
));
}
my
$context
=
$self
->context;
if
(
$context
->is_used(
'shell::command'
)) {
(
my
$exec
=
$command
) =~ s/^run_//;
my
$executables
=
$self
->{_executables};
if
(
exists
(
$executables
->{
$exec
})) {
my
$cmd
=
"run shell::command system $exec"
;
return
$self
->cmd(
join
(
' '
,
$cmd
,
@args
));
}
}
else
{
$self
->
log
->verbose(
"AUTOLOAD: Brik [shell::command] not loaded, skipping"
);
}
return
1;
}
sub
_word_may_be_brik {
my
$self
=
shift
;
my
(
$word
) =
@_
;
my
$context
=
$self
->context;
my
$used
=
$context
->used;
for
(
keys
%$used
) {
return
$used
if
/^
$word
/;
}
return
0;
}
sub
rl_complete {
my
$self
=
shift
;
my
(
$word
,
$line
,
$start
) =
@_
;
my
@comp
= ();
if
((
$start
== 0 ||
substr
(
$line
, 0,
$start
) =~ /^\s*$/)
&& (
$word
!~ m{/})) {
$self
->debug &&
$self
->
log
->debug(
"rl_complete: word[$word] start[$start] line[$line]"
);
@comp
=
$self
->complete(
''
,
$word
,
$line
,
$start
);
$self
->debug &&
$self
->
log
->debug(
"rl_complete: comp[@comp]"
);
}
else
{
my
$command
= (
$self
->line_parsed(
$line
))[0];
$self
->debug &&
$self
->
log
->debug(
"rl_complete: send to custom completion"
);
@comp
=
$self
->complete(
$command
,
$word
,
$line
,
$start
);
}
$self
->debug &&
$self
->
log
->debug(
"rl_complete: return comp[@comp] count["
.
scalar
(
@comp
).
"]"
);
return
@comp
;
}
sub
_convert_path {
my
(
$path
) =
@_
;
$path
=~ s/\\/\//g;
return
$path
;
}
sub
_update_path_home {
my
$self
=
shift
;
$self
->{path_home} = _convert_path(File::HomeDir->my_home ||
'/tmp'
);
return
1;
}
sub
_update_path_cwd {
my
$self
=
shift
;
my
$cwd
= _convert_path(Cwd::getcwd() ||
'/tmp'
);
$self
->debug &&
$self
->
log
->debug(
"cwd [$cwd]"
);
my
$home
=
$self
->{path_home} ||
'/tmp'
;
$self
->debug &&
$self
->
log
->debug(
"home [$home]"
);
$cwd
=~ s/^
$home
/~/;
$self
->{path_cwd} =
$cwd
;
return
1;
}
sub
_update_prompt {
my
$self
=
shift
;
my
(
$prompt
) =
@_
;
if
(
defined
(
$prompt
)) {
$self
->{prompt} =
$prompt
;
}
else
{
my
$ps1
=
$self
->ps1;
my
$cwd
=
$self
->{path_cwd};
my
$prompt
=
defined
(
$ps1
) ?
"$ps1:$cwd> "
:
"Meta:$cwd> "
;
if
($^O =~ /win32/i) {
$prompt
=~ s/> /\$ /;
}
elsif
($< == 0) {
$prompt
=~ s/> /
}
$self
->{prompt} =
$prompt
;
}
return
1;
}
sub
init {
my
$self
=
shift
;
$|++;
$self
->_update_path_home;
$self
->_update_path_cwd;
$self
->_update_prompt;
$self
->term->ornaments(
'md,me'
);
$self
->{API}{match_uniq} = 0;
return
$self
;
}
sub
prompt_str {
my
$self
=
shift
;
return
$self
->{prompt};
}
sub
cmd_is_complete {
my
$self
=
shift
;
my
(
$lines
) =
@_
;
my
$string
=
join
(
"\n"
,
@$lines
);
my
$document
= PPI::Document->new(\
$string
);
if
(!
$document
) {
return
$self
->
log
->error(
"cmd_is_complete: cannot parse Perl string"
);
}
my
$r
=
$document
->find_any(
sub
{
$_
[1]->isa(
'PPI::Structure'
) and !
$_
[1]->finish
});
return
$r
? 0 : 1;
}
sub
cmd_to_code {
my
$self
=
shift
;
my
(
$line
) =
@_
;
$self
->debug &&
$self
->
log
->debug(
"cmd_to_code: before: [$line]"
);
if
(
$line
=~ /^\s*
'\s*((?:use|set|get|run)\s.*?)\s*'
\s*;?\s*$/) {
(
my
$new
= $1) =~ s{
"}{\\"
}g;
$new
=~ s{\$}{\\\$}g;
$self
->debug &&
$self
->
log
->debug(
"cmd_to_code: new: [$new]"
);
$line
=
'$SHE->cmd("'
.
$new
.
'");'
;
}
$self
->debug &&
$self
->
log
->debug(
"cmd_to_code: after: [$line]"
);
return
$line
;
}
sub
process_line {
my
$self
=
shift
;
my
(
$line
,
$lines
) =
@_
;
$self
->debug &&
$self
->
log
->debug(
"process_line: [$line]"
);
if
(
$line
=~ /^\s*
return
0;
}
if
(
$line
=~ /^\s*$/) {
return
0;
}
push
@$lines
,
$line
;
if
(!
$self
->cmd_is_complete(
$lines
)) {
$lines
->[-1] =
$self
->cmd_to_code(
$line
);
$self
->_update_prompt(
'.. '
);
return
1;
}
$self
->debug &&
$self
->
log
->debug(
"process_line: lines[@$lines]"
);
$self
->cmd(
join
(
''
,
@$lines
));
$self
->_update_prompt;
return
0;
}
sub
cmdloop {
my
$self
=
shift
;
my
(
$lines
) =
@_
;
my
@lines
= ();
if
(
defined
(
$lines
)) {
for
my
$line
(
@$lines
) {
if
(
$self
->process_line(
$line
, \
@lines
)) {
next
;
}
else
{
@lines
= ();
}
last
if
$self
->{stop};
}
}
else
{
$self
->{stop} = 0;
$self
->preloop;
while
(
defined
(
my
$line
=
$self
->
readline
(
$self
->prompt_str))) {
if
(
$self
->process_line(
$line
, \
@lines
)) {
next
;
}
else
{
@lines
= ();
}
last
if
$self
->{stop};
}
$self
->run_exit;
return
$self
->postloop;
}
return
1;
}
sub
run_exit {
my
$self
=
shift
;
my
$context
=
$self
->context;
if
(
$context
->is_used(
'shell::history'
)) {
$context
->run(
'shell::history'
,
'write'
);
}
$context
->brik_fini;
return
$self
->stoploop;
}
sub
comp_exit {
my
$self
=
shift
;
$self
->debug &&
$self
->
log
->debug(
"comp_exit: true"
);
return
();
}
sub
run_alias {
my
$self
=
shift
;
my
(
$alias
,
@cmd
) =
@_
;
my
$aliases
=
$self
->{_aliases};
if
(!
defined
(
$alias
)) {
for
my
$this
(
sort
{
$a
cmp
$b
}
keys
%$aliases
) {
(
$alias
=
$this
) =~ s/^run_//;
printf
(
"alias %-10s \"%s\"\n"
,
$alias
,
$aliases
->{
$this
});
}
return
1;
}
elsif
(
length
(
$alias
) &&
@cmd
== 0) {
$alias
=~ s/^run_//;
printf
(
"alias %-10s \"%s\"\n"
,
$alias
,
$aliases
->{
"run_$alias"
});
return
1;
}
$aliases
->{
"run_$alias"
} =
join
(
' '
,
@cmd
);
$self
->{_aliases} =
$aliases
;
$self
->add_handler(
"run_$alias"
);
return
1;
}
sub
comp_alias {
my
$self
=
shift
;
$self
->debug &&
$self
->
log
->debug(
"comp_alias: true"
);
return
();
}
sub
run_cd {
my
$self
=
shift
;
my
(
$dir
,
@args
) =
@_
;
if
(
defined
(
$dir
)) {
if
(
$dir
=~ m{^~}) {
$dir
=~ s{^~}{
$self
->{path_home}};
}
if
(! -d
$dir
) {
return
$self
->
log
->error(
"cd: directory [$dir] does not exist"
);
}
chdir
(
$dir
)
or
return
$self
->
log
->error(
"cd: chdir failed for directory [$dir]: $!"
);
$self
->_update_path_cwd;
}
else
{
chdir
(
$self
->{path_home})
or
return
$self
->
log
->error(
"cd: chdir failed for directory [$dir]: $!"
);
$self
->_update_path_cwd;
}
$self
->_update_prompt;
return
1;
}
sub
comp_cd {
my
$self
=
shift
;
my
(
$word
,
$line
,
$start
) =
@_
;
$self
->debug &&
$self
->
log
->debug(
"comp_cd: true"
);
return
$self
->catch_comp_sub(
$word
,
$start
,
$line
);
}
sub
run_code {
my
$self
=
shift
;
my
$context
=
$self
->context;
my
$line
=
$self
->line;
$line
=~ s/^code\s+//;
if
(!
length
(
$line
)) {
return
$self
->
log
->info(
'code <code>'
);
}
$self
->debug &&
$self
->
log
->debug(
"run_code: code[$line]"
);
my
$r
;
eval
{
local
$SIG
{INT} =
sub
{
$self
->debug &&
$self
->
log
->debug(
"run_code: SIG received"
);
if
(
$self
->global->exit_on_sigint) {
$self
->debug &&
$self
->
log
->debug(
"run_code: exiting"
);
$self
->run_exit;
}
die
(
"interrupted by user\n"
);
};
$r
=
$context
->
do
(
$line
);
};
if
(!
defined
(
$r
)) {
return
$self
->
log
->error(
"run_code: unable to execute Code [$line]"
);
}
if
(
$self
->echo) {
$self
->page(Data::Dump::
dump
(
$r
).
"\n"
);
}
return
$r
;
}
sub
comp_code {
my
$self
=
shift
;
my
(
$word
,
$line
,
$start
) =
@_
;
$self
->debug &&
$self
->
log
->debug(
"comp_code: true"
);
return
$self
->catch_comp_sub(
$word
,
$start
,
$line
);
}
sub
run_use {
my
$self
=
shift
;
my
(
$brik
,
@args
) =
@_
;
my
$context
=
$self
->context;
if
(!
defined
(
$brik
)) {
return
$self
->
log
->info(
'use <brik>'
);
}
my
$r
;
if
(
$brik
=~ /^[a-z]/ &&
$brik
=~ /::/) {
$r
=
$context
->
use
(
$brik
) or
return
;
if
(
$r
) {
$self
->
log
->verbose(
"use: Brik [$brik] success"
);
}
}
else
{
return
$self
->run_code(
$brik
,
@args
);
}
return
$r
;
}
sub
comp_use {
my
$self
=
shift
;
my
(
$word
,
$line
,
$start
) =
@_
;
$self
->debug &&
$self
->
log
->debug(
"comp_use: true"
);
my
$context
=
$self
->context;
my
@words
=
$self
->line_parsed(
$line
);
my
$count
=
scalar
(
@words
);
if
(
$self
->debug) {
$self
->
log
->debug(
"word[$word] line[$line] start[$start] count[$count]"
);
}
my
@comp
= ();
if
((
$count
== 1)
|| (
$count
== 2 &&
length
(
$word
) > 0)) {
my
$available
=
$context
->available;
if
(
$self
->debug && !
defined
(
$available
)) {
$self
->
log
->debug(
"\ncomp_use: can't fetch available Briks"
);
return
();
}
for
my
$a
(
keys
%$available
) {
push
@comp
,
$a
if
$a
=~ /^
$word
/;
}
}
return
@comp
;
}
sub
get_help_attributes {
my
$self
=
shift
;
my
(
$brik
) =
@_
;
if
(!
defined
(
$brik
)) {
return
$self
->
log
->error(
$self
->brik_help_run(
'get_help_attributes'
));
}
my
$context
=
$self
->context;
if
(!
$context
->is_used(
$brik
)) {
return
{};
}
my
$used
=
$context
->used;
my
$attributes
=
$used
->{
$brik
}->brik_own_attributes;
my
$base_attributes
= {};
if
(
$self
->help_show_base_attributes ||
$self
->help_show_base_all
||
$self
->show_base_attributes ||
$self
->show_base_all
||
$self
->help_show_all ||
$self
->show_all) {
$base_attributes
=
$used
->{
$brik
}->brik_base_attributes;
}
my
$inherited_attributes
= {};
if
(
$self
->help_show_inherited_attributes ||
$self
->help_show_inherited_all
||
$self
->show_inherited_attributes ||
$self
->show_inherited_all
||
$self
->help_show_all ||
$self
->show_all) {
$inherited_attributes
=
$used
->{
$brik
}->brik_inherited_attributes;
}
for
my
$attribute
(
keys
%$base_attributes
) {
$attributes
->{
$attribute
} =
$base_attributes
->{
$attribute
};
}
for
my
$attribute
(
keys
%$inherited_attributes
) {
$attributes
->{
$attribute
} =
$inherited_attributes
->{
$attribute
};
}
return
$attributes
;
}
sub
get_help_commands {
my
$self
=
shift
;
my
(
$brik
) =
@_
;
if
(!
defined
(
$brik
)) {
return
$self
->
log
->error(
$self
->brik_help_run(
'get_help_commands'
));
}
my
$context
=
$self
->context;
if
(!
$context
->is_used(
$brik
)) {
return
{};
}
my
$used
=
$context
->used;
my
$commands
=
$used
->{
$brik
}->brik_own_commands;
my
$base_commands
= {};
if
(
$self
->help_show_base_commands ||
$self
->help_show_base_all
||
$self
->show_base_commands ||
$self
->show_base_all
||
$self
->help_show_all ||
$self
->show_all) {
$base_commands
=
$used
->{
$brik
}->brik_base_commands;
}
my
$inherited_commands
= {};
if
(
$self
->help_show_inherited_commands ||
$self
->help_show_inherited_all
||
$self
->show_inherited_commands ||
$self
->show_inherited_all
||
$self
->help_show_all ||
$self
->show_all) {
$inherited_commands
=
$used
->{
$brik
}->brik_inherited_commands;
}
for
my
$command
(
keys
%$base_commands
) {
$commands
->{
$command
} =
$base_commands
->{
$command
};
}
for
my
$command
(
keys
%$inherited_commands
) {
$commands
->{
$command
} =
$inherited_commands
->{
$command
};
}
return
$commands
;
}
sub
get_comp_attributes {
my
$self
=
shift
;
my
(
$brik
) =
@_
;
if
(!
defined
(
$brik
)) {
return
$self
->
log
->error(
$self
->brik_help_run(
'get_comp_attributes'
));
}
my
$context
=
$self
->context;
if
(!
$context
->is_used(
$brik
)) {
return
{};
}
my
$used
=
$context
->used;
my
$attributes
=
$used
->{
$brik
}->brik_own_attributes;
my
$base_attributes
= {};
if
(
$self
->comp_show_base_attributes ||
$self
->comp_show_base_all
||
$self
->show_base_attributes ||
$self
->show_base_all
||
$self
->comp_show_all ||
$self
->show_all) {
$base_attributes
=
$used
->{
$brik
}->brik_base_attributes;
}
my
$inherited_attributes
= {};
if
(
$self
->comp_show_inherited_attributes ||
$self
->comp_show_inherited_all
||
$self
->show_inherited_attributes ||
$self
->show_inherited_all
||
$self
->comp_show_all ||
$self
->show_all) {
$inherited_attributes
=
$used
->{
$brik
}->brik_inherited_attributes;
}
for
my
$attribute
(
keys
%$base_attributes
) {
$attributes
->{
$attribute
} =
$base_attributes
->{
$attribute
};
}
for
my
$attribute
(
keys
%$inherited_attributes
) {
$attributes
->{
$attribute
} =
$inherited_attributes
->{
$attribute
};
}
return
$attributes
;
}
sub
get_comp_commands {
my
$self
=
shift
;
my
(
$brik
) =
@_
;
if
(!
defined
(
$brik
)) {
return
$self
->
log
->error(
$self
->brik_help_run(
'get_comp_commands'
));
}
my
$context
=
$self
->context;
if
(!
$context
->is_used(
$brik
)) {
return
{};
}
my
$used
=
$context
->used;
my
$commands
=
$used
->{
$brik
}->brik_own_commands;
my
$base_commands
= {};
if
(
$self
->comp_show_base_commands ||
$self
->comp_show_base_all
||
$self
->show_base_commands ||
$self
->show_base_all
||
$self
->comp_show_all ||
$self
->show_all) {
$base_commands
=
$used
->{
$brik
}->brik_base_commands;
}
my
$inherited_commands
= {};
if
(
$self
->comp_show_inherited_commands ||
$self
->comp_show_inherited_all
||
$self
->show_inherited_commands ||
$self
->show_inherited_all
||
$self
->comp_show_all ||
$self
->show_all) {
$inherited_commands
=
$used
->{
$brik
}->brik_inherited_commands;
}
for
my
$command
(
keys
%$base_commands
) {
$commands
->{
$command
} =
$base_commands
->{
$command
};
}
for
my
$command
(
keys
%$inherited_commands
) {
$commands
->{
$command
} =
$inherited_commands
->{
$command
};
}
return
$commands
;
}
sub
run_help {
my
$self
=
shift
;
my
(
$arg1
,
$arg2
) =
@_
;
my
$context
=
$self
->context;
my
$help
=
$self
->get_available_help;
my
%aliases
=
map
{
$_
=> 1 } @{
$help
->{aliases}};
my
%briks
=
map
{
$_
=> 1 } @{
$help
->{briks}};
my
%commands
=
map
{
$_
=> 1 } @{
$help
->{commands}};
if
(!
defined
(
$arg1
)) {
$self
->
log
->info(
"For more help, print help <Command>:"
);
$self
->
log
->info(
" "
);
for
my
$this
(
sort
{
$a
cmp
$b
} @{
$help
->{briks}}) {
$self
->
log
->info(
" $this - Brik"
);
}
for
my
$this
(
sort
{
$a
cmp
$b
} @{
$help
->{aliases}}) {
$self
->
log
->info(
" $this - Alias"
);
}
for
my
$this
(
sort
{
$a
cmp
$b
} @{
$help
->{commands}}) {
$self
->
log
->info(
" $this - Command"
);
}
return
1;
}
elsif
(!
defined
(
$arg2
)) {
if
(
$context
->is_used(
$arg1
)) {
my
$used_brik
=
$context
->used->{
$arg1
};
my
$attributes
=
$self
->get_help_attributes(
$arg1
);
my
$commands
=
$self
->get_help_commands(
$arg1
);
for
my
$attribute
(
sort
{
$a
cmp
$b
}
keys
%$attributes
) {
my
$help
=
"set $arg1 "
.
$used_brik
->brik_help_set(
$attribute
);
$self
->
log
->info(
$help
)
if
defined
(
$help
);
}
for
my
$command
(
sort
{
$a
cmp
$b
}
keys
%$commands
) {
my
$help
=
"run $arg1 "
.
$used_brik
->brik_help_run(
$command
);
$self
->
log
->info(
$help
)
if
defined
(
$help
);
}
}
elsif
(
exists
(
$commands
{
$arg1
})) {
for
my
$this
(
sort
{
$a
cmp
$b
}
keys
%commands
) {
return
$self
->
log
->info(
"$arg1 - core::shell Command, see 'help core::shell $arg1'"
);
}
}
elsif
(
exists
(
$aliases
{
$arg1
})) {
return
$self
->
log
->info(
"$arg1 - no help for Aliases"
);
}
else
{
return
$self
->
log
->info(
"Command [$arg1] not found"
);
}
}
else
{
if
(
exists
(
$briks
{
$arg1
})) {
my
$used_brik
=
$context
->used->{
$arg1
};
my
$attributes
=
$used_brik
->brik_attributes;
my
$commands
=
$used_brik
->brik_commands;
my
$base_attributes
=
$used_brik
->brik_base_attributes;
my
$base_commands
=
$used_brik
->brik_base_commands;
my
$help
;
if
(
exists
(
$attributes
->{
$arg2
}) ||
exists
(
$base_attributes
->{
$arg2
})) {
$help
=
$used_brik
->brik_help_set(
$arg2
);
}
elsif
(
exists
(
$commands
->{
$arg2
}) ||
exists
(
$base_commands
->{
$arg2
})) {
$help
=
$used_brik
->brik_help_run(
$arg2
);
}
else
{
$help
=
"Attribute or Command [$arg2] not found for Brik [$arg1]"
;
}
return
$self
->
log
->info(
$help
);
}
else
{
return
$self
->
log
->info(
"Command [$arg1] not found"
);
}
}
return
1;
}
sub
comp_help {
my
$self
=
shift
;
my
(
$word
,
$line
,
$start
) =
@_
;
$self
->debug &&
$self
->
log
->debug(
"comp_help: true"
);
my
@words
=
$self
->line_parsed(
$line
);
my
$count
=
scalar
(
@words
);
if
(
$self
->debug) {
$self
->
log
->debug(
"word[$word] line[$line] start[$start] count[$count]"
);
}
my
@comp
= ();
if
(
$count
== 1 || (
$count
== 2 &&
length
(
$word
) > 0)) {
my
$help
=
$self
->get_available_help;
for
my
$a
(@{
$help
->{briks}}, @{
$help
->{commands}}) {
next
unless
length
(
$a
);
push
@comp
,
$a
if
$a
=~ /^
$word
/;
}
}
else
{
push
@comp
,
$self
->comp_run(
@_
);
push
@comp
,
$self
->comp_set(
@_
);
return
@comp
;
}
return
@comp
;
}
sub
run_set {
my
$self
=
shift
;
my
(
$brik
,
$attribute
,
$value
) =
@_
;
my
$context
=
$self
->context;
if
(!
defined
(
$brik
) || !
defined
(
$attribute
) || !
defined
(
$value
)) {
return
$self
->
log
->info(
"set <brik> <attribute> <value>"
);
}
my
$r
=
$context
->set(
$brik
,
$attribute
,
$value
);
if
(!
defined
(
$r
)) {
return
$self
->
log
->error(
"set: unable to set Attribute [$attribute] for Brik [$brik]"
);
}
return
$r
;
}
sub
comp_set {
my
$self
=
shift
;
my
(
$word
,
$line
,
$start
) =
@_
;
$self
->debug &&
$self
->
log
->debug(
"comp_set: true"
);
my
$context
=
$self
->context;
my
$used
=
$context
->used;
if
(!
defined
(
$used
)) {
$self
->debug &&
$self
->
log
->debug(
"comp_set: can't fetch used Briks"
);
return
();
}
my
@words
=
$self
->line_parsed(
$line
);
my
$count
=
scalar
(
@words
);
if
(
$self
->debug) {
$self
->
log
->debug(
"word[$word] line[$line] start[$start] count[$count]"
);
}
my
$brik
=
defined
(
$words
[1]) ?
$words
[1] :
undef
;
my
@comp
= ();
if
((
$count
== 1)
|| (
$count
== 2 &&
length
(
$word
) > 0)) {
for
my
$a
(
keys
%$used
) {
push
@comp
,
$a
if
$a
=~ /^
$word
/;
}
}
elsif
(
$count
== 2 &&
length
(
$word
) == 0) {
if
(
$self
->debug) {
if
(!
exists
(
$used
->{
$brik
})) {
$self
->
log
->debug(
"comp_set: Brik [$brik] not used"
);
return
();
}
}
my
$attributes
=
$self
->get_comp_attributes(
$brik
);
for
my
$attribute
(
keys
%$attributes
) {
push
@comp
,
$attribute
;
}
}
elsif
(
$count
== 3 &&
length
(
$word
) > 0) {
if
(
$self
->debug) {
if
(!
exists
(
$used
->{
$brik
})) {
$self
->
log
->debug(
"comp_set: Brik [$brik] not used"
);
return
();
}
}
my
$attributes
=
$self
->get_comp_attributes(
$brik
);
for
my
$attribute
(
keys
%$attributes
) {
if
(
$attribute
=~ /^
$word
/) {
push
@comp
,
$attribute
;
}
}
}
else
{
return
$self
->catch_comp_sub(
$word
,
$start
,
$line
);
}
return
@comp
;
}
sub
run_get {
my
$self
=
shift
;
my
(
$brik
,
$attribute
) =
@_
;
my
$context
=
$self
->context;
if
(!
defined
(
$brik
)) {
my
$used
=
$context
->used or
return
;
for
my
$brik
(
sort
{
$a
cmp
$b
}
keys
%$used
) {
my
$attributes
=
$self
->get_help_attributes(
$brik
);
for
my
$attribute
(
sort
{
$a
cmp
$b
}
keys
%$attributes
) {
$self
->
log
->info(
"$brik $attribute "
.
$context
->get(
$brik
,
$attribute
));
}
}
}
elsif
(
defined
(
$brik
) && !
defined
(
$attribute
)) {
my
$used
=
$context
->used or
return
;
if
(!
exists
(
$used
->{
$brik
})) {
return
$self
->
log
->error(
"get: Brik [$brik] not used"
);
}
my
$attributes
=
$self
->get_help_attributes(
$brik
);
for
my
$attribute
(
sort
{
$a
cmp
$b
}
keys
%$attributes
) {
$self
->
log
->info(
"$brik $attribute "
.
$context
->get(
$brik
,
$attribute
));
}
}
elsif
(
defined
(
$brik
) &&
defined
(
$attribute
)) {
my
$used
=
$context
->used or
return
;
if
(!
exists
(
$used
->{
$brik
})) {
return
$self
->
log
->error(
"get: Brik [$brik] not used"
);
}
if
(!
$used
->{
$brik
}->brik_has_attribute(
$attribute
)) {
return
$self
->
log
->error(
"get: Attribute [$attribute] does not exist for Brik [$brik]"
);
}
$self
->
log
->info(
"$brik $attribute "
.
$context
->get(
$brik
,
$attribute
));
}
return
1;
}
sub
comp_get {
my
$self
=
shift
;
$self
->debug &&
$self
->
log
->debug(
"comp_get: true"
);
return
$self
->comp_set(
@_
);
}
sub
run_run {
my
$self
=
shift
;
my
(
$brik
,
$command
,
@args
) =
@_
;
my
$context
=
$self
->context;
if
(!
defined
(
$brik
) || !
defined
(
$command
)) {
return
$self
->
log
->info(
"run <brik> <command> [ <arg1> <arg2> .. <argN> ]"
);
}
my
$r
;
{
local
$SIG
{INT} =
sub
{
$self
->debug &&
$self
->
log
->debug(
"run_run: SIG received"
);
if
(
$self
->global->exit_on_sigint) {
$self
->debug &&
$self
->
log
->debug(
"run_run: exiting"
);
$self
->run_exit;
}
die
(
"interrupted by user\n"
);
};
if
(
$self
->debug) {
my
(
$module
,
$file
,
$line
) =
caller
();
$self
->
log
->debug(
"run_run: called by module [$module] from [$file] line[$line]"
);
}
my
(
$module
) =
caller
();
if
(
$module
eq
'Term::Shell'
&&
$command
eq
'exec'
) {
$command
=
'execute'
;
}
$r
=
$context
->run(
$brik
,
$command
,
@args
);
if
(!
defined
(
$r
)) {
return
$self
->
log
->error(
"run: unable to execute Command [$command] for Brik [$brik]"
);
}
}
if
(
$self
->echo) {
$self
->page(Data::Dump::
dump
(
$r
).
"\n"
);
}
return
$r
;
}
sub
comp_run {
my
$self
=
shift
;
my
(
$word
,
$line
,
$start
) =
@_
;
$self
->debug &&
$self
->
log
->debug(
"comp_run: true"
);
my
$context
=
$self
->context;
my
@words
=
$self
->line_parsed(
$line
);
my
$count
=
scalar
(
@words
);
my
$last
=
$words
[-1];
if
(
$self
->debug) {
$self
->
log
->debug(
"comp_run: words[@words] | word[$word] line[$line] "
.
"start[$start] | last[$last]"
);
}
my
$used
=
$context
->used;
if
(!
defined
(
$used
)) {
$self
->debug &&
$self
->
log
->debug(
"comp_run: can't fetch used Briks"
);
return
();
}
my
$brik
=
defined
(
$words
[1]) ?
$words
[1] :
undef
;
my
@comp
= ();
if
((
$count
== 1)
|| (
$count
== 2 &&
length
(
$word
) > 0)) {
for
my
$a
(
keys
%$used
) {
push
@comp
,
$a
if
$a
=~ /^
$word
/;
}
}
elsif
(
$count
== 2 &&
length
(
$word
) == 0) {
if
(
$self
->debug) {
if
(!
exists
(
$used
->{
$brik
})) {
$self
->
log
->debug(
"comp_run: Brik [$brik] not used"
);
return
();
}
}
my
$commands
=
$self
->get_comp_commands(
$brik
);
for
my
$command
(
keys
%$commands
) {
push
@comp
,
$command
;
}
}
elsif
(
$count
== 3 &&
length
(
$word
) > 0) {
if
(
$self
->debug) {
if
(!
exists
(
$used
->{
$brik
})) {
$self
->
log
->debug(
"comp_run: Brik [$brik] not used"
);
return
();
}
}
my
$commands
=
$self
->get_comp_commands(
$brik
);
for
my
$command
(
keys
%$commands
) {
if
(
$command
=~ /^
$word
/) {
push
@comp
,
$command
;
}
}
}
else
{
return
$self
->catch_comp_sub(
$word
,
$start
,
$line
);
}
return
@comp
;
}
sub
catch_run {
my
$self
=
shift
;
my
(
@args
) =
@_
;
my
$context
=
$self
->context;
$self
->debug &&
$self
->
log
->debug(
"catch_run: args [@args]"
);
if
(
$context
->is_used(
'shell::command'
)) {
if
(
defined
(
$args
[0]) &&
$args
[0] =~ m{^\s*/}) {
my
$cmd
=
"run shell::command system"
;
return
$self
->cmd(
join
(
' '
,
$cmd
,
@args
));
}
}
return
$self
->run_code(
@args
);
}
sub
_file_find {
my
$self
=
shift
;
my
(
$path
) =
@_
;
my
@dirs
= ();
my
@files
= ();
my
$dirpattern
=
'.*'
;
my
$filepattern
=
'.*'
;
my
@tmp_dirs
= ();
eval
{
@tmp_dirs
= io(
$path
)->all_dirs;
};
if
($@) {
if
(
$self
->debug) {
chomp
($@);
$self
->
log
->debug(
"all: $path: dirs: $@"
);
}
return
{
directories
=> [],
files
=> [] };
}
for
my
$this
(
@tmp_dirs
) {
if
(
$this
=~ /
$dirpattern
/) {
push
@dirs
,
"$this/"
;
}
}
my
@tmp_files
= ();
eval
{
@tmp_files
= io(
$path
)->all_files;
};
if
($@) {
if
(
$self
->debug) {
chomp
($@);
$self
->
log
->debug(
"all: $path: files: $@"
);
}
return
{
directories
=> [],
files
=> [] };
}
for
my
$this
(
@tmp_files
) {
if
(
$this
=~ /
$filepattern
/) {
push
@files
,
"$this"
;
}
}
@dirs
=
map
{ s/^\.\///;
$_
}
@dirs
;
@files
=
map
{ s/^\.\///;
$_
}
@files
;
return
{
directories
=> \
@dirs
,
files
=> \
@files
,
};
}
sub
catch_comp_sub {
my
$self
=
shift
;
my
(
$word
,
$start
,
$line
) =
@_
;
$self
->debug &&
$self
->
log
->debug(
"catch_comp_sub: true"
);
my
$context
=
$self
->context;
my
$attribs
=
$self
->term->Attribs;
$attribs
->{completion_suppress_append} = 1;
my
@words
=
$self
->line_parsed(
$line
);
my
$count
=
scalar
(
@words
);
my
$last
=
$words
[-1];
$self
->debug &&
$self
->
log
->debug(
"catch_comp_sub: words[@words] | word[$word] line[$line] start[$start] | last[$last]"
);
if
(!
length
(
$word
)) {
$word
=
'.'
;
}
$self
->debug &&
$self
->
log
->debug(
"catch_comp_sub: DEFAULT: words[@words] | word[$word] line[$line] start[$start] | last[$last]"
);
my
@comp
= ();
if
(
$last
=~ /^\$/ &&
$line
!~ /\s+$/) {
my
$variables
=
$context
->variables;
for
my
$this
(
@$variables
) {
$this
=~ s/^\$//;
$self
->debug &&
$self
->
log
->debug(
"variable[$this] start[$start]"
);
if
(
$this
=~ /^
$word
/) {
push
@comp
,
$this
;
}
}
}
else
{
my
$path
=
'.'
;
my
$home
=
$self
->{path_home};
$word
=~ s/^~/
$home
/;
if
(
$word
=~ /^(.*)\/.*$/) {
$path
= $1 ||
'/'
;
}
$self
->debug &&
$self
->
log
->debug(
"path[$path]"
);
my
$found
=
$self
->_file_find(
$path
);
for
my
$this
(@{
$found
->{files}}, @{
$found
->{directories}}) {
$self
->debug &&
$self
->
log
->debug(
"check[$this]"
);
if
(
$this
=~ /^
$word
/) {
push
@comp
,
$this
;
}
}
}
for
(
@comp
) {
if
(m{\s+}) {
s/^/"/;
s/$/"/;
}
}
return
@comp
;
}
sub
catch_comp {
my
$self
=
shift
;
my
(
$word
,
$start
,
$line
) =
@_
;
$self
->debug &&
$self
->
log
->debug(
"catch_comp: true"
);
my
$context
=
$self
->context;
my
$attribs
=
$self
->term->Attribs;
$attribs
->{completion_suppress_append} = 1;
my
@words
=
$self
->line_parsed(
$line
);
my
$count
=
scalar
(
@words
);
my
$last
=
$words
[-1];
$self
->debug &&
$self
->
log
->debug(
"catch_comp: words[@words] | word[$word] line[$line] start[$start] | last[$last]"
);
if
(!
length
(
$start
)) {
$start
=
'.'
;
}
$self
->debug &&
$self
->
log
->debug(
"catch_comp: DEFAULT: words[@words] | word[$word] line[$line] start[$start] | last[$last]"
);
my
@comp
= ();
if
(
$last
=~ /^\$/ &&
$line
!~ /\s+$/) {
my
$variables
=
$context
->variables;
for
my
$this
(
@$variables
) {
$this
=~ s/^\$//;
$self
->debug &&
$self
->
log
->debug(
"variable[$this] start[$start]"
);
if
(
$this
=~ /^
$start
/) {
push
@comp
,
$this
;
}
}
}
else
{
my
$path
=
'.'
;
my
$home
=
$self
->{path_home};
$start
=~ s/^~/
$home
/;
if
(
$start
=~ /^(.*)\/.*$/) {
$path
= $1 ||
'/'
;
}
$self
->debug &&
$self
->
log
->debug(
"path[$path]"
);
my
$found
=
$self
->_file_find(
$path
);
for
my
$this
(@{
$found
->{files}}, @{
$found
->{directories}}) {
$self
->debug &&
$self
->
log
->debug(
"check[$this]"
);
if
(
$this
=~ /^
$start
/) {
push
@comp
,
$this
;
}
}
}
for
(
@comp
) {
if
(m{\s+}) {
s/^/"/;
s/$/"/;
}
}
$self
->debug &&
$self
->
log
->debug(
"catch_comp: possible [@comp]"
);
return
@comp
;
}
1;
Hide Show 131 lines of Pod