From d3b5f37a141a5283e2c49278003c1bddfa5fd566 Mon Sep 17 00:00:00 2001 From: Will Budic Date: Sun, 9 Nov 2025 21:15:41 +1100 Subject: [PATCH] imp. constantsRegistryCheck --- system/modules/CNFParser.pm | 44 +++++++++++++++++---------------- tests/test_CursesProgressBar.pl | 19 +++++++------- 2 files changed, 33 insertions(+), 30 deletions(-) diff --git a/system/modules/CNFParser.pm b/system/modules/CNFParser.pm index dd564d2..0f10333 100644 --- a/system/modules/CNFParser.pm +++ b/system/modules/CNFParser.pm @@ -148,7 +148,7 @@ our $meta_const = meta_const(); # When the future becomes life in anonymity, unknown variables best describe the meta state. ## package META_PROCESS { - sub constance{ + sub constant{ my($class, $set) = @_; if(!$set){ $set = {anonymous=>'*'} @@ -163,8 +163,8 @@ package META_PROCESS { return $val; } } -use constant META => META_PROCESS->constance(); -use constant META_TO_JSON => META_PROCESS->constance({anonymous=>*_to_JSON}); +use constant META => META_PROCESS->constant(); +use constant META_TO_JSON => META_PROCESS->constant({anonymous=>*_to_JSON}); sub _to_JSON { my($property, $val) = @_; return <<__JSON @@ -335,7 +335,7 @@ sub anon { my ($self, $n, $args)=@_; ### # Validates and returns a constant named value as part of this configs instance. -# Returns undef if it doesn't exist, and exception if constance required is set; +# Returns undef if it doesn't exist, and exception if constant required is set; sub const { my ($self,$c)=@_; return $self->{$c} if exists $self->{$c}; if ($CONSTREQ){CNFParserException->throw("Required constants variable ' $c ' not defined in config!")} @@ -345,9 +345,9 @@ sub const { my ($self,$c)=@_; return; } ### -# Validates if this repository contains expected and required constance. -# Returns 0 if an required constance not found in list. -sub constanceRegistryCheck{ my ($self,@list)=@_; +# Validates if this repository contains expected and required constant. +# Returns 0 if an required constant has not been found in the provided list. +sub constantsRegistryCheck{ my ($self,@list)=@_; return 0 if !@list; my $r = 1; my ($package, $filename, $line) = caller; foreach(@list){ @@ -492,13 +492,13 @@ sub doInstruction { my ($self,$e,$t,$v,$is_tagged) = @_; $priority = $itm->{'^'}; } $is_tagged = defined($t); $t = $e if not $is_tagged; - if($t eq 'CONST' or $t eq 'CONSTANT'){#Single constant with mulit-line value; - # It is NOT allowed to overwrite constant. - if (not $self->{$e}){ - $v =~ s/^\s//; + if($t eq 'CONST' or $t eq 'CONSTANT'){#Single constant with multiline value; + # It is NOT allowed to overwrite an constant like an anon variable. + if (not exists $self->{$e}){ + $v =~ s/^\s//; $v = "" if not defined $v; $self->{$e} = $v; }else{ - warn "Skipped constant detected assignment for '$e'."; + $self->warn("Skipped constant reassignment for '$e'."); } } elsif($t eq 'VAR' or $t eq 'VARIABLE'){ @@ -976,27 +976,29 @@ sub parse { my ($self, $cnf_file, $content, $del_keys) = @_; my $v = $2; if(isReservedWord($self, $t)){ my $isVar = ($t eq 'VARIABLE' || $t eq 'VAR'); - if($t eq 'CONST' or $isVar){ #constant multiple properties. + if($t eq 'CONST' or $isVar or $t eq 'CONSTANT'){ #constant multiple properties. foreach my $line (split '\n', $v) { my $isMETAConst = $line =~ s/$meta_const//s; + next if $line =~ /^#/; $line =~ s/^\s+|\s+$//; # strip unwanted spaces + $line =~ s/\s*#.*$//; #strip comment for end of line. $line =~ s/\s*>$//; $line =~ m/([\$\w]*)(\s*=\s*)(.*)/g; + my $name = $1; - $line = $3; $line =~ s/^\s*(['"])(.*)\g{1}$/$2/ if $line;#strip quotes + $line = $3; + $line =~ s/^\s*(['"])(.*)\g{1}$/$2/ if $line;#strip quotes + $line = "" if not defined $line; if(defined $name){ if($isVar && not $isMETAConst){ $anechoic ->{$name} = $line if $line }else{ $name =~ s/^\$// if $isMETAConst; - # It is NOT allowed to overwrite a constant, so check an issue warning. - if($line and not $self->{$name}){ + # It is NOT allowed to overwrite a constant, so check and issue warning. + if(not exists $self->{$name}){ $self->{$name} = $line; - }else{ - if(defined $line && $line ne $self->{$name}){ - my $w = "Skipping and keeping a previously set constance of -> [$name] in (". $self->{CNF_CONTENT}. - ") the new script value dosen't match -> $line."; $self->warn($w) - } + }else{ + $self->warn("Skipped constant reassignment for '$name'."); } } } diff --git a/tests/test_CursesProgressBar.pl b/tests/test_CursesProgressBar.pl index 8ac2865..fbaeeb7 100644 --- a/tests/test_CursesProgressBar.pl +++ b/tests/test_CursesProgressBar.pl @@ -11,7 +11,7 @@ use Time::HiRes qw(usleep); # Disable bellow use lib::relative when debugging -> "perl.perlInc" # if set hard linked to vscode project/workspace finds the right folder. ## -#use lib::relative (".","../system/modules"); + use lib::relative (".","../system/modules"); ## use CNFParser; use CNFDateTime; use TestManager; @@ -20,8 +20,8 @@ my $cnf = CNFParser-> blank() -> parseString(q{ <<>> <<@<@DIRECTORIES> Documents, Pictures, Public, Music, @@ -53,20 +53,21 @@ localperl .config/Code/logs/* >> }); -if( $cnf -> constanceRegistryCheck(qw( +if( not $cnf -> constantsRegistryCheck(qw( TZ target - prefix + postfix ))){ - die "CNF Repository Check Failed" + die "CNF Repository Check Failed!" }; my ($target_fname, $target_arindex_file,$target_archive_file); { use POSIX; my @uname = POSIX::uname(); -my $dtpart = CNFDateTime -> now({TZ=>$cnf->{TZ}}) ->toSquash(); -my $prefix = $cnf->{prefix}; -$target_fname = $uname[1] . '-' .$dtpart.$prefix; +my $date = CNFDateTime -> now({TZ=>$cnf->{TZ}}) ->toSquash(); +# No more checks needed as when 'postfix' or 'target' is missing, we would previously with constantsRegistryCheck died. +my $postfix = ""; $postfix ="-". $cnf->{postfix} if($cnf->{postfix}); +$target_fname = $uname[1] . '-' .$date.$postfix; $target_arindex_file = $cnf->{target}.'/'.$target_fname.'.lst.xz'; $target_archive_file = $cnf->{target}.'/'.$target_fname.'.xz.enc'; } -- 2.34.1