#
# Represents a tree node CNF object having children and a parent node if it is not the root.
# Programed by : Will Budic
-# Source Origin : https://github.com/wbudic/PerlCNF.git
-# Open Source License -> https://choosealicense.com/licenses/isc/
+# Notice - This source file is copied and usually placed in a local directory, outside of its project.
+# So it could not be the actual or current version, can vary or has been modiefied for what ever purpose in another project.
+# Please leave source of origin in this file for future references.
+# Source of Origin : https://github.com/wbudic/PerlCNF.git
+# Documentation : Specifications_For_CNF_ReadMe.md
+# Open Source Code License -> https://choosealicense.com/licenses/isc/
#
package CNFNode;
use strict;
use warnings;
use Carp qw(cluck);
+require CNFMeta; CNFMeta::import();
+
sub new {
- my ($class,$attrs, $self) = @_;
- $self = \%$attrs;
+ my ($class, $attrs) = @_;
+ my $self = \%$attrs;
bless $self, $class;
}
-sub name {
+sub name {shift -> {'_'}}
+sub parent {shift -> {'@'}}
+sub isRoot {not exists shift -> {'@'}}
+sub list {shift -> {'@@'}}
+sub script {shift -> {'~'}}
+sub attributes {
my $self = shift;
- return $self->{'_'}
+ my @nodes;
+ foreach(sort keys %$self){
+ my $node = $self->{$_};
+ if($_ !~ /@|@\$|#_~/){
+ $nodes[@nodes] = [$_, $node]
+ }
+ }
+ return @nodes;
+}
+sub nodes {
+ my $self = shift;
+ my $ret = $self->{'@$'};
+ if($ret){
+ return @$ret;
+ }
+ return ();
}
+
###
# Convenience method, returns string scalar value dereferenced (a copy) of the property value.
##
sub val {
my $self = shift;
- my $ret = $self->{'#'};
- $ret = $self->{'*'} if !$ret;
+ my $ret = $self->{'#'}; # Standard value
+ $ret = $self->{'*'} if !$ret; # Linked value
+ $ret = _evaluate($self->{'&'}) if !$ret and exists $self->{'&'}; # Evaluated value
+ if(!$ret && $self->{'@$'}){ #return from subproperties.
+ my $buf;
+ my @arr = @{$self->{'@$'}};
+ foreach my $node(@arr){
+ $buf .= $node->val()."\n";
+ }
+ return $buf;
+ }
if(ref($ret) eq 'SCALAR'){
$ret = $$ret;
- }
+ }
return $ret
}
-sub parent {
- my $self = shift;
- return $self->{'@'}
-}
-sub attributes {
- my $self = shift;
- my @nodes;
- foreach(sort keys %$self){
- my $node = $self->{$_};
- if($_ !~ /@|@\$|#_/){
- $nodes[@nodes] = [$_, $node]
+ my $meta = meta(SHELL());
+ sub _evaluate {
+ my $value = shift;
+ if($value =~ s/($meta)//i){
+ $value =~ s/^`|`\s*$/""/g; #we strip as a possible monkey copy had now redundant meta in the value.
+ $value = '`'.$value.'`';
+ }
+ ## no critic BuiltinFunctions::ProhibitStringyEval
+ my $ret = eval $value;
+ ## use critic
+ if ($ret){
+ chomp $ret;
+ return $ret;
+ }else{
+ cluck("Perl DO_ENABLED script evaluation failed to evalute: $value Error: $@");
+ return '<<ERROR>>';
}
}
- return @nodes;
-}
+
#
###
my ($self, $path, $ret, $prev, $seekArray)=@_;
foreach my $name(split(/\//, $path)){
if(ref($self) eq "ARRAY"){
- if($name eq '#'){
- if(ref($ret) eq "ARRAY"){
- next
- }else{
- return $prev->val()
- }
- }elsif($name =~ /\[(\d+)\]/){
+ if($name eq '#'){
+ if(ref($ret) eq "ARRAY"){
+ next
+ }else{
+ return $prev->val()
+ }
+ }elsif($name =~ /\[(\d+)\]/){
$self = $ret = @$ret[$1];
next
- }else{
- #if(@$self == 1){
- $ret = $prev->{'@$'};
- # }
- }
+ }else{
+ $ret = $prev->{'@$'};
+ }
}else{
- if($name eq '@@') {
- $ret = $self->{'@@'}; $seekArray = 1;
- next
- }elsif($name eq '@$') {
- $ret = $self->{'@$'}; #This will initiate further search in subproperties names.
- next
- }elsif($name eq '#'){
- return $ret->val()
- }if(ref($ret) eq "CNFNode" && $seekArray){
- $ret = $ret->{$name};
- next
- }else{
- $ret = $self->{'@$'} if ! $seekArray; #This will initiate further search in subproperties names.
- }
+ if($name eq '@@') {
+ $ret = $self->{'@@'}; $seekArray = 1;
+ next
+ }elsif($name eq '@$') {
+ $ret = $self->{'@$'}; # This will initiate further search in subproperties names.
+ next
+ }elsif($name eq '#'){
+ return $ret->val()
+ }if(ref($ret) eq "CNFNode" && $seekArray){
+ $ret = $ret->{$name};
+ next
+ }else{
+ $ret = $self->{'@$'} if ! $seekArray; # This will initiate further search in subproperties names.
+ }
}
if($ret){
my $found = 0;
if(!$found){
$self = $ret = $_
}else{
- $ret = \@arr;
+ $ret = \@arr;
}
$found=1
}
}
$ret = $self->{$name} if(!$found && $name ne '@$');
}else{
- $ret = $self->{$name} ;
+ if(ref($ret) ne "ARRAY"){
+ $ret = $self->{$name}
+ }
}
}
return $ret;
return $ret;
}
-sub nodes {
- my $self = shift;
- my $ret = $self->{'@$'};
- if($ret){
- return @$ret;
- }
- return ();
-}
-
###
# Outreached subs list of collected node links found in a property.
my @linked_subs;
my ($self, $parser, $script)=@_;
my ($sub, $val, $isArray,$body) = (undef,0,0,"");
- my ($tag,$sta,$end)=("","","");
- my @array;
+ my ($tag,$sta,$end)=("","","");
my ($opening,$closing,$valing)=(0,0,0);
+ my @array;
if(exists $self->{'_'} && $self->{'_'} eq '#'){
$val = $self->{'#'};
$tag = $2;
$end = $3;
my $isClosing = ($sta =~ /[>\]]/) ? 1 : 0;
- if($tag =~ /^([#\*\@]+)[\[<](.*)[\]>]\/*[#\*\@]+$/){#<- The \/ can sneak in as included in closing tag.
+ if($tag =~ /^([#\*\@]+)[\[<](.*)[\]>]\/*[#\*\@]+$/){#<- The \/ can sneak in as included in closing tag.
if($1 eq '*'){
my $link = $2;
my $rval = $self -> obtainLink($parser, $link);
@nodes = ();
}
$nodes[@nodes] = CNFNode->new({'_'=>$link, '*'=>$rval,'@' => \$self});
- $self->{'@$'} = \@nodes;
+ $self->{'@$'} = \@nodes;
}
else{
#Links scripted in main tree parent are copied main tree attributes.
}else{
$val = $2;
}
- }
- elsif($tag =~ /^(.*)[\[<]\/*(.*)[\]>](.*)$/ && $1 eq $3){
+ }elsif($tag =~ /^(.*)[\[<]\/*(.*)[\]>](.*)$/ && $1 eq $3){
if($opening){
$body .= qq($ln\n)
}
$self->{'@$'} = \@nodes;
}
next
- }
- elsif($isClosing){
+ }elsif($isClosing){
$opening--;
$closing++;
- }
- else{
+ }else{
$opening++;
$closing--;
}
}else{
my $a = $isArray;
my $property = CNFNode->new({'_'=>$sub, '@' => \$self});
- $property->process($parser, $body);
+ $property -> process($parser, $body);
$isArray = $a;
if($tag eq '@@'){
$array[@array] = $property;
}elsif($tag eq '#'){
$valing = 1;
}elsif($opening==0 && $isArray){
- $array[@array] = $ln;
- # next
+ $array[@array] = $ln;
}elsif($opening==0 && $ln =~ /^([<\[])(.+)([<\[])(.*)([>\]])(.+)([>\]])$/ &&
$1 eq $3 && $5 eq $7 ){ #<- tagged in line
if($2 eq '#') {
$array[@array] = $2;
next;
}
- my @attr = ($ln =~m/([\s\w]*?)\s*[=:]\s*(.*)\s*/);
+ my @attr = ($ln =~ m/([\s\w]*?)\s*[=:]\s*(.*)\s*/);
if(@attr>1){
my $n = $attr[0];
- my $v = $attr[1];
- $self->{$n} = $v;
+ my $v = $attr[1];
+ if($v =~ /[<\[]\*[<\[](.*)[]>\]]\*[>\]]/){
+ $v = $self-> obtainLink($parser, $1)
+ } $v =~ m/^(['"]).*(['"])$/g;
+ $v =~ s/^$1|$2$//g if($1 && $2 && $1 eq $2);
+ $self->{$n} = $v;
next;
}else{
$val = $ln if $val;
}
}
- $body .= qq($ln\n) if $ln!~/^\#/
+ # Very complex rule, allow #comment lines in buffer withing an node value tag, ie [#[..]#]
+ $body .= qq($ln\n) #if !$tag && $ln!~/^\#/ || $tag eq '#'
}
elsif($tag eq '#'){
- $body .= qq(\n)
+ $body .= qq(\n)
}
}
}
-
$self->{'@@'} = \@array if @array;
$self->{'#'} = \$val if $val;
## no critic BuiltinFunctions::ProhibitStringyEval
my $entry = pop (@linked_subs);
my $node = $entry->{node};
my $res = &{+$entry->{sub}}($node);
- $entry->{node}->{'*'} = \$res;
+ $entry->{node}->{'*'} = \$res;
}
return \$self;
}
# Validates a script if it has correctly structured nodes.
#
sub validate {
- my ($self, $script) = @_;
+ my $self = shift;
my ($tag,$sta,$end,$lnc,$errors)=("","","",0,0);
my (@opening,@closing,@singels);
my ($open,$close) = (0,0);
- my @lines = split(/\n/, $script);
+ my @lines = split(/\n/, $self->{'~'});
foreach my $ln(@lines){
$ln =~ s/^\s+|\s+$//g;
$lnc++;
}else{
my $errors = 0; my $error_tag; my $nesting;
my $cnt = $#opening;
- for my $i (0..$cnt){
-
+ for my $i (0..$cnt){
my $o = $opening[$i];
my $c = $closing[$cnt - $i];
if($o->{T} ne $c->{T}){
# Main Parser for the Configuration Network File Format.
-# This source file is copied and usually placed in a local directory, outside of its project.
-# So not the actual or current version, might vary or be modiefied for what ever purpose in other projects.
# Programed by : Will Budic
-# Source Origin : https://github.com/wbudic/PerlCNF.git
+# Notice - This source file is copied and usually placed in a local directory, outside of its project.
+# So it could not be the actual or current version, can vary or has been modiefied for what ever purpose in another project.
+# Please leave source of origin in this file for future references.
+# Source of Origin : https://github.com/wbudic/PerlCNF.git
# Documentation : Specifications_For_CNF_ReadMe.md
-# Open Source License -> https://choosealicense.com/licenses/isc/
+# Open Source Code License -> https://choosealicense.com/licenses/isc/
#
package CNFParser;
use Time::HiRes qw(time);
use DateTime;
+require CNFMeta; CNFMeta::import();
+require CNFNode;
+require CNFtoJSON;
+
# Do not remove the following no critic, no security or object issues possible.
# We can use perls default behaviour on return.
##no critic qw(Subroutines::RequireFinalReturn)
our %RESERVED_WORDS = map +($_, 1), qw{ CONST CONSTANT VARIABLE VAR
FILE TABLE TREE INDEX
- VIEW SQL MIGRATE DO
+ VIEW SQL MIGRATE DO LIB
PLUGIN MACRO %LOG INCLUDE INSTRUCTOR };
sub isReservedWord { my ($self, $word)=@_; return $word ? $RESERVED_WORDS{$word} : undef }
###
# Create a new CNFParser instance.
-# $path - Path to some .cnf file, to parse, not compsuluory to add now.
+# $path - Path to some .cnf_file file, to parse, not compsuluory to add now? Make undef.
# $attrs - is reference to hash of constances and settings to dynamically employ.
# $del_keys - is a reference to an array of constance attributes to dynamically remove.
sub new { my ($class, $path, $attrs, $del_keys, $self) = @_;
$self = \%$attrs;
}else{
$self = {
- DO_ENABLED => 0, # Enable/Disable DO instruction. Which could evaluated potentially be an doom execute destruction.
- ANONS_ARE_PUBLIC=> 1, # Anon's are shared and global for all of instances of this object, by default.
- ENABLE_WARNINGS => 1, # Disable this one, and you will stare into the void, on errors or operations skipped.
- STRICT => 1, # Enable/Disable strict processing to FATAL on errors, this throws and halts parsing on errors.
- HAS_EXTENSIONS => 0, # Enable/Disable extension of custom instructions. These is disabled by default and ingored.
- DEBUG => 0 # Not internally used by the parser, but possible a convience bypass setting for code using it.
+ DO_ENABLED => 0, # Enable/Disable DO instruction. Which could evaluated potentially be an doom execute destruction.
+ ANONS_ARE_PUBLIC=> 1, # Anon's are shared and global for all of instances of this object, by default.
+ ENABLE_WARNINGS => 1, # Disable this one, and you will stare into the void, about errors or operations skipped.
+ STRICT => 1, # Enable/Disable strict processing to FATAL on errors, this throws and halts parsing on errors.
+ HAS_EXTENSIONS => 0, # Enable/Disable extension of custom instructions. These is disabled by default and ingored.
+ DEBUG => 0, # Not internally used by the parser, but possible a convience bypass setting for code using it.
+ CNF_CONTENT => "", # Origin of the script, this wull be set by the parser, usually the path of a script file or is direct content.
};
}
- $CONSTREQ = $self->{'CONSTANT_REQUIRED'};
- if (!$self->{'ANONS_ARE_PUBLIC'}){ #Not public, means are private to this object, that is, anons are not static.
- $self->{'ANONS_ARE_PUBLIC'} = 0; #<- Caveat of Perl, if this is not set to zero, it can't be accessed legally in a protected hash.
- $self->{'__ANONS__'} = {};
- }
- $self->{'__DATA__'} = {};
- if(exists $self->{'%LOG'}){
+ $CONSTREQ = $self->{CONSTANT_REQUIRED};
+ if (!$self->{ANONS_ARE_PUBLIC}){ #Not public, means are private to this object, that is, anons are not static.
+ $self->{ANONS_ARE_PUBLIC} = 0; #<- Caveat of Perl, if this is not set to zero, it can't be accessed legally in a protected hash.
+ $self->{__ANONS__} = {};
+ }
+ if(exists $self->{'%LOG'}){
if(ref($self->{'%LOG'}) ne 'HASH'){
die '%LOG'. "passed attribute is not an hash reference."
}else{
$properties{'%LOG'} = $self->{'%LOG'}
}
}
- $self->{'STRICT'} = 1 if not exists $self->{'STRICT'}; #make strict by default if missing.
- $self->{'HAS_EXTENSIONS'} = 0 if not exists $self->{'HAS_EXTENSIONS'};
+ $self->{STRICT} = 1 if not exists $self->{STRICT}; #make strict by default if missing.
+ $self->{ENABLE_WARNINGS} = 1 if not exists $self->{ENABLE_WARNINGS};
+ $self->{HAS_EXTENSIONS} = 0 if not exists $self->{HAS_EXTENSIONS};
+ $self->{CNF_VERSION} = VERSION;
+ $self->{__DATA__} = {};
bless $self, $class; $self->parse($path, undef, $del_keys) if($path);
return $self;
}
#
sub import {
- my $caller = caller;
+ my $caller = caller; no strict "refs";
{
*{"${caller}::configDumpENV"} = \&dumpENV;
*{"${caller}::anon"} = \&anon;
our $dataItemCounter = int(0);
sub new { my ($class, $ele, $ins, $val) = @_;
- my $priority = ($val =~ s/_HAS_PROCESSING_PRIORITY_//si)?1:0;
+ my $priority = ($val =~ s/CNFMETA::HAS_PRIORITY//sexi)?1:0;
bless {
ele => $ele,
aid => $dataItemCounter++,
}
#
-
-
###
# PropertyValueStyle objects must have same rule of how an property body can be scripted for attributes.
##
warn "Scalar argument passed $args, did you mean array to pass? For property $n=$ret\n"
unless $self and not $self->{ENABLE_WARNINGS}
}
- }
- return $$ret if ref($ret) eq "REF";
+ }
+ my $ref = ref($ret);
+ return $$ret if $ref eq "REF";
+ return $ret->val() if $ref eq "CNFNode";
return $ret;
}
return $anechoic;
if($t eq 'CONST' or $t eq 'CONSTANT'){#Single constant with mulit-line value;
$v =~ s/^\s//;
- $self->{$e} = $v if not $self->{$e}; # Not allowed to overwrite constant.
+ # Not allowed to overwrite constant. i.e. it could be DO_ENABLED which is restricted.
+ if (not $self->{$e}){
+ $self->{$e} = $v if not $self->{$e};
+ }else{
+ warn "Skipped constant detected assignment for '$e'.";
+ }
}
elsif($t eq 'VAR' or $t eq 'VARIABLE'){
$v =~ s/^\s//;
}
}elsif($t eq 'FILE'){#@TODO Test case this
- my ($i,$path,$cnf) = (0,"",$self->{CNF_CONTENT});
+ my ($i,$path,$cnf_file) = (0,"",$self->{CNF_CONTENT});
$v=~s/\s+//g;
- $path = substr($path, 0, rindex($cnf,'/')) .'/'.$v;
+ $path = substr($path, 0, rindex($cnf_file,'/')) .'/'.$v;
push @files, $path;
next if !$self->{'$AUTOLOAD_DATA_FILES'};
open(my $fh, "<:perlio", $path ) or CNFParserException->throw("Can't open $path -> $!");
}elsif($t eq 'INCLUDE'){
$includes{$e} = {loaded=>0,path=>$e,v=>$v};
}elsif($t eq 'TREE'){
- my $tree = CNFNode->new({'_'=>$e,script=>$v});
- $tree->{DEBUG} = $self->{DEBUG};
+ my $tree = CNFNode->new({'_'=>$e,'~'=>$v});
+ $tree->{DEBUG} = 1 if $self->{DEBUG};
$instructs{$e} = $tree;
}elsif($t eq 'TABLE'){ # This has now be late bound and send to the CNFSQL package. since v.2.6
SQL()->createTable($e,$v) } # It is hardly been used. But in future itt might change.
}
elsif($t eq 'DO'){
if($DO_ENABLED){
- ## no critic BuiltinFunctions::ProhibitStringyEval
- $v = eval $v;
- ## use critic
- chomp $v; $anons->{$e} = $v;
+ my $ret;
+ if (!$v){
+ $v = $e;
+ $e = 'LAST_DO';
+ }
+ my $meta = meta(ON_DEMAND());
+ if($v=~ s/($meta)//i){
+ $anons->{$e} = CNFNode -> new({'_'=>$e,'&'=>$v});
+ return;
+ }
+ ## no critic BuiltinFunctions::ProhibitStringyEval
+ $ret = eval $v if not $ret;
+ ## use critic
+ if ($ret){
+ chomp $ret;
+ $anons->{$e} = $ret;
+ }else{
+ $self->warn("Perl DO_ENABLED script evaluation failed to evalute: $e Error: $@");
+ $anons->{$e} = '<<ERROR>>';
+ }
}else{
$self->warn("DO_ENABLED is set to false to process property: $e\n")
}
+ }elsif($t eq 'LIB'){
+ if($DO_ENABLED){
+ if (!$v){
+ $v = $e;
+ $e = 'LAST_LIB';
+ }
+ try{
+ use Module::Load;
+ autoload $v;
+ $v =~ s/^(.*\/)*|(\..*)$//g;
+ $anons->{$e} = $v;
+ }catch{
+ $self->warn("Module DO_ENABLED library failed to load: $v\n");
+ $anons->{$e} = '<<ERROR>>';
+ }
+ }else{
+ $self->warn("DO_ENABLED is set to false to process a LIB property: $e\n");
+ $anons->{$e} = '<<ERROR>>';
+ }
}
elsif($t eq 'PLUGIN'){
if($DO_ENABLED){
###
# Parses a CNF file or a text content if specified, for this configuration object.
##
-sub parse { my ($self, $cnf, $content, $del_keys) = @_;
+sub parse { my ($self, $cnf_file, $content, $del_keys) = @_;
my @tags;
if($self->{'ANONS_ARE_PUBLIC'}){
#private instructs on this parse call.
%instructs = ();
+ # We control from here the constances, as we need to unlock them if previous parse was run.
+ unlock_hash(%$self);
+
if(not $content){
- open(my $fh, "<:perlio", $cnf ) or die "Can't open $cnf -> $!";
+ open(my $fh, "<:perlio", $cnf_file ) or die "Can't open $cnf_file -> $!";
read $fh, $content, -s $fh;
close $fh;
- my @stat = stat($cnf);
+ my @stat = stat($cnf_file);
$self->{CNF_STAT} = \@stat;
- $self->{CNF_CONTENT} = $cnf;
+ $self->{CNF_CONTENT} = $cnf_file;
}else{
my $type =Scalar::Util::reftype($content);
if($type && $type eq 'ARRAY'){
$content = join "",@$content;
$self->{CNF_CONTENT} = 'ARRAY';
- }
+ }else{$self->{CNF_CONTENT} = 'script'};
}
$content =~ m/^\!(CNF\d+\.\d+)/;
my $CNF_VER = $1; $CNF_VER="Undefined!" if not $CNF_VER;
$self->{CNF_VERSION} = $CNF_VER if not defined $self->{CNF_VERSION};
- # We control from here the constances, need to unlock them if previous parse was run.
- unlock_hash(%$self);
my $spc = $content =~ /\n/ ? '(<{2,3}?)(<*.*?>*)(>{2,3})' : '(<{2,3}?)(<*.*?>*?)(>{2,3})$';
@tags = ($content =~ m/$spc/gms);
next if not $tag;
next if $tag =~ m/^(>+)|^(<<)/;
if($tag =~ m/^<(\w*)\s+(.*?)>*$/gs){ # Original fastest and early format: <<<anon value>>>
- my $p = $1;
+ my $t = $1;
my $v = $2;
- if(isReservedWord($self,$p)){
- my $isVar = ($p eq 'VARIABLE' || $p eq 'VAR');
- if($p eq 'CONST' or $isVar){ #constant multiple properties.
+ if(isReservedWord($self,$t)){
+ my $isVar = ($t eq 'VARIABLE' || $t eq 'VAR');
+ if($t eq 'CONST' or $isVar){ #constant multiple properties.
foreach my $line(split '\n', $v) {
$line =~ s/^\s+|\s+$//; # strip unwanted spaces
$line =~ s/\s*>$//;
}
}
}
- }else{
- my $t = $p; (m/(\w+)(.*)/s);
- my $e = $1;
- $v = $2;
- doInstruction($self,$e,$t,$v);
+ }else{
+ doInstruction($self,$v,$t,undef);
}
}else{
$v =~ s/\s*>$//;
- $anons->{$p} = $v;
+ $anons->{$t} = $v;
}
}else{
$ditms[@ditms] = $struct;
}
}
- my @del;
+ my @del; my $meta = meta(HAS_PRIORITY());
for my $idx(0..$#ditms) {
my $struct = $ditms[$idx];
my $type = ref($struct);
- if($type eq 'CNFNode' && ($struct->{'script'} =~ s/_HAS_PROCESSING_PRIORITY_//si)){ # This will within trim out the flag if found.
- $struct->validate($struct->{'script'}) if $self->{ENABLE_WARNINGS};
- $anons->{$struct->{'_'}} = $struct->process($self, $struct->{'script'});
- #splice @ditms, $idx,1; <- causing havoc when key order is scrambled. Weirdest thing in perl!
+ if($type eq 'CNFNode' && ($struct->{'~'} =~ s/$meta//i)){ # This will trim out the flag within if found.
+ $struct->validate() if $self->{ENABLE_WARNINGS};
+ $anons ->{$struct->name()} = $struct->process($self, $struct->script());
push @del, $idx;
}
}
my $struct = $ditms[$idx];
my $type = ref($struct);
if($type eq 'CNFNode'){
- $struct->validate($struct->{'script'}) if $self->{ENABLE_WARNINGS};
- $anons->{$struct->{'_'}} = $struct->process($self, $struct->{'script'});
+ $struct->validate() if $self->{ENABLE_WARNINGS};
+ $anons->{$struct->name()} = $struct->process($self, $struct->script());
push @del, $idx;
- }elsif($type eq 'InstructedDataItem' && $struct->{'priority'}){
+ }elsif($type eq 'InstructedDataItem' && $struct->{'priority'} || $struct->{'val'} =~ s/$meta//i){
my $t = $struct->{ins};
if($t eq 'PLUGIN'){
instructPlugin($self,$struct,$anons);
- }
+ }
push @del, $idx;
- }
+ }
}
while(@del){
splice @ditms,pop @del, 1
my $t = $struct->{ins};
if($t eq 'PLUGIN'){
instructPlugin($self,$struct,$anons);
+ }else{
+ warn "Undefined instruction detected: ".$struct->toString()
}
}
}
}
#Do scripted includes.
my @inc = sort values %includes;
- $includes{$0} = {loaded=>1,path=>$self->{CNF_CONTENT}}; #<- to prevent circular includes.
+ $includes{$0} = {loaded=>1, path=>$self->{CNF_CONTENT}}; #<- to prevent circular includes.
foreach my $file(@inc){
if(!$file->{loaded} && $file->{path} ne $self->{CNF_CONTENT}){
if(open(my $fh, "<:perlio", $file->{path} )){
sub log {
my $self = shift;
my $message = shift;
+ my $type = shift;
my $attach = join @_; $message .= $attach if $attach;
my %log = $self -> collection('%LOG');
my $time = DateTime->from_epoch( epoch => time )->strftime('%Y-%m-%d %H:%M:%S.%3N');
- if($message =~ /^ERROR/){
- warn $time . " " . $message;
+ $message = "$type $message" if 'WARNG';
+ if($message =~ /^ERROR/ || defined($type eq 'WARNG')){
+ warn $time . " " .$message;
}
elsif(%log && $log{console}){
- print $time . " " . $message ."\n"
+ print $time . " " .$message ."\n"
}
if(%log && $log{enabled} && $message){
my $logfile = $log{file};
use Carp qw(cluck); #what the? I know...
sub warn {
my $self = shift;
- my $message = shift;
- my $time = DateTime->from_epoch( epoch => time )->strftime('%Y-%m-%d %H:%M:%S.%3N');
- $message = "$time WARNG $message\t".$self->{CNF_CONTENT};
+ my $message = shift;
if($self->{ENABLE_WARNINGS}){
- $self -> log($message)
- }else{
- cluck $message
+ $self -> log($message,'WARNG');
}
}
sub trace {
$SQL->addStatement(@_) if @_;
return $SQL;
}
+our $JSON;
+sub JSON {
+ my $self = shift;
+ if(!$JSON){
+ require CNFtoJSON; $JSON = CNFtoJSON-> new();
+ }
+ return $JSON;
+}
+
sub END {
undef %ANONS;
lifelog.hopto.org / LifeLog.git / commitdiff