##no critic qw(Subroutines::RequireFinalReturn)
##no critic Perl::Critic::Policy::ControlStructures::ProhibitMutatingListFunctions
-use constant VERSION => '3.3.2';
+use constant VERSION => '3.3.3';
use constant APP_STS => 'APP_SETTINGS';
our @files;
our %lists;
# Package fields are always global in perl!
###
our %ANONS;
-#private -> Instance fields:
- my $ANONS;
+###
+# Following is private -> Instance fields for package, every objects has its own not accessible from outside.
+###
+ my $anechoic; #<- Not setting here by purpose to package global. As anon sub here is ideally an method.
my @includes; my $CUR_SCRIPT;
my %instructs;
my $IS_IN_INCLUDE_MODE;
};
}
$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 ($self->{'ANONS_ARE_PUBLIC'}){
+ $anechoic = \%ANONS;
+ }else{
+ #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__} = {};
+ $anechoic = $self->{__ANONS__};
}
+
if(exists $self->{'%LOG'}){
if(ref($self->{'%LOG'}) ne 'HASH'){
die '%LOG'. "passed attribute is not an hash reference."
}
###
-# Post parsing instructed special item objects. They have lower priority to Order of apperance and from CNFNodes.
+# Post parsing instructed special item objects. They have lower priority to Order of appearance and from CNFNodes.
##
package InstructedDataItem {
our %counters;
- sub new { my ($class, $ele, $ins, $val) = @_;
- my $priority = ($val =~ s/$meta_has_priority/""/sexi)?2:3; $val =~ s/$meta_priority/""/sexi;
+ sub new { my ($class, $ele, $ins, $val, $aid) = @_;
+ my $priority = ($val =~ s/$meta_has_priority/""/sexi)?2:3;
+ $val =~ s/$meta_priority/""/sexi;
$priority = $2 if $2;
my $dataItemCounter;
if(exists $counters{$ele}){
$dataItemCounter = $counters{$ele};
}else{
- $dataItemCounter = {aid=>int(0)};
- $counters{$ele} = $dataItemCounter;
+ $dataItemCounter = {aid=>int(0)};
+ $counters{$ele} = $dataItemCounter;
}
bless {
ele => $ele,
# They can be; and are only dynamically set via the config instance directly.
# That is, if it has the ANONS_ARE_PUBLIC property set, and by using the empty method of anon() with no arguments.
# i.e. ${CNFParser->new()->anon()}{'MyDynamicAnon'} = 'something';
-# However a private config instance, will have its own anon's. And could be read only if it exist as a property, via this anon(NAME) method.
+# However a private config instance, will have its own anon's. And could be read only if it exist as an property, via this anon(NAME) method.
# This hasn't been yet fully specified in the PerlCNF specs.
# i.e. ${CNFParser->new({ANONS_ARE_PUBLIC=>0})->anon('MyDynamicAnon') # <-- Will not be available.
##
sub anon { my ($self, $n, $args)=@_;
- my $anechoic = \%ANONS;
+
+ my $this_anechoic;
+
if(ref($self) ne 'CNFParser'){
$n = $self;
- }elsif (not $self->{'ANONS_ARE_PUBLIC'}){
- $anechoic = $self->{'__ANONS__'};
+ $this_anechoic = $anechoic #To what ever is globally set.
+ }else{
+ $this_anechoic = $self->{ANONS_ARE_PUBLIC} ? \%ANONS: $self->{__ANONS__};
}
if($n){
- my $ret = %$anechoic{$n};
+ my $ret = %$this_anechoic {$n};
return if !$ret;
if($args){
my $ref = ref($args);
my @arr = ($ret =~ m/(\$\$\$.+?\$\$\$)/gm);
foreach my $find(@arr) {# <- MACRO TAG translate. ->
my $s= $find; $s =~ s/^\$\$\$|\$\$\$$//g;#
- my $r = %$anechoic{$s};
+ my $r = $this_anechoic -> {$s};
if(!$r && exists $self->{$s}){#fallback to maybe constant property has been seek'd?
$r = $self->{$s};
}
$cnt++;
}
}else{
- my $val = %$anechoic{$args};
+ my $val = $this_anechoic->{$args};
$ret =~ s/\$\$\$$args\$\$\$/$val/g;
warn "Scalar argument passed $args, did you mean array to pass? For property $n=$ret\n"
unless $self and not $self->{ENABLE_WARNINGS}
}
}
my $ref = ref($ret);
+ return $ret if $ref eq '';
return $$ret if $ref eq "REF";
return $ret->val() if $ref eq "CNFNode";
return $ret;
}
- return $anechoic;
+ return $this_anechoic;
}
###
#private to parser sub.
sub doInstruction { my ($self,$e,$t,$v) = @_;
- my $DO_ENABLED = $self->{'DO_ENABLED'}; my $priority = 0; my $isMetaConst;
+ my $DO_ENABLED = $self->{'DO_ENABLED'}; my $priority = 4; my $isMetaConst;
+ if(!$t && !$v && ref($e) eq 'InstructedDataItem'){
+ my $itm = $e;
+ $e = $itm->{ele} . $itm ->{aid};
+ $t = $itm->{ins};
+ $v = $itm->{val};
+ $priority = $itm->{'^'};
+ }
$t = "" if not defined $t;
if($t eq 'CONST' or $t eq 'CONSTANT'){#Single constant with mulit-line value;
# It is NOT allowed to overwrite constant.
}
elsif($t eq 'VAR' or $t eq 'VARIABLE'){
$v =~ s/^\s//;
- $ANONS->{$e} = $v;
+ $anechoic->{$e} = $v;
}
elsif($t eq 'DATA'){
$self->doDATAInstructions_($e,$v)
if($isMetaConst){
$self ->{$e} = $v
}else{
- $ANONS->{$e} = $v
+ $anechoic->{$e} = $v
}
}elsif($t eq 'FILE'){#@TODO Test case this
$self->doLoadDataFile($e,$v);
if ($isMetaConst){
$self -> {$e} = $v;
}else{
- $ANONS = $v
+ $anechoic = $v
}
}
my $prc_last = ($v =~ s/($meta_process_last)/""/ei)?1:0;
$includes[@includes] = {script=>$v,local=>$CUR_SCRIPT,loaded=>0, prc_last=>$prc_last};
}elsif($t eq 'TREE'){
my $tree = 0;
- if (!$v){
- $v = $e;
- $e = 'LAST_DO';
+ if( !$v ){
+ $v = $e;
+ $e = CNFMeta::ANN();
}
if( $v =~ s/($meta_has_priority)/""/ei ){
$priority = 1;
if( $v =~ s/$meta_priority/""/sexi ){
$priority = $2;
}
- $tree = CNFNode->new({'_'=>$e,'~'=>$v,'^'=>$priority});
- $tree->{DEBUG} = 1 if $self->{DEBUG};
- $instructs{$e} = \$tree;
+ $tree = CNFNode->new({'_'=>$e,'~'=>$v,'^'=>$priority});
+ $tree->{DEBUG} = 1 if $self->{DEBUG};
+ $instructs{$e} = \$tree;
}elsif($t eq 'TABLE'){ # This all have now be late bound and send via the CNFSQL package. since v.2.6
# It is hardly been used. But in the future this might change.
my $type = "NONE"; if ($v =~ 'AUTOINCREMENT'){$type = "AUTOINCREMENT"}
my $ret;
if (!$v){
$v = $e;
- $e = 'LAST_DO';
+ $e = CNFMeta::ANN();
}
if( $v =~ s/($meta_has_priority)/""/ei ){
$priority = 1;
$priority = $2;
}
if( $v=~ s/($meta_on_demand)/""/ei ){
- $ANONS->{$e} = CNFNode -> new({'_'=>$e,'&'=>$v,'^'=>$priority});
+ $anechoic->{$e} = CNFNode -> new({'_'=>$e,'&'=>$v,'^'=>$priority});
return;
}
## no critic BuiltinFunctions::ProhibitStringyEval
## use critic
if ($ret){
chomp $ret;
- $ANONS->{$e} = $ret;
+ $anechoic->{$e} = $ret;
}else{
$self->warn("Perl DO_ENABLED script evaluation failed to evalute: $e Error: $@");
- $ANONS->{$e} = '<<ERROR>>';
+ $anechoic->{$e} = '<<ERROR>>';
}
}else{
$self->warn("DO_ENABLED is set to false to process property: $e\n")
use Module::Load;
autoload $v;
$v =~ s/^(.*\/)*|(\..*)$//g;
- $ANONS->{$e} = $v;
+ $anechoic->{$e} = $v;
}catch{
$self->warn("Module DO_ENABLED library failed to load: $v\n");
- $ANONS->{$e} = '<<ERROR>>'
+ $anechoic->{$e} = '<<ERROR>>'
}
}else{
$self->warn("DO_ENABLED is set to false to process a LIB property: $e\n");
- $ANONS->{$e} = '<<ERROR>>';
+ $anechoic->{$e} = '<<ERROR>>';
}
}
elsif($t eq 'PLUGIN'){
#Register application statement as either an anonymous one. Or since v.1.2 a listing type tag.
if($e !~ /\$\$$/){ #<- It is not matching {name}$$ here.
if($self->{'HAS_EXTENSIONS'}){
- $ANONS->{$e} = InstructedDataItem->new($e,$t,$v)
+ $anechoic->{$e} = InstructedDataItem->new($e,$t,$v)
}else{
- $v = $t if not $v;
- if($e=~/^\$/){
- $self->{$e} = $v if !$self->{$e}; # Not allowed to overwrite constant.
- }else{
- $ANONS->{$e} = $v
- }
+ $v = $t if not $v;
+ if($e=~/^\$/){
+ $self->{$e} = $v if !$self->{$e}; # Not allowed to overwrite constant.
+ }else{
+ $anechoic->{$e} = $v
+ }
}
}
else{
$tag = $kv[1];
$i = index $tag, "\n";
if($i==-1){
- $tag = $v = substr $tag, 0, (rindex $tag, ">>");
+ $tag = $v = substr $tag, 0, (rindex $tag, ">>");
}
else{
- $v = substr $tag, $i+1, (rindex $tag, ">>")-($i+1);
- $tag = substr $tag, 0, $i;
+ $v = substr $tag, $i+1, (rindex $tag, ">>")-($i+1);
+ $tag = substr $tag, 0, $i;
}
if($tag eq 'DATA'){
$self->doDATAInstructions_($e,$v)
}
}
##
-# DATA instructions are not preserved as CNF script values as would be redundand and a waist.
-# They by default are only META translated into tables for efficiancy by data property name.
+# DATA instructions are not preserved as CNF script values as would be redundant and a waist.
+# They by default are only META translated into tables for efficiency by data property name.
#private
sub doDATAInstructions_{ my ($self,$e,$v,$t,$d)=@_;
my $add_as_SQLTable = $v =~ s/${meta('SQL_TABLE')}/""/sexi;
my @hdr; my @rows; my $autonumber = 0;
my $ref = $self->{__DATA__}{$e};
if($ref){
- $ref = $$ref;
- @hdr = @{$ref->{header}};
- @rows= @{$ref->{data}};
- $autonumber = $ref->{auto}; $isAutonumber = 1 if($autonumber || $isAutonumber);
+ $ref = $$ref;
+ @hdr = @{$ref->{header}};
+ @rows= @{$ref->{data}};
+ $autonumber = $ref->{auto}; $isAutonumber = 1 if($autonumber || $isAutonumber);
}
$v=~ s/^\s*//gm;
foreach my $row(split(/~\s/,$v)){
sub parse { my ($self, $cnf_file, $content, $del_keys) = @_;
my @tags;
- if($self->{'ANONS_ARE_PUBLIC'}){
- $ANONS = \%ANONS;
- }else{
- $ANONS = $self->{'__ANONS__'};
- }
+ $cnf_file = $cnf_file -> {path} if ref($cnf_file) eq 'CNFGlobalFile';
# We control from here the constances, as we need to unlock them if a previous parse was run.
unlock_hash(%$self);
foreach my $tag (@tags){
next if not $tag;
next if $tag =~ m/^(>+)|^(<<)/;
- if($tag =~ m/^<(\w*)\s+(.*?)>*$/gs){ # Original fastest and early format: <<<anon value>>>
+ if($tag =~ m/^<
\s*(\w*)\s+(.*?)>*$/gs){ # Original fastest and early format: <<<anon value>>>
my $t = $1;
my $v = $2;
if(isReservedWord($self, $t)){
$line = $3; $line =~ s/^\s*(['"])(.*)\g{1}$/$2/ if $line;#strip quotes
if(defined $name){
if($isVar && not $isMETAConst){
- $ANONS ->{$name} = $line if $line
+ $anechoic ->{$name} = $line if $line
}else{
$name =~ s/^\$// if $isMETAConst;
# It is NOT allowed to overwrite a constant, so check an issue warning.
$t = $1;
$v = $2;
}
- $ANONS->{$t} = $v;
+ $anechoic->{$t} = $v;
}
}else{
# Check if very old format and don't parse the data for old code compatibility to (still) do it.
# This is interesting, as a newer format file is expected to use the DATA instruction and final data specified script rules.
if($CNF_VER eq 'CNF2.2' && $tag =~ m/(\w+)\s*(<\d+>\s)\s*(.*\n)/mg){#It is old DATA format annon
- $e = $1;
- $t = $2;
- $v = substr($tag,length($e)+length($t));
- $ANONS->{$e} = $v;
- next;
+ $e = $1;
+ $t = $2;
+ $v = substr($tag,length($e)+length($t));
+ $anechoic->{$e} = $v;
+ next;
}
# Before mauling into possible value types, let us go for the full expected tag specs first:
# <<{$sig}{name}<{INSTRUCTION}>{value\n...value\n}>>
}
}else{
#############################################################################
- $tag =~ m/\s*([@%\$\.\/\w]+)\s* # The name.
- ([ <>\n]) # begin or close of instruction, where '\n' mark in script as instruction less.
- ([^<^>^^\n]+) # instruction or value of anything
- ([<>\n]?) # close mark for instruction or is less if \n encountered before.
+ $tag =~ m/\s*([@%\$\w\/\.]+)\s* # The name.
+ ([ <>\n]*)? # begin or close of instruction, where '\n' mark in script as instruction less.
+ ([^<>\n]+) # instruction or value of anything
+ ([ <>\n])? # close mark for instruction or is less if \n encountered before.
(.*) # actual value is the rest.
(>$)* # capture above value up to here from buffer, i.e. if coming from a >>> tag.
- /gmxs; ###############################################################################
+ /gmsx; ###############################################################################
$e =$1;
if($e eq '@' or $2 eq '<' or ($2 eq '>' and !$4)){
@array = @{$lists{$e}};
}
if(!$t or $t ne 'DATA'){
- push @array, InstructedDataItem -> new($e, $t, $v);
- $lists{$e} = \@array;
- next;
+ push @array, InstructedDataItem -> new($e, $t, $v);
+ $lists{$e} = \@array;
+ next;
}
}elsif ($e eq '@'){#collection processing.
my $isArray = $t=~ m/^@/;
my $macro = 0;
if(exists($properties{$t})){
if($self->isReservedWord($t)){
- $self->warn("Skipped a try to overwrite a reserved property -> $t.");
- next
+ $self->warn("Skipped a try to overwrite a reserved property -> $t.");
+ next
}else{
- %hsh = %{$properties{$t}}
+ %hsh = %{$properties{$t}}
}
}else{
%hsh =();
my @arr = ($value =~ m/(\$\$\$.+?\$\$\$)/gm);
foreach my $find(@arr) {
my $s = $find; $s =~ s/^\$\$\$|\$\$\$$//g;
- my $r = $ANONS->{$s};
+ my $r = $anechoic->{$s};
$r = $self->{$s} if !$r;
$r = $instructs{$s} if !$r;
CNFParserException->throw(error=>"Unable to find property for $t.$name -> $find\n",show_trace=>1) if !$r;
}
# Do those autonumbering list anons, and for pre instruction processing prepare if have it.
if(%lists){
- foreach my $arr(values %lists){
- foreach my $item(@$arr){
- my $e = $item->{ele} . $item ->{aid};
- doInstruction($self, $e, $item->{ins},$item->{val});
- }
+ foreach my $arr(values %lists){
+ foreach my $itm(@$arr){
+ doInstruction($self, $itm);
+ }
}
undef %InstructedDataItem::counters;
}
if(%instructs && not $IS_IN_INCLUDE_MODE){
my @items;
foreach my $e(keys %instructs){
- my $struct = $instructs{$e};
- my $type = ref($struct);
+ my $struct = $instructs{$e};
+ my $type = ref($struct);
if ($type eq 'REF'){
$struct = $$struct;
- $type = ref($struct);
+ $type = ref($struct);
}
if($type eq 'String'){
- my $v = $struct;
+ my $v = $struct;
my @arr = ($v =~ m/(\$\$\$.+?\$\$\$)/gm);
foreach my $find(@arr) {# <- MACRO TAG translate. ->
my $s= $find; $s =~ s/^\$\$\$|\$\$\$$//g;#
- my $r = %$ANONS{$s};
+ my $r = %$anechoic{$s};
$r = $self->{$s} if !$r;
if(!$r){
$self->warn("Unable to find property to translate macro expansion: $e -> $find\n");
$v =~ s/\Q$find\E/$r/g;
}
}
- $ANONS->{$e}=$v;
+ $anechoic->{$e}=$v;
}else{
$items[@items] = $struct;
}
my $type = ref($struct);
if($type eq 'CNFNode' && $struct-> priority() > 0){
$struct->validate() if $self->{ENABLE_WARNINGS};
- $ANONS ->{$struct->name()} = $struct->process($self, $struct->script());
+ if($struct->name() eq CNFMeta::ANN()){
+ my $anode = $struct->process($self, $struct->script());
+ foreach my $node($$anode->nodes()){
+ $anechoic ->{$node->name()} = \$node;
+ }
+ }else{
+ $anechoic ->{$struct->name()} = $struct->process($self, $struct->script());
+ }
splice @items, $idx, 1
}
}
my $type = ref($struct);
if($type eq 'CNFNode'){
$struct->validate() if $self->{ENABLE_WARNINGS};
- $ANONS->{$struct->name()} = $struct->process($self, $struct->script());
+ $anechoic->{$struct->name()} = $struct->process($self, $struct->script());
}elsif($type eq 'InstructedDataItem'){
my $t = $struct->{ins};
if($t eq 'PLUGIN'){
return 1;
}
else{
- $prp = $ANONS{$property};
+ $prp = $anechoic->{$property};
$prp = $self->{$property} if !$prp;
if (!$prp){
$buffer = "<<ERROR<$property>Property not found!>>>\n"
$message = "$type $message" if $isWarning;
if($message =~ /^ERROR/ || ($isWarning && $self->{ENABLE_WARNINGS})){
- $message =~ s/(\s+line\s)(\d+)\.*\s+/:$2\n/gm;
- warn $time . " " .$message;
+ $message =~ s/(\s+line\s)(\d+)\.*\s+/:$2\n/gm;
+ warn $time . " " .$message;
}
elsif(%log && $log{console}){
- print $time . " " .$message ."\n"
+ print $time . " " .$message ."\n"
}
if(%log && _isTrue($log{enabled}) && $message){
my $dir = $log{directory}; $dir = '.' if not $dir; $dir .= '/' if $dir !~ /\/$/;
}
###
-# CNFNodes are kept as anons by the TREE instruction, but these either could have been futher processed or
-# externaly assigned too as nodes to the parser.
+# CNFNodes are kept as anons by the TREE instruction, but these either could have been further processed or
+# externally assigned too as nodes to the parser.
###
our %NODES;
sub addTree {
$NODES{$name} = $node;
}
}
-### Utility way to obtain CNFNodes from a configuration.
+### Utility way to obtain CNFNodes from an configuration.
sub getTree {
my ($self, $name) = @_;
return $NODES{$name} if exists $NODES{$name};
if(ref($ret) eq 'CNFNode'){
return \$ret;
}
- return;
+ return $ret
}
##
-# Conveniently ribs an cnf file for an pl source file to be next too in marriage.
+# Conveniently ribs an cnf file for an pl source file to be next to in marriage.
# Ribs means the config file is same name next to it.
# @$const - Dynamic instance assignable hash with constances, optional can be undef.
# @$file - Path to CNF file if missing will be created.
lifelog.hopto.org / PerlCNF.git / commitdiff