|
|
|
@ -147,6 +147,7 @@ |
|
|
|
|
use strict; |
|
|
|
|
use warnings; |
|
|
|
|
use Anvil::Tools; |
|
|
|
|
use Data::Dumper; |
|
|
|
|
use JSON; |
|
|
|
|
use Text::ParseWords; |
|
|
|
|
|
|
|
|
@ -162,21 +163,29 @@ my $anvil = Anvil::Tools->new(); |
|
|
|
|
sub access_chain |
|
|
|
|
{ |
|
|
|
|
my $parameters = shift; |
|
|
|
|
# Required: |
|
|
|
|
my $chain_str = $parameters->{chain}; |
|
|
|
|
# Optional: |
|
|
|
|
my $chain_args = $parameters->{chain_args} // []; |
|
|
|
|
my $chain_str = $parameters->{chain}; |
|
|
|
|
my $debug = $parameters->{debug} // 3; |
|
|
|
|
|
|
|
|
|
my @chain = split(/->|[.]/, $chain_str); |
|
|
|
|
my $key_index = 0; |
|
|
|
|
my $intermediate = $anvil; |
|
|
|
|
my @results; |
|
|
|
|
my @results = (1); |
|
|
|
|
|
|
|
|
|
$anvil->Log->variables({ source => $THIS_FILE, line => __LINE__, level => $debug, list => { chain => prettify(\@chain) } }); |
|
|
|
|
|
|
|
|
|
foreach my $key (@chain) |
|
|
|
|
{ |
|
|
|
|
my $is_intermediate_hash = is_hash($intermediate); |
|
|
|
|
my $is_last_key = $key_index == $#chain; |
|
|
|
|
|
|
|
|
|
$anvil->Log->variables({ source => $THIS_FILE, line => __LINE__, level => $debug, list => { |
|
|
|
|
is_intermediate_hash => $is_intermediate_hash, |
|
|
|
|
is_last_key => $is_last_key, |
|
|
|
|
key => $key, |
|
|
|
|
key_index => $key_index, |
|
|
|
|
} }); |
|
|
|
|
|
|
|
|
|
if ($is_intermediate_hash) # Left-hand is hash; treat it as reading data |
|
|
|
|
{ |
|
|
|
|
last if (not exists $intermediate->{$key}); |
|
|
|
@ -192,14 +201,15 @@ sub access_chain |
|
|
|
|
} |
|
|
|
|
else # Left-hand is not hash; treat it as blessed/class object (module) and try to call a method from it |
|
|
|
|
{ |
|
|
|
|
# Key not found in object; stop following the chain |
|
|
|
|
eval { defined $intermediate->${key} ? 1 : 0; } or last; |
|
|
|
|
# Don't continue follow the chain when key if not found |
|
|
|
|
# Note: can() results in truthy when key refers to something that can return a value |
|
|
|
|
eval { $intermediate->can($key) } or last; |
|
|
|
|
|
|
|
|
|
# On the last key of the chain; try to execute the subroutine if it exists |
|
|
|
|
if ( $is_last_key && $intermediate->can($key) ) |
|
|
|
|
if ($is_last_key) |
|
|
|
|
{ |
|
|
|
|
# Trailing 1 means the eval block will return success if the subroutine and assign succeeded |
|
|
|
|
eval { (@results) = $intermediate->${key}(@$chain_args); 1; } or @results = (1); |
|
|
|
|
eval { (@results) = $intermediate->${key}(@$chain_args); 1; }; |
|
|
|
|
|
|
|
|
|
last; |
|
|
|
|
} |
|
|
|
@ -380,6 +390,18 @@ sub is_hash |
|
|
|
|
return ref($_[0]) eq "HASH"; |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
sub prettify |
|
|
|
|
{ |
|
|
|
|
my $var_value = shift; |
|
|
|
|
my $var_name = shift; |
|
|
|
|
|
|
|
|
|
local $Data::Dumper::Indent = 1; |
|
|
|
|
local $Data::Dumper::Varname = $var_name; |
|
|
|
|
local $Data::Dumper::Terse = (defined $var_name) ? 0 : 1; |
|
|
|
|
|
|
|
|
|
return Dumper($var_value); |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
sub process_scmd_db |
|
|
|
|
{ |
|
|
|
|
my $parameters = shift; |
|
|
|
@ -409,12 +431,13 @@ sub process_scmd_db |
|
|
|
|
sub process_scmd_execute |
|
|
|
|
{ |
|
|
|
|
my $parameters = shift; |
|
|
|
|
# Required: |
|
|
|
|
my $debug = $parameters->{debug} // 3; |
|
|
|
|
my $input = $parameters->{input}; |
|
|
|
|
# Optional: |
|
|
|
|
my $lid = $parameters->{lid} // ""; |
|
|
|
|
|
|
|
|
|
my @sargs = parse_line('\s+', 0, $input); |
|
|
|
|
my @sargs = parse_line('\s+', 0, $input); |
|
|
|
|
|
|
|
|
|
$anvil->Log->variables({ source => $THIS_FILE, line => __LINE__, level => $debug, list => { sargs => prettify(\@sargs) } }); |
|
|
|
|
|
|
|
|
|
return if $#sargs < 1; |
|
|
|
|
|
|
|
|
@ -429,7 +452,12 @@ sub process_scmd_execute |
|
|
|
|
$chain_args[$i] = $param if $is_decode_success; |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
my (@results) = access_chain({ chain => $chain_str, chain_args => \@chain_args }); |
|
|
|
|
$anvil->Log->variables({ source => $THIS_FILE, line => __LINE__, level => $debug, list => { |
|
|
|
|
chain_args => prettify(\@chain_args), |
|
|
|
|
chain_str => $chain_str, |
|
|
|
|
} }); |
|
|
|
|
|
|
|
|
|
my (@results) = access_chain({ chain => $chain_str, chain_args => \@chain_args, debug => $debug }); |
|
|
|
|
|
|
|
|
|
pstdout($lid.JSON->new->utf8->allow_blessed->encode({ sub_results => \@results })); |
|
|
|
|
} |
|
|
|
@ -456,6 +484,7 @@ if (not $anvil->data->{sys}{database}{connections}) |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
my $data_hash = $anvil->data->{switches}{'data'}; |
|
|
|
|
my $switch_debug = $anvil->data->{switches}{'debug'} // 3; |
|
|
|
|
my $db_access_mode = $anvil->data->{switches}{'mode'} // ""; |
|
|
|
|
my $db_uuid = $anvil->data->{switches}{'uuid'}; |
|
|
|
|
my $pre_data = $anvil->data->{switches}{'predata'}; |
|
|
|
@ -553,9 +582,14 @@ else |
|
|
|
|
my $scmd_db_write = "w"; |
|
|
|
|
my $scmd_execute = "x"; |
|
|
|
|
|
|
|
|
|
$script_line =~ s/^([[:xdigit:]]{8}-[[:xdigit:]]{4}-[1-5][[:xdigit:]]{3}-[89ab][[:xdigit:]]{3}-[[:xdigit:]]{12})\s+//; |
|
|
|
|
$script_line =~ s/^([[:xdigit:]]{8}-(?:[[:xdigit:]]{4}-){3}[[:xdigit:]]{12})\s+//; |
|
|
|
|
|
|
|
|
|
my $script_line_id = $1; |
|
|
|
|
|
|
|
|
|
$anvil->Log->variables({ source => $THIS_FILE, line => __LINE__, level => $switch_debug, list => { |
|
|
|
|
script_line_id => $script_line_id, |
|
|
|
|
script_line => $script_line, |
|
|
|
|
} }); |
|
|
|
|
|
|
|
|
|
if ($script_line =~ /^$scmd_db_read\s+/) |
|
|
|
|
{ |
|
|
|
@ -567,7 +601,7 @@ else |
|
|
|
|
} |
|
|
|
|
elsif ($script_line =~ /^$scmd_execute\s+/) |
|
|
|
|
{ |
|
|
|
|
process_scmd_execute({ input => $script_line, lid => $script_line_id }); |
|
|
|
|
process_scmd_execute({ debug => $switch_debug, input => $script_line, lid => $script_line_id }); |
|
|
|
|
} |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|