New dev. 3.2, anon list properties fixed.

diff --git a/delete_older_backups.pl b/delete_older_backups.pl
new file mode 100644 (file)
index 0000000..85977ac
--- /dev/null
+++ b/delete_older_backups.pl
@@ -0,0 +1,37 @@
+#!/usr/bin/env perl
+use DateTime;
+use File::stat;
+use feature 'say';
+
+
+my ($BACKUPS, $PREFIX, $DAYS) = ('/home/will/backups','nomad-', 3);
+
+my $dt = DateTime->now(time_zone => "local") -> subtract(days => $DAYS);
+
+opendir my($dh),$BACKUPS or die WHITE."Couldn't open dir '$BACKUPS':".RED." $!";
+my @files = grep {   !/^\./ && /^$PREFIX/ } readdir($dh);
+closedir $dh;
+say "Sel.Files: ".@files." ".$dt->strftime("%m/%d/%Y %H:%M");
+disk_space("/");
+exit unless @files > 2;
+
+delete_extras();
+disk_space("/");
+
+sub disk_space {
+    my $dir = shift;
+say `df -h / |tail -n 1 | awk '{print "Dir: $dir Used: "\$3, \$5, "Avail:" \$4, "Cap: " \$2}'`
+}
+
+sub delete_extras {
+    foreach my $file (@files){
+            my  $info = stat("$BACKUPS/$file");
+            if ($info->mtime < $dt->epoch){
+                unlink "$BACKUPS/$file";
+                say scalar localtime $info->mtime,  " $file", "\tDeleted!";
+            }
+    }
+}
+
+
+ exit;
\ No newline at end of file

diff --git a/system/modules/CNFParser.pm b/system/modules/CNFParser.pm
index 61c7c0fb24e276cb0813aee8b27142dc86f775af..e2af36b475b312bf5e01ae67fc9765529b974ae2 100644 (file)
--- 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.1';
+use constant VERSION => '3.2';
 our @files;
 our %lists;
 our %properties;
@@ -157,19 +157,27 @@ sub _isTrue{
     return 0 if(not $value);
     return ($value =~ /1|true|yes|on|t|da/i)
 }
+
 ###
 # Post parsing instructed special item objects. They have lower priority to Order of apperance and from CNFNodes.
 ##
 package InstructedDataItem {
 
-    our $dataItemCounter   = int(0);
+    our %counters;
 
     sub new { my ($class, $ele, $ins, $val) = @_;
         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;
+        }
         bless {
                 ele => $ele,
-                aid => $dataItemCounter++,
+                aid => $dataItemCounter->{aid}++,
                 ins => $ins,
                 val => $val,
                 '^' => $priority
@@ -355,6 +363,18 @@ sub list  {
         return @{$an} if defined $an;
         die "Error: List name '$t' not found!"
 }
+sub listProcessed {
+    my $self = shift;
+    my $t=shift;
+    my @arr = @{$lists{$t}};
+    if(@arr){
+        foreach my$i(0..$#arr){
+            my $anon_name = $arr[$i]->{ele} . $arr[$i]->{aid};
+            @arr[$i]= $self->anon($anon_name);
+        }
+    }
+    return @arr
+}
 
 # Adds a list of environment expected list of variables.
 # This is optional and ideally to be called before parse.
@@ -464,7 +484,7 @@ sub doInstruction { my ($self,$e,$t,$v) = @_;
         }
             $tree = CNFNode->new({'_'=>$e,'~'=>$v,'^'=>$priority});
             $tree->{DEBUG} = 1 if $self->{DEBUG};
-            $instructs{$e} = $tree;
+            $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"}
@@ -721,7 +741,7 @@ sub parse {  my ($self, $cnf_file, $content, $del_keys) = @_;
       if($tag =~ m/^<(\w*)\s+(.*?)>*$/gs){ # Original fastest and early format: <<<anon value>>>
            my $t = $1;
            my $v = $2;
-           if(isReservedWord($self,$t)){
+           if(isReservedWord($self, $t)){
               my $isVar = ($t eq 'VARIABLE' || $t eq 'VAR');
               if($t eq 'CONST' or $isVar){ #constant multiple properties.
                 foreach  my $line(split '\n', $v) {
@@ -747,7 +767,7 @@ sub parse {  my ($self, $cnf_file, $content, $del_keys) = @_;
                         }
                 }
               }else{
-                 doInstruction($self,$v,$t,undef);
+                doInstruction($self,$v,$t,undef);
               }
            }else{
               $v =~ s/\s*>$//;
@@ -777,9 +797,9 @@ sub parse {  my ($self, $cnf_file, $content, $del_keys) = @_;
                    $v = substr $tag, length($e)+1;
                    $v =~ s/>$// if $t ne '<<' && $tag =~ />$/
                 }else{
-                    $tag =~ m/([@%\$\.\/\w]+) ([ <>\n|^\\]{1})+ ([^<^>^^\n]+) ([<>]?) (.*)/gmxs;
-                         $t = $3;
-                         $v = $5;
+                   $tag =~ m/([@%\$\.\/\w]+) ([ <>\n|^\\]{1})+ ([^<^>^^\n]+) ([<>]?) (.*)/gmxs;
+                   $t = $3;
+                   $v = $5;
                 }
             }else{
                                                 #############################################################################
@@ -803,20 +823,22 @@ sub parse {  my ($self, $cnf_file, $content, $del_keys) = @_;
 
             }
             if(!$v && !$RESERVED_WORDS{$t}){
-                $v= $t;
+                $v = $t; undef $t
             }
             $v =~ s/\\</</g; $v =~ s/\\>/>/g;# escaped brackets from v.2.8.
 
-            #Do we have an autonumbered instructed list?
-            #DATA best instructions are exempted and differently handled by existing to only one uniquely named property.
-            #So its name can't be autonumbered.
+            #Do we have an autonumbered list of anons?
+            #Instructions like DATA can't be autonumbered properties.
             if ($e =~ /(.*?)\$\$$/){
                 $e = $1;
-                if($t && $t ne 'DATA'){
-                   my $array = $lists{$e};
-                   if(!$array){$array=();$lists{$e} = \@{$array};}
-                   push @{$array}, InstructedDataItem -> new($e, $t, $v);
-                   next
+                my @array = ();
+                if(exists $lists{$e}){
+                   @array = @{$lists{$e}};
+                }
+                if(!$t or $t ne 'DATA'){
+                    push @array, InstructedDataItem -> new($e, $t, $v);
+                    $lists{$e} = \@array;
+                    next;
                 }
             }elsif ($e eq '@'){#collection processing.
                 my $isArray = $t=~ m/^@/;
@@ -897,13 +919,28 @@ sub parse {  my ($self, $cnf_file, $content, $del_keys) = @_;
           $self -> doInclude($_) if $_ && not $_->{prc_last} and not $_->{loaded} and $_->{local} eq $CUR_SCRIPT;
        }
     }
+    # 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});
+            }
+       }
+       undef %InstructedDataItem::counters;
+    }
+
     ###  Do the smart instructions and property linking.
     if(%instructs && not $IS_IN_INCLUDE_MODE){
         my @items;
         foreach my $e(keys %instructs){
             my $struct = $instructs{$e};
             my $type =  ref($struct);
-           if($type eq 'String'){
+            if ($type eq 'REF'){
+                $struct  = $$struct;
+                $type =  ref($struct);
+            }
+            if($type eq 'String'){
                 my $v = $struct;
                 my @arr = ($v =~ m/(\$\$\$.+?\$\$\$)/gm);
                 foreach my $find(@arr) {# <- MACRO TAG translate. ->

diff --git a/test.cnf b/test.cnf
new file mode 100644 (file)
index 0000000..a7e7092
--- /dev/null
+++ b/test.cnf
@@ -0,0 +1,26 @@
+<<paragraphs$$<TREE>
+<content< __IN_SHORTIFE__
+ class : main
+  div _\
+    class: paragraphs
+  div _|
+    class: paragraph
+This is a Perl CNF to HTML example document.
+It is similar to HTML that individual DOM elements.
+Are tree like placed in the body of the TREE instructed CNF Property.
+It is easier to the eye, and more readable. You can be the judge.
+
+div _|
+    class: paragraph
+Second parapgraph here.
+>content>
+>>
+
+<<paragraphs$$<TREE>
+<content< __IN_SHORTIFE__
+test list type anon with instructions.
+>content>
+>>
+
+<<paragraphs$$<Simple format of annon.>>>
+<<paranormal$$>value>>
\ No newline at end of file

diff --git a/test.css b/test.css
new file mode 100644 (file)
index 0000000..a47993e
--- /dev/null
+++ b/test.css
@@ -0,0 +1,40 @@
+
+body {
+    margin: 20px;
+    text-align: center;
+    font-family: 'Franklin Gothic Medium', 'Arial Narrow', Arial, sans-serif;
+    font-size: large;
+}
+
+p {
+text-align: justify;
+padding-top: 5ch;
+padding-left: 2ch;
+padding-bottom: 50px;
+}
+
+.main {
+    display: grid;
+    place-items: center;
+}
+
+.paragraphs {
+    display: flexbox;
+}
+
+.paragraph{
+    border-radius: 32%;
+    shape-outside: circle();
+    background-color: antiquewhite;
+    border: 1px solid black;
+    margin-bottom: 5px;
+    display: grid;
+    max-width:740px;
+}
+img {
+
+    float: right;
+    margin: 2ch;
+    max-width: 230px;
+    height: auto;
+}
\ No newline at end of file

diff --git a/tests/testAppSettings.pl b/tests/testAppSettings.pl
index da1f4ef74e315120e3bcfccdf5ddfdb0dd233149..0bb1fc64ed89690f9debabaa7acf66cc35bf9502 100644 (file)
--- a/tests/testAppSettings.pl
+++ b/tests/testAppSettings.pl
@@ -82,7 +82,5 @@ use Syntax::Keyword::Try; try {
 }
 catch{
    $test -> dumpTermination($@);
-   $test->doneFailed();
+   $test -> doneFailed();
 }
-
-

diff --git a/tests/testCNFNode.pl b/tests/testCNFNode.pl
index 513a89b30ae83034d605e658d3f033b5dc38231f..7af46c90457a7a2b668bf47d3bc782c8c4386db7 100644 (file)
--- a/tests/testCNFNode.pl
+++ b/tests/testCNFNode.pl
@@ -4,7 +4,6 @@ use warnings; use strict;
 use lib "tests";
 use lib "system/modules";
 
-
 require TestManager;
 require CNFParser;
 require CNFNode;
@@ -128,8 +127,12 @@ use Syntax::Keyword::Try; try {
     #
     $test -> nextCase();
     #
-
-    #
+    $test -> case("Test shortify from file");
+    my $parser =  CNFParser->new('test.cnf');
+    my @para_instructed = $parser->list("paragraphs");
+    my @paragraphs = $parser->listProcessed("paragraphs");
+    my %anons = %{$parser->anon()};
+    # #
     $test->done();
     #
 }
@@ -137,5 +140,3 @@ catch{
    $test -> dumpTermination($@);
    $test->doneFailed();
 }
-
-