From 489597ebb8c5f393cb4e0e073664686288ceb5b0 Mon Sep 17 00:00:00 2001 From: Will Budic Date: Thu, 6 Feb 2025 09:48:33 +1100 Subject: [PATCH] Sarch and shortif algorithms revised and reimplemented. --- system/modules/CNFNode.pm | 577 +++++++++++++++++++++++--------------- 1 file changed, 352 insertions(+), 225 deletions(-) diff --git a/system/modules/CNFNode.pm b/system/modules/CNFNode.pm index be86980..ffb1fc6 100644 --- a/system/modules/CNFNode.pm +++ b/system/modules/CNFNode.pm @@ -4,33 +4,59 @@ package CNFNode; use strict; use warnings; +use Syntax::Keyword::Try; use Carp qw(cluck); require CNFMeta; CNFMeta::import(); sub new { my ($class, $attrs) = @_; - my $self = \%$attrs; - bless $self, $class; + my $self = \%$attrs; $self->{'_'} = '__NEW__' if not exists $self->{'_'}; + return bless $self, $class; } +sub _createNode { + return new CNFNode({'_'=>shift}) +} + +use constant PRIVATE_FIELDS => qr/@\$|[@#_~^&]/o; +use constant EMPTY => _createNode('EMPTY'); + +### +# Convenience method to check a scalar as reference if it is a CNF node. +### sub _isNode { return ref(shift) eq 'CNFNode' } - -use constant PRIVATE_FIELDS => qr/@\$|[@#_~^&]/o; -use constant EMPTY => new CNFNode; +### +# CNFNode uses symbols as opcodes for all its own internal field values, for efficiency. +### +sub name {shift -> {'_'}} # Name of this node. +sub parent {return shift -> {'@'}} # Its parent node, containing it. +sub isRoot {not exists shift -> {'@'}} # Root has no parent node, this checks this for this node. +sub script {shift -> {'~'}} # Usually contains the script that has build this root node and its children. +sub priority {shift -> {'^'}} # Usually internal, processing priority for parsing and construction of a tree. +sub evaluate {shift -> {'&'}} # Internal reserved setting to indicate a node or root has to evaluate further. ### -# CNFNode uses symbol offcodes for all its own field values, foe efficiancy. +# Each node can have an array of other named nodes. Number tagged (tag$$) by name nodes are also placed here. +# When so tagged, each node will have its own unique ordered number assigned +# for its name by under each parent from 01..n. +# This method returns this nodes assigned nodes. +### +sub nodes { + my $self = shift; my @ret; @ret = @{$self->{'@$'}} if exists $self->{'@$'}; + return @ret; +} +### +# Each node can separately have an array of special same @@ tagged of nodes called list nodes. +# This segregation makes searching and listing faster. +# i.e. If searching only in listed nodes from any path for nested named nodes, +# within them, this methodology makes this an breeze. +# This method returns this list separately contained from other the nodes. ### -sub name {shift -> {'_'}} -sub parent {shift -> {'@'}} -sub isRoot {not exists shift -> {'@'}} sub list {shift -> {'@@'}} -sub script {shift -> {'~'}} -sub priority {shift -> {'^'}} -sub evaluate {shift -> {'&'}} + ### # Obtains this nodes all public attributes. # What you usually only want. @@ -46,42 +72,16 @@ sub attributes { } return @attributes; } + ### -# Utility arrays any attributes by list requested. -# $node-> array('Name','#') will return node 'Name' attribute and value if it has it, onderwise undef for either. -### -sub array { - my $self = shift; - my @attributes = @_; - my @arr; - foreach my $next(@attributes){ - my $val = $self -> {$next}; - if(ref($val) eq 'SCALAR'){ - $val = $$val; - } - $arr[@arr] = $val#'['.$next.':'.$val.']'; - } - return @arr; -} -sub nodes { - my $self = shift; - my $ret = $self->{'@$'}; - if($ret){ - return @$ret; - } - return (); -} -### -# Add another CNFNode to this one, to become a its parent. +# Add another CNFNode to this one, to become its parent. # Returns $self so you can perl them, if you want.. ## sub add { my ($self, $node, @nodes) = @_; - my $prev = $self->{'@$'}; - if($prev) { + my $prev = $self->{'@$'}; + if ($prev) { @nodes = @$prev; - }else{ - @nodes = (); } $node->{'@'} = \$self; $nodes[@nodes] = $node; @@ -89,7 +89,7 @@ sub add { return $self; } ### -# Convenience method, returns string scalar value dereferenced (a copy) of the property value. +# Convenience method, returns string scalar value dereferenced (a copy) of the node value. ## sub val { my $self = shift; @@ -100,7 +100,8 @@ sub val { my $buf; my @arr = @{$self->{'@$'}}; foreach my $node(@arr){ - $buf .= $node -> val() ."\n"; + my $nv = $node -> val(); + $buf .= "$nv\n" if $nv } return $buf; } @@ -131,28 +132,44 @@ sub val { # -sub items(){ +### +# Utility arrays this nodes attributes by a list of names those requested being passed to this method. +# $node-> array('Name','#') will return node 'Name' attribute and value, if it has it, otherwise undef for either. +### +sub array { my $self = shift; - return $self -> {'@$'} + my @attributes = @_; + my @arr; + foreach my $next(@attributes){ + my $val = $self -> {$next}; + if(ref($val) eq 'SCALAR'){ + $val = $$val; + } + $arr[@arr] = $val + } + return @arr; } + ### # Search select nodes based on from a path statement. # It will always return an array for even a single subproperty with a passed path ending with (/*). -# The reason is several subproperties of the same name can be contained as elements of this node. +# The reason is several subproperties of the same name can be contained as nodes of this node. # It will return an array of list values with (@@). # Or will return an array of its shallow list of child nodes with (@$). # Or will return an scalar value of an attribute or an property with (#). # NOTICE - 20221222 Future versions might provide also for more complex path statements with regular expressions enabled. ### -sub find { +sub search { my ($self, $path, $ret, $prev, $seekArray,$ref)=@_; my (@arr,$seekPName); - foreach my $name(split(/\//, $path)){ next if !$name; + my @split_path = split(/\//, $path); shift @split_path if @split_path > 1 && $split_path[0] eq $self->{_}; + foreach my $name(@split_path){ + next if !$name; if($name eq '*'){ #return \@arr if @arr; # The path instructs to return an array, which is set but return is set to single only found element. - # foreach my $itm(@arr){ - # $self = $itm; - # } + foreach my $itm(@arr){ + $self = $itm; + } $seekPName = $self->{'_'} if ref($self) eq 'CNFNode'; $seekArray = 1; $ret = \@arr; @@ -190,7 +207,7 @@ sub find { if ($n->node($name)){ $ret = $n; last } - }### TODO - Search further elements if not found. Many to many. + }### TODO - Search further nodes if not found. Many to many. }elsif($ref eq "CNFNode" && $seekArray){ $ret = $ret->{$name}; next @@ -198,7 +215,17 @@ sub find { if (!$seekArray){ # This will initiate further search in subproperties names. $ret = $self->{'@$'}; - @arr = () + @arr = (); + if($name =~ m/(\w+)\*/){ #Wild carded path tag name. + $name = $1; + my @target = @$ret; + foreach my $ele(@target){ + if($ele->{_} =~ m/^$name/){ + $arr[@arr] = $ele + } + } + next; + } } } } @@ -219,31 +246,31 @@ sub find { @arr= @$ele; } $arr[@arr] = $node; - } - elsif($node->{'_'} eq $seekPName){ - my $seek = $node -> find("$seekPName/$name"); - $ref = ref($seek); - if($ref eq 'ARRAY'){ - @arr=(); - foreach my$nd(@{$seek}){ - my $child = $nd -> findChildrenByName($name); - $arr[@arr] = $child if $child - } - return \@arr if(@arr>1); - $ele = $arr[0]; - @arr=(); - }elsif($seekPName && $ref eq 'CNFNode'){ - $ele = $seek; - } - } - elsif($seekPName && $node->{'@'}){ - my $found = findChildrenByName($node,$name); - if($found){ - $ele = $found; - $found++; - next - } + elsif($seekPName){ + if($node->{'_'} eq $seekPName){ + my $seek = $node -> search($self->{'_'}."/$seekPName/$name"); + $ref = ref($seek); + if($ref eq 'ARRAY'){ + @arr=(); + foreach my$nd(@{$seek}){ + my $child = $nd -> findChildrenByName($name); + $arr[@arr] = $child if $child + } + return \@arr if(@arr>1); + $ele = $arr[0]; + @arr=(); + }elsif($ref eq 'CNFNode'){ + $ele = $seek; + } + }elsif($seekPName && $node->{'@'}){ + my $found = findChildrenByName($node,$name); + if($found){ + $ele = $found; + $found++; + next + } + } } } if(@arr>1){ @@ -291,7 +318,9 @@ sub find { return !$ret?\@arr: ref($ret) eq 'SCALAR' ? $$ret : $ret; } ## -# Convinence method to find lastChild or all chidren by a certain name. +# Convenience method to find lastChild or all children by a certain name. +# This is opposite to list() method which is an inbuilt array +# for consecutive @@ tagged nodes in a script not required to be named. ## sub findChildrenByName { my ($self, $name, $ret,@arr)=@_; @@ -309,33 +338,55 @@ sub findChildrenByName { } ### -# Similar to find, put simpler node by path routine. +# Similar to search(...), put simpler node by path routine. # Returns first node found based on path. ### sub node { - my ($self, $path, $ret)=@_; + my ($self, $path, $ret) = @_; if($path !~ /\//){ return $self->{$path} if exists $self->{$path}; $ret = $self->{'@$'}; if($ret){ - foreach(@$ret){ - if ($_->{'_'} eq $path){ - return $_; - } + foreach my $n(@$ret){ + # if(ref($n) ne'CNFNode'){cluck "$n is illegal node hash element in [".$self->toPath()."]" } + # else{ + if ($n->{'_'} eq $path){ + $ret = $n; last + } + # } } + return $ret } return EMPTY } - foreach my $name(split(/\//, $path)){ - $ret = $self->{'@$'}; - if($ret){ - foreach(@$ret){ - if ($_->{'_'} eq $name){ - $ret = $_; last + my @arr = split(/\//, $path); + my $children = $self->{'@$'}; + if($children){ + foreach my $next(@$children){ + $self = $next; $ret = EMPTY; + for my $i(0..@arr-1){ + my $name = $arr[$i]; + my $attr = $self->{$name}; + return $attr if $attr && $i == @arr-1; + if($next->{'_'} eq $name){ + $self = $next; + $ret = $next; + next + } + if($name eq '@@' && exists $ret->{'@@'}){ + return $ret->{'@@'} + } + if(exists $ret->{'@$'}){ + return $ret->{'@$'} if $name eq '@$' ; + foreach my $n(@{$ret->{'@$'}}){ + if ($n->{'_'} eq $name){ + $self = $n; + $ret = $n; + last + } } - } - }else{ - $ret = EMPTY; + } + } } } return $ret @@ -344,7 +395,7 @@ sub node { ### -# Outreached subs list of collected node links found in a property. +# Outreached subs list of collected node links found in a CNF property. my @linked_subs; ### @@ -353,12 +404,12 @@ my @linked_subs; sub process { my ($self, $parser, $script)=@_; - my ($sub, $val, $isArray,$isShortifeScript,$body) = (undef,0,0,0,""); + my ($sub, $val, $isArray,$isShortife,$body) = (undef,0,0,0,""); my ($tag,$sta,$end)=("","",""); my $meta_shortife = &meta_node_in_shortife; - my ($opening,$closing,$valing)=(0,0,0); + my ($opening,$closing,$valing,$shorting)=(0,0,0,0); my @array; - if(exists $self->{'_'} && $self->{'_'} eq '#'){ + if($self->{'_'} eq '#'){ $val = $self->{'#'}; if($val){ $val .= "\n$script"; @@ -371,12 +422,11 @@ sub process { foreach my $ln(@lines){ $ln =~ s/^\s+|\s+$//g; if(length ($ln)){ - my $isShortife = $ln =~ s/($meta_shortife)/""/sexi; + $isShortife = $ln =~ s/($meta_shortife)/""/sexi if !$isShortife; if($ln =~ /^([<>\[\]])(.*)([<>\[\]])$/ && $1 eq $3){ $sta = $1; $tag = $2; $end = $3; - $isShortifeScript = 1 if $isShortife; my $isClosing = ($sta =~ /[>\]]/) ? 1 : 0; if($tag =~ /^([#\*\@]+)[\[<](.*)[\]>]\/*[#\*\@]+$/){#<- The \/ can sneak in as included in closing tag. if($1 eq '*'){ @@ -388,53 +438,50 @@ sub process { }else{ #Is this a child node? if(exists $self->{'@'}){ - my @nodes; - my $prev = $self->{'@$'}; - if($prev) { - @nodes = @$prev; - }else{ - @nodes = (); - } - $nodes[@nodes] = CNFNode->new({'_'=>$link, '*'=>$rval,'@' => \$self}); - $self->{'@$'} = \@nodes; + my $prev = $self->{'@$'}; + my @nodes; + if($prev) { + @nodes = @$prev; + } + $nodes[@nodes] = CNFNode->new({'_'=>$link, '*'=>$rval,'@' => \$self}); + $self->{'@$'} = \@nodes; } else{ - #Links scripted in main tree parent are copied main tree attributes. - $self->{$link} = $rval + #Links scripted in main tree parent are copied main tree attributes. + $self->{$link} = $rval } } next }else{ - if(!$opening){warn "Anon link $link not located with $ln for node ".$self->{'_'}}; + if(!$opening){warn "Anon link $link not located with $ln for node -> ".$self->toPath()}; } }elsif($1 eq '@@'){ - if($opening==$closing){ - $array[@array] = $2; $val=""; - next - } + if($opening==$closing){ + $array[@array] = $2; $val=""; + next + } }else{ $val = $2; } }elsif($tag =~ /^(.*)[\[<]\/*(.*)[\]>](.*)$/ && $1 eq $3){ - if($opening){ - $body .= qq($ln\n) - } - else{ - my $property = CNFNode->new({'_'=>$1, '#' => $2, '@' => \$self}); - my @nodes; - my $prev = $self->{'@$'}; - if($prev) { - @nodes = @$prev; - }else{ - @nodes = (); - } - $nodes[@nodes] = $property; - $self->{'@$'} = \@nodes; + if($opening){ + $body .= qq($ln\n) + } + else{ + my $property = CNFNode->new({'_'=>$1, '#' => $2, '@' => \$self}); + my @nodes; + my $prev = $self->{'@$'}; + if($prev) { + @nodes = @$prev; + } + $nodes[@nodes] = $property; + $self->{'@$'} = \@nodes; } next }elsif($isClosing){ $opening--; $closing++; + }else{ $opening++; $closing--; @@ -458,12 +505,12 @@ sub process { }else{ my $property = CNFNode->new({'_'=>$sub, '@' => \$self}); my $a = $isArray; - if($isShortifeScript){ - _parseShortife($property,$body); - $isShortifeScript = 0 + if($isShortife){ + _parseShortife(\$property,$body); + $isShortife = 0 }else{ $property -> process($parser, $body); - } + } $isArray = $a; if($tag eq '@@'){ $array[@array] = $property; @@ -475,11 +522,9 @@ sub process { my $prev = $self->{'@$'}; if($prev) { @nodes = @$prev; - }else{ - @nodes = (); } $nodes[@nodes] = $property; - $self->{'@$'} = \@nodes; + $self->{'@$'} = \@nodes; } undef $sub; $body = $val = ""; } @@ -507,8 +552,6 @@ sub process { my $prev = $self->{'@$'}; if($prev) { @nodes = @$prev; - }else{ - @nodes = (); } $nodes[@nodes] = CNFNode->new({'_'=>$link, '*'=>$rval, '@' => \$self}); $self->{'@$'} = \@nodes; @@ -523,16 +566,14 @@ sub process { }elsif($2 eq '@@'){ $array[@array] = CNFNode->new({'_'=>$2, '#'=>$4, '@' => \$self}); }else{ - my $property = CNFNode->new({'_'=>$2, '#'=>$4, '@' => \$self}); - my @nodes; - my $prev = $self->{'@$'}; - if($prev) { - @nodes = @$prev; - }else{ - @nodes = (); - } - $nodes[@nodes] = $property; - $self->{'@$'} = \@nodes; + my $property = CNFNode->new({'_'=>$2, '#'=>$4, '@' => \$self}); + my $prev = $self->{'@$'}; + my @nodes; + if($prev) { + @nodes = @$prev; + } + $nodes[@nodes] = $property; + $self->{'@$'} = \@nodes; } next }elsif($val){ @@ -543,11 +584,7 @@ sub process { $self->{'#'} = qq($ln\n); } } - elsif($isShortife){ - $isShortifeScript = 1; $opening++; - next; - } - elsif($opening < 1){ + elsif($opening < 1 && not $isShortife){ if($ln =~m/^([<\[]@@[<\[])(.*?)([>\]@@[>\]])$/){ $array[@array] = $2; next; @@ -568,8 +605,13 @@ sub process { $val = $ln if $val; } } - # Very complex rule, allow #comment lines in buffer withing an node value tag, ie [#[..]#] - $body .= qq($ln\n) #if !$tag && $ln!~/^\#/ || $tag eq '#' + elsif($isShortife && not $shorting){ + if($body !~ m/_+[\/\\\|]*/){ + $shorting = $body; + $body = "" + } + } + $body .= qq($ln\n) } elsif($tag eq '#'){ $body .= qq(\n) @@ -577,8 +619,8 @@ sub process { } } - if($isShortifeScript && $body){ - _parseShortife($self,$body) + if($isShortife && $body){ + _parseShortife(\$self,$body) } $self->{'@@'} = \@array if @array; @@ -594,66 +636,151 @@ sub process { return \$self; } + +### +# Processor of Shortife parsing format for CNFNodes line by line from a body of text in some script. +## sub _parseShortife { - my($property,$body) = @_; - my ($sub,$prev,$cnt_nl,$bck_p); - while ($body =~ / (.*)__+ ([\\\|]|\/*) | (.*)[:=](.*) | (.*)\n/gmx){ - my @sel = @{^CAPTURE}; - if(defined $sel[0]){ - if ($sel[1]){ - my $t = substr $sel[1],0,1; - $bck_p=length($sel[1]); - my $parent = $sub; - if($t eq '\\'){ - $parent = $sub ? $sub : $property; - }elsif($t eq '|'){ - $parent = $sub ? $sub->parent() : $prev; - }elsif($t eq '/') { - while(--$bck_p>0){ - $parent = $parent -> parent() if $parent -> parent(); - my $ref = ref($parent); $parent = $$parent if $ref eq 'REF'; + my ($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; + $body =~ s/\#.*$//gm; + my %ords; + + while($body =~ (/ + \s*([^\n:~\/\\\|]*?)\s*_+([\/\\\|]*?)\s*\n | # Make next Node as subnode, parent node or go to Parent or + \s*([^\n]*?)\s*[:=]\s*([^\n]*?)\n|__~\n | # parse next line as an attribute and value for last node direction or + \s*(.*?)__~\s*\n # collect as current node value, or terminate multi-line node value.. + /gmsx)){ + my @sel = @{^CAPTURE}; + if(defined $sel[0] || defined $sel[1]){ + my $name = $sel[0]; $name =~ s/[\_\s]*$//g; + my $nest = $sel[1]; + if($name =~ /(\w+)\$\$$/){ + my $cnt_id = qq($$parent->name()./.$name); + my $cnt = $ords {$cnt_id}; $cnt = 0 if !$cnt; + $name = $1.CNFMeta::_zero_prefix(1, ++$cnt); + $ords {$cnt_id} = $cnt + } + if($nest =~ m/\\/){ + if($name){ + #my $ref = ref($parent); + my $ptr = $$parent; + my @parr; + if($name eq '@@'){ + @parr = @{$ptr->{'@@'}} if exists $ptr->{'@@'}; + }else{ + @parr = @{$ptr->{'@$'}} if exists $ptr->{'@$'}; } - if ($sel[0] eq ''){ - $sub = $parent; next + $sub = CNFNode->new({'_' => $name, '@' => \$ptr}); + $parr[@parr] = $sub; + if($name eq '@@'){ + $ptr -> {'@@'} = \@parr; + }else{ + $ptr -> {'@$'} = \@parr; } - } - $t = $sel[0]; $t=~s/[\s_]*$//g; - $sub = CNFNode->new({'_' => $t, '@' => $parent}); - #my $ref = ref($parent); $parent = $$parent if $ref eq 'REF'; - my @elements = $parent -> {'@$'} ? $parent -> {'@$'} : (); - $elements[@elements] = $sub; $prev = $parent; $cnt_nl = 0; - $parent -> {'@$'} = \@elements; - } - } - 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; + $parent = \$sub + } + next + }elsif($nest =~ m/\/+/) { + # God algorithm, where root is the father, the mum only can receive new attributes or children nodes. if($sub){ - $sub -> {$attribute} = $value - }else{ - $property -> {$attribute} = $value - } - $cnt_nl = 0; - } - elsif (defined $sel[4]){ - if ($sel[4] eq ''){ - if(++$cnt_nl>1){ #cancel collapse chain and at root of property that is shorted. - ##$sub = $property ; - $cnt_nl =0 + my $bck_n = length($nest); + if($name){ + if($sub->{'#'}){ + $sub->{'#'} = $sub->{'#'}."\n$name"; + }else{ + $sub->{'#'} = $name; + } } - next - }elsif($sel[4] !~ /^\s*\#/ ){ - my $parent = defined $sub ? $sub : $property; - #my $ref = ref($parent); $parent = $$parent if $ref eq 'REF'; + for(0..$bck_n-1) { + my $ptr = $$parent; + my $mum = $ptr->{'@'}; + if($mum){ + $sub = $$mum; + $parent = $mum; - if (exists $parent->{'#'}){ - $parent->{'#'} .= "\n" . $sel[4] }else{ - $parent->{'#'} = $sel[4] + $parent = $root; + last + } } + }else{ + $parent = $sub -> parent() if $sub; + $parent = $root if !$parent; } + next + }elsif($nest eq '|'){ + my $ptr = $$parent; my @parr; + $sub = CNFNode->new({'_' => $name, '@' => \$ptr}); + if($name eq '@@'){ + @parr = @{$ptr->{'@@'}} if exists $ptr->{'@@'}; + }else{ + @parr = @{$ptr->{'@$'}} if exists $ptr->{'@$'}; + } + $parr[@parr] = $sub; + if($name eq '@@'){ + $ptr -> {'@@'} = \@parr; + }else{ + $ptr -> {'@$'} = \@parr; + $parent = \$sub + } + next + } + $nest = $sel[0]; $nest=~s/[\s_]*$//g; + if(!$sub && $root->{'_'} eq CNFMeta::ANN()){ + $root->{'_'} = $nest; + $sub = $root; + }elsif($nest eq '@@'){ + my $node = new({'_' => $nest, '@' => \$parent}); + my $ptr = $parent; + my @parr = @$ptr->{'@@'} if exists $ptr->{'@@'}; + $parr[@parr] = $node; + $ptr -> {'@@'} = \@parr; + $sub = $node; + }else{ + try{ + cluck "Parent is undefined!" if not $parent; + $nest = $1.CNFMeta::_zero_prefix(1, ++$counter) if $nest =~ m/(\w+)\$\$$/; + my $ptr = $$parent; + $sub = CNFNode->new({'_' => $nest, '@' => \$ptr}); + my @nodes = $ptr->{'@$'} if exists $ptr->{'@$'}; + $nodes[@nodes] = $sub; + $ptr -> {'@$'} = \@nodes; + $prev = $parent; + }catch($e){ + cluck "\nERROR -> $e", @! + } + } + } - } + 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($sub){ + $sub -> {$attribute} = $value + }else{ + my $ptr = $$parent; + $ptr -> {$attribute} = $value + } + } + elsif (defined $sel[4] && (my $val = $sel[4])){ + if ($val eq ''){ + next + }elsif($val !~ /^\s*\#/ ){ + my $ptr = $sub ? $sub : $parent; + my $ref = ref($ptr); + $ptr = $$ptr if $ref eq 'REF'; + #$ref = ref($ptr); + if (exists $ptr->{'#'}){ + $ptr->{'#'} .= "\n$val" + }else{ + $ptr->{'#'} = $val + } + } + } + } } @@ -686,9 +813,7 @@ sub validate { foreach my $ln(@lines){ $ln =~ s/^\s+|\s+$//g; $lnc++; - #print $ln, "<-","\n"; if(length ($ln)){ - #print $ln, "\n"; if($ln =~ /^([<>\[\]])(.*)([<>\[\]])(.*)/ && $1 eq $3){ $sta = $1; $tag = $2; @@ -697,8 +822,8 @@ sub validate { if($tag =~ /^([#\*\@]+)[\[<](.*)[\]>]\/*[#\*\@]+$/){ }elsif($tag =~ /^(.*)[\[<]\/*(.*)[\]>](.*)$/ && $1 eq $3){ - $singels[@singels] = $tag; - next + $singels[@singels] = $tag; + next } elsif($isClosing){ $close++; @@ -712,7 +837,7 @@ sub validate { } } if(@opening != @closing){ - cluck "Opening and clossing tags mismatch!"; + cluck "Opening and closing tags mismatch!"; foreach my $o(@opening){ my $c = pop @closing; if(!$c){ @@ -729,7 +854,7 @@ sub validate { if($o->{T} ne $c->{T}){ print '['.$o->{T}."[ idx ".$o->{idx}." line ".$o->{L}. ' but picked for closing: ]'.$c->{T}.'] idx '.$o->{idx}.' line '.$c->{L}."\n" if $self->{DEBUG}; - # Let's try same index from the clossing array. + # Let's try same index from the closing array. $c = $closing[$i]; }else{next} @@ -744,7 +869,7 @@ sub validate { }else{next} if($o->{T} ne $c->{T} && $o->{N} ne $c->{N}){ - cluck "Error opening and clossing tags mismatch for ". + cluck "Error opening and closing tags mismatch for ". _brk($o).' ln: '.$o->{L}.' idx: '.$o->{idx}. ' wrongly matched with '._brk($c).' ln: '.$c->{L}.' idx: '.$c->{idx}."\n"; $errors++; @@ -755,8 +880,8 @@ sub validate { } sub _brk{ - my $t = shift; - return 'tag: \''.$t->{S}.$t->{T}.$t->{S}.'\'' + my $nest = shift; + return 'tag: \''.$nest->{S}.$nest->{T}.$nest->{S}.'\'' } ### # Compare one node with another if is equal in structure. @@ -802,11 +927,12 @@ sub equals { return 0; } ### -# Obtaine the full path of this node. +# Obtain the full path of this node. ### sub toPath { my($self, @arr)= @_; if(exists $self -> {'@'}){ + my $ref = ref($self -> {'@'}); return ${$self -> {'@'}} -> toPath() . '/'. $self->{_} } return $self -> {'_'} @@ -850,8 +976,9 @@ sub toScript { } my $list = $self->{'@@'}; if($list){ - foreach(@$list) { - $script .= toScript($_,$nested+2)."\n" + foreach my$itm(@$list) { + my $ref = ref($itm); + $script .= toScript($itm,$nested+2)."\n" } } my $nodes = $self->{'@$'}; @@ -888,11 +1015,11 @@ sub toScript { if ($isParent){ $script .= ">>\n" }else{ - if($nested){ - $script .= "$tab>$tag>\n" - }else{ - $script .= "$tab]$tag]\n" - } + if($nested){ + $script .= "$tab>$tag>\n" + } else { + $script .= "$tab]$tag]\n" + } } return $script; } -- 2.34.1