From 9955d55197440fd4dd3f56e2017c00ab9f03da2d Mon Sep 17 00:00:00 2001 From: Will Budic Date: Wed, 19 Mar 2025 04:59:54 +1100 Subject: [PATCH] Linking in Shortifs implemented. --- system/modules/CNFGlobalFile.pm | 2 +- system/modules/CNFNode.pm | 44 +++++++++--- system/modules/CNFParser.pm | 123 +++++++++++++++++++++----------- 3 files changed, 117 insertions(+), 52 deletions(-) diff --git a/system/modules/CNFGlobalFile.pm b/system/modules/CNFGlobalFile.pm index 817887b..944cade 100644 --- a/system/modules/CNFGlobalFile.pm +++ b/system/modules/CNFGlobalFile.pm @@ -45,7 +45,7 @@ sub _load($self){ close $fh; my @stat = stat($self->{path}); $self -> {content_date} = time; - $self -> {content_length} = $stat[9]; + $self -> {content_length} = $stat[7]; $self -> {content} = \$content; return $self; } diff --git a/system/modules/CNFNode.pm b/system/modules/CNFNode.pm index 083e212..00e5a9d 100644 --- a/system/modules/CNFNode.pm +++ b/system/modules/CNFNode.pm @@ -365,7 +365,7 @@ sub node { foreach my $next(@$children){ $self = $next; $ret = EMPTY; for my $i(0..@arr-1){ - my $name = $arr[$i]; + my $name = $arr[$i]; my $attr = $self->{$name}; return $attr if $attr && $i == @arr-1; if($next->{'_'} eq $name){ @@ -506,7 +506,7 @@ sub process { my $property = CNFNode->new({'_'=>$sub, '@' => \$self}); my $a = $isArray; if($isShortife){ - _parseShortife(\$property,$body); + _parseShortife($parser,\$property,$body); $isShortife = 0 }else{ $property -> process($parser, $body); @@ -577,11 +577,16 @@ sub process { } next }elsif($val){ - $val = $self->{'#'}; - if($val){ - $self->{'#'} = qq($val\n$ln\n); + if($isShortife){ + $body .= qq($val __~\n$ln\n); undef $val; + next }else{ - $self->{'#'} = qq($ln\n); + $val = $self->{'#'}; + if($val){ + $self->{'#'} = qq($val\n$ln\n); + }else{ + $self->{'#'} = qq($ln\n); + } } } elsif($opening < 1 && not $isShortife){ @@ -620,7 +625,7 @@ sub process { } if($isShortife && $body){ - _parseShortife(\$self,$body) + _parseShortife($parser,\$self,$body) } $self->{'@@'} = \@array if @array; @@ -641,7 +646,7 @@ sub process { # Processor of Shortife parsing format for CNFNodes line by line from a body of text in some script. ## sub _parseShortife { - my ($root, $body, $sub, $parent, $prev) = @_; my $counter = 0; + my ($parser, $root, $body, $sub, $parent, $prev) = @_; my $counter = 0; cluck "Root not passed!".$root->toScript() if !$root; cluck "Root to assigned a body not passed by reference ->".$root->toPath() if ref ($root) ne 'REF'; $parent = $root; @@ -713,7 +718,7 @@ sub _parseShortife { next }elsif($nest eq '|'){ my $ptr = $$parent; my @parr; - $sub = CNFNode->new({'_' => $name, '@' => \$ptr}); + $sub = CNFNode->new({'_' => $name, '@' => \$ptr}); if($name eq '@@'){ @parr = @{$ptr->{'@@'}} if exists $ptr->{'@@'}; }else{ @@ -729,8 +734,8 @@ sub _parseShortife { next } $nest = $sel[0]; $nest=~s/[\s_]*$//g; - if(!$sub && $root->{'_'} eq CNFMeta::ANN()){ - $root->{'_'} = $nest; + if(!$sub && $$root->{'_'} eq CNFMeta::ANN()){ + $$root->{'_'} = $nest; $sub = $root; }elsif($nest eq '@@'){ my $node = new({'_' => $nest, '@' => \$parent}); @@ -758,6 +763,9 @@ sub _parseShortife { elsif (defined $sel[2] && defined $sel[3]){ my $attribute = $sel[2]; $attribute =~ s/^\s*|\s*$//g; my $value = $sel[3]; $value =~ s/^\s*|\s*$//g; + if($value =~ m/[<\[]\*[<\[](.*)[]>\]]\*[>\]]/){ + $value = $$root -> obtainLink($parser, $1) + } if($sub){ $sub -> {$attribute} = $value }else{ @@ -797,6 +805,20 @@ sub obtainLink { $ret = \&{+$link}($self); } } + # Check first if it is a data set property by some plugin? + # Since CNF properties or collections are global and to be avoid. + $ret = $parser->data()->{$link} if !$ret; + if($ret && ref($ret) eq 'ARRAY'){ + my $pkg = @$ret[0]; + my $sub = @$ret[1]; + use Module::Loaded qw(is_loaded); + if(is_loaded($pkg)){ + my $obj = $pkg->new(undef); + $ret = $obj->$sub(@$ret[2]); + } + + } + #Let's anything else next. $ret = $parser->obtainLink($link) if !$ret; return $ret; } diff --git a/system/modules/CNFParser.pm b/system/modules/CNFParser.pm index a4c9ca7..1f736d2 100644 --- a/system/modules/CNFParser.pm +++ b/system/modules/CNFParser.pm @@ -19,7 +19,7 @@ require CNFDateTime; ##no critic qw(Subroutines::RequireFinalReturn) ##no critic Perl::Critic::Policy::ControlStructures::ProhibitMutatingListFunctions -use constant VERSION => '3.3.3'; +use constant VERSION => '3.3.4'; use constant APP_STS => 'APP_SETTINGS'; our @files; our %lists; @@ -72,9 +72,9 @@ sub new { my ($class, $path, $attrs, $del_keys, $self) = @_; 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 ignored. - DEBUG => 0, # Not internally used by the parser, but possible a convenience bypass setting for code using it. + DEBUG => 0, # Not critical to the parser, but possible a convenience bypass setting for code using it. CNF_CONTENT => "", # Origin of the script, this will be set by the parser, usually the path of a script file or is direct content. - RUN_PROCESSORS => 1, # When enabled post parse processors are run, are these outside of the scope of the parsers executions. + RUN_PROCESSORS => 1, # When enabled post parse processors are run, these are outside of the scope of the parsers executions. }; } $CONSTREQ = $self->{CONSTANT_REQUIRED}; @@ -82,7 +82,7 @@ sub new { my ($class, $path, $attrs, $del_keys, $self) = @_; if ($self->{'ANONS_ARE_PUBLIC'}){ $anechoic = \%ANONS; }else{ - #Not public, means are private to this object, that is, anons are not static. + #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__}; @@ -175,7 +175,7 @@ package InstructedDataItem { our %counters; sub new { my ($class, $ele, $ins, $val, $aid) = @_; - my $priority = ($val =~ s/$meta_has_priority/""/sexi)?2:3; + my $priority = ($val =~ s/$meta_has_priority/""/sexi)?2:($val =~ s/$meta_process_last/""/sexi)?5:3; $val =~ s/$meta_priority/""/sexi; $priority = $2 if $2; my $dataItemCounter; @@ -227,6 +227,12 @@ package PropertyValueStyle { } bless $self, $class } + sub setParameters{ + my ($self, $prms) = @_; + if(ref($prms) eq 'HASH' && exists ${$self->{plugin}}->{params}){ + ${$self->{plugin}}->setParameters($prms); + } + } sub setPlugin{ my ($self, $obj) = @_; $self->{plugin} = \$obj; @@ -341,7 +347,7 @@ sub property { my($self, $name) = @_; if(exists($properties{$name})){ my $ret = $properties{$name}; my $ref = ref($ret); - if($ref eq 'REF'){ + if($ref eq 'REF'){ #This should ideally return and dereferenced to an reference. return $$ret }elsif($ref eq 'ARRAY'){ @@ -349,7 +355,7 @@ sub property { my($self, $name) = @_; }elsif($ref eq 'PropertyValueStyle'){ return ${$ret->{plugin}} if $ret->{instructor} eq APP_STS; return $ret - }elsif($ref eq 'SCALAR'){ + }elsif($ref eq 'SCALAR'){ return $ret }else{ return %{$ret} @@ -447,7 +453,7 @@ sub template { my ($self, $property, %macros) = @_; sub doInstruction { my ($self,$e,$t,$v) = @_; my $DO_ENABLED = $self->{'DO_ENABLED'}; my $priority = 4; my $isMetaConst; if(!$t && !$v && ref($e) eq 'InstructedDataItem'){ - my $itm = $e; + my $itm = $e; $e = $itm->{ele} . $itm ->{aid}; $t = $itm->{ins}; $v = $itm->{val}; @@ -516,6 +522,9 @@ sub doInstruction { my ($self,$e,$t,$v) = @_; if( $v =~ s/$meta_priority/""/sexi ){ $priority = $2; } + if( $v =~ s/$meta_process_last/""/sexi ){ + $priority = 4; + } $tree = CNFNode->new({'_'=>$e,'~'=>$v,'^'=>$priority}); $tree->{DEBUG} = 1 if $self->{DEBUG}; $instructs{$e} = \$tree; @@ -585,7 +594,7 @@ sub doInstruction { my ($self,$e,$t,$v) = @_; $self->warn("DO_ENABLED is set to false to process following plugin: $e\n") } } - elsif($t eq 'PROCESSOR'){ + elsif($t eq 'PROCESSOR' && $DO_ENABLED){ if(not $self->registerProcessor($e, $v)){ CNFParserException->throw("PostParseProcessor Registration Failed for '<<$e<$t>$v>>'!\t") } @@ -602,9 +611,13 @@ sub doInstruction { my ($self,$e,$t,$v) = @_; $self->instructPlugin(InstructedDataItem -> new($e, APP_STS, $v)); } elsif(exists $instructors{$t}){ - if(not $instructors{$t}->instruct($e, $v) && $self->{STRICT}){ + my $result = $instructors{$t}; + if(!$result && $self->{STRICT}){ CNFParserException->throw("Instruction processing failed for '<<$e<$t>>'!\t"); + }else{ + $result = $result->instruct($self,$t,$v); } + $properties{$e} = \$result; } else{ #Register application statement as either an anonymous one. Or since v.1.2 a listing type tag. @@ -845,7 +858,6 @@ sub parse { my ($self, $cnf_file, $content, $del_keys) = @_; } $anechoic->{$t} = $v; } - }else{ # Vars are e-element,t-token or instruction,v- for value, vv -array of the lot. my ($e,$t,$v,@vv); @@ -980,7 +992,9 @@ sub parse { my ($self, $cnf_file, $content, $del_keys) = @_; } next; } + doInstruction($self,$e,$t,$v) + } } # Do scripted includes first. As these might set properties imported and processed used by the main script. @@ -992,8 +1006,8 @@ sub parse { my ($self, $cnf_file, $content, $del_keys) = @_; } # Do those autonumbering list anons, and for pre instruction processing prepare if have it. if(%lists){ - foreach my $arr(values %lists){ - foreach my $itm(@$arr){ + foreach my $arr(values %lists){ + foreach my $itm(@$arr){ doInstruction($self, $itm); } } @@ -1031,20 +1045,32 @@ sub parse { my ($self, $cnf_file, $content, $del_keys) = @_; @items = sort {$a->{'^'} <=> $b->{'^'}} @items; #sort by priority; - for my $idx(0..$#items) { + for my $idx(0..$#items-1) { my $struct = $items[$idx]; my $type = ref($struct); - if($type eq 'CNFNode' && $struct-> priority() > 0){ - $struct->validate() if $self->{ENABLE_WARNINGS}; - 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 + if(not $type){ + CNFParserException->throw("Illegal struct encountered->$struct") if $struct + }else{ + my $priority = $struct-> {'^'}; + if($type eq 'CNFNode' && $priority > 0){ + $struct->validate() if $self->{ENABLE_WARNINGS}; + 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()); + $self->log("Processed -> ".$struct->name()) if $self->{DEBUG} + } + splice @items, $idx, 1 + }elsif($type eq 'InstructedDataItem' && $priority > 0 && $priority < 5){ + my $t = $struct->{ins}; + if($t eq 'PLUGIN'){ + instructPlugin($self, $struct); + splice @items, $idx, 1 + } + } } } #Now only what is left instructed data items or plugins, and nodes that have assigned last priority, if any. @@ -1053,11 +1079,19 @@ sub parse { my ($self, $cnf_file, $content, $del_keys) = @_; my $type = ref($struct); if($type eq 'CNFNode'){ $struct->validate() if $self->{ENABLE_WARNINGS}; - $anechoic->{$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()); + } + $self->log("Processed -> ".$struct->name()) if $self->{DEBUG} }elsif($type eq 'InstructedDataItem'){ my $t = $struct->{ins}; if($t eq 'PLUGIN'){ - instructPlugin($self,$struct); + instructPlugin($self, $struct); } }else{warn "What is -> $struct type:$type ?"} } @@ -1124,7 +1158,7 @@ sub instructPlugin { my ($self, $struct) = @_; try{ $properties{$struct->{'ele'}} = doPlugin($self, $struct); - $self->log("CNFParser plugin instructed -> ". $struct->{'ele'}); + $self->log("Plugin instructed -> ". $struct->{'ele'}); }catch($e){ if($self->{STRICT}){ CNFParserException->throw(error=>$e); @@ -1137,9 +1171,16 @@ sub instructPlugin { ### # Register Instructor on tag and value for to be externally processed. -# $package - Is the anonymouse package name. -# $body - Contains attribute(s) linking to method(s) to be registered. -# @TODO Current Under development. +# Instructor instance is global to the repository and can be registered to multiple different word instructions. +# Reasoning is that multiple and included CNF files can use own name for the instructor, but the instance is shared the same. +# Programmatically then the package code is used to provide additional settings, via private fields, if desired. +# Rather then make new instances with own private fields. Instructor currently os not an constructor, +# also receives for peruse the actual repository in unprotected state as part of the parsing process. +# Hence the DO_ENABLE setting is required to be true, this method to be ever called. +# +# $package - Is the instructor package name. +# $body - Contains attribute(s) linking and or as last instruction to be registered. +# Logs error - If another instructor type tries to register an previously already registered instruction word. ### sub registerInstructor { my ($self, $package, $body) = @_; @@ -1149,15 +1190,16 @@ sub registerInstructor { my @pair = $ln =~ /\s*(\w+)[:=](.*)\s*/; $ins = $1; $ins = $ln if !$ins; $mth = $2; - $args{$ins} = $mth if $ins =~ /[a-z]/i + $args{$ins} = $mth if $ins =~ /[a-z]/i && $mth } - if(exists $instructors{$ins}){ - $self -> error("$package<$ins> <- Instruction has been previously registered by: ".ref(${$instructors{$ins}})); + $ins =~ s/^\s*|\s*$//; + if(ref($instructors{$ins}) ne $package && exists $instructors{$ins}){ + $self -> error("$package<$ins> <- Instruction [$ins] has been previously registered by: ".ref(${$instructors{$ins}})); return; }else{ foreach(values %instructors){ - if(ref($$_) eq $package){ + if(ref($_) eq $package){ $obj = $_; last } } @@ -1172,16 +1214,16 @@ sub registerInstructor { $has_instruct = 1 if $_ eq "$package\::instruct"; } if(!$has_new){ - $self -> log("ERR $package<$ins> -> new() method not found for package."); + $self -> error("$package<$ins> -> new() method not found for package."); return; } if(!$has_instruct){ - $self -> log("ERR $package<$ins> -> instruct() required method not found for package."); + $self -> error("$package<$ins> -> instruct() required method not be found for package."); return; } $obj = $package -> new(\%args); } - $instructors{$ins} = \$obj + $instructors{$ins} = $obj } return \$obj; } @@ -1282,7 +1324,7 @@ sub doPlugin { elsif($pck && $prp && $sub){ ## no critic (RequireBarewordIncludes) require "$pck.pm" if $pck !~ /::/; - #Properties are global, all plugins share a %Settings property if specifed, otherwise the default will be set from here only. + #Properties are global, all plugins share a %Settings property if specified, otherwise the default will be set from here only. my $settings = $properties{'%Settings'}; if($settings){ foreach(keys %$settings){ @@ -1330,7 +1372,8 @@ sub obtainLink { } } }else{ - $ret = $self->anon($link); + $ret = $self->property($link); + $ret = $self->anon($link) if !$ret; $ret = $self-> {$link} if !$ret; } return $ret; -- 2.34.1