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){
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);
}
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){
}
if($isShortife && $body){
- _parseShortife(\$self,$body)
+ _parseShortife($parser,\$self,$body)
}
$self->{'@@'} = \@array if @array;
# 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;
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{
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});
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{
$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;
}
##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;
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};
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__};
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;
}
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;
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'){
}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}
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};
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;
$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")
}
$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.
}
$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);
}
next;
}
+
doInstruction($self,$e,$t,$v)
+
}
}
# Do scripted includes first. As these might set properties imported and processed used by the main script.
}
# 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);
}
}
@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.
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 ?"}
}
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);
###
# 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) = @_;
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
}
}
$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;
}
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){
}
}
}else{
- $ret = $self->anon($link);
+ $ret = $self->property($link);
+ $ret = $self->anon($link) if !$ret;
$ret = $self-> {$link} if !$ret;
}
return $ret;
lifelog.hopto.org / PerlCNF.git / commitdiff