From d48e576f1ccc24efa442a1e7fc041494344b59cb Mon Sep 17 00:00:00 2001 From: Will Budic Date: Thu, 28 Mar 2024 18:16:39 +1100 Subject: [PATCH] New dev. 3.2, anon list properties fixed. --- delete_older_backups.pl | 37 ++++++++++++++++++ system/modules/CNFParser.pm | 75 +++++++++++++++++++++++++++---------- test.cnf | 26 +++++++++++++ test.css | 40 ++++++++++++++++++++ tests/testAppSettings.pl | 4 +- tests/testCNFNode.pl | 11 +++--- 6 files changed, 166 insertions(+), 27 deletions(-) create mode 100644 delete_older_backups.pl create mode 100644 test.cnf create mode 100644 test.css diff --git a/delete_older_backups.pl b/delete_older_backups.pl new file mode 100644 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 61c7c0f..e2af36b 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.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: <<>> 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;# 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 index 0000000..a7e7092 --- /dev/null +++ b/test.cnf @@ -0,0 +1,26 @@ +< +content> +>> + +< +content> +>> + +<>> +<value>> \ No newline at end of file diff --git a/test.css b/test.css new file mode 100644 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 da1f4ef..0bb1fc6 100644 --- 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 513a89b..7af46c9 100644 --- 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(); } - - -- 2.34.1