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.
}
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;
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;
my $buf;
my @arr = @{$self->{'@$'}};
foreach my $node(@arr){
- $buf .= $node -> val() ."\n";
+ my $nv = $node -> val();
+ $buf .= "$nv\n" if $nv
}
return $buf;
}
#
-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;
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
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;
+ }
}
}
}
@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){
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)=@_;
}
###
-# 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
###
-# 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;
###
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";
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 '*'){
}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--;
}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;
my $prev = $self->{'@$'};
if($prev) {
@nodes = @$prev;
- }else{
- @nodes = ();
}
$nodes[@nodes] = $property;
- $self->{'@$'} = \@nodes;
+ $self->{'@$'} = \@nodes;
}
undef $sub; $body = $val = "";
}
my $prev = $self->{'@$'};
if($prev) {
@nodes = @$prev;
- }else{
- @nodes = ();
}
$nodes[@nodes] = CNFNode->new({'_'=>$link, '*'=>$rval, '@' => \$self});
$self->{'@$'} = \@nodes;
}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){
$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;
$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)
}
}
- if($isShortifeScript && $body){
- _parseShortife($self,$body)
+ if($isShortife && $body){
+ _parseShortife(\$self,$body)
}
$self->{'@@'} = \@array if @array;
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
+ }
+ }
+ }
+ }
}
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;
if($tag =~ /^([#\*\@]+)[\[<](.*)[\]>]\/*[#\*\@]+$/){
}elsif($tag =~ /^(.*)[\[<]\/*(.*)[\]>](.*)$/ && $1 eq $3){
- $singels[@singels] = $tag;
- next
+ $singels[@singels] = $tag;
+ next
}
elsif($isClosing){
$close++;
}
}
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){
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}
}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++;
}
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.
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 -> {'_'}
}
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->{'@$'};
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;
}
lifelog.hopto.org / PerlCNF.git / commitdiff