From 79927dbcef694240624e0fe91e1a23ef3f0b5eee Mon Sep 17 00:00:00 2001 From: Will Budic Date: Sat, 13 Apr 2024 10:59:08 +1000 Subject: [PATCH] dev. --- README.md | 12 ++-- system/modules/CNFNode.pm | 109 ++++++++++++++++++---------------- test.cnf | 21 ++++--- tests/TestManager.pm | 2 +- tests/bitcoin.cnf | 41 +++++++++++++ tests/testCNFNode.pl | 8 +-- tests/testCNFNodeShortiefs.pl | 66 ++++++++++++++++++++ 7 files changed, 186 insertions(+), 73 deletions(-) create mode 100644 tests/bitcoin.cnf create mode 100644 tests/testCNFNodeShortiefs.pl diff --git a/README.md b/README.md index ad6fc00..1409fa7 100644 --- a/README.md +++ b/README.md @@ -3,12 +3,14 @@ Perl based Configuration Network File Format Parser and Specifications. CNF file format supports used format extraction from any text file. Useful for templates and providing initial properties and values for various application settings. -Has own textual data tag format. Therefore can also be useful for database data batch processing. +Has own textual data tag format. Therefore, can also be useful for database data batch processing. This project also contains custom build TestManager module for general and all test driven development. It is at current v.3.0 version, project is specification implemented, and test driven development produced. +Public open source: git clone git://lifelog.hopto.org/PerlCNF + ### [You can find the specification here](./Specifications_For_CNF_ReadMe.md). --- @@ -29,11 +31,11 @@ It is at current v.3.0 version, project is specification implemented, and test d * SQLite and Postgress Database functionality has been revisited. * (2023-08-08) - v.2.9, new DATE instruction has been implemented. * (2023-06-14) - v.2.9, new meta flags and priority can be set via these pre-evaluation settings for instructions. - - Node processing on demand and JSON translation on demand of CNFNode's (TREE instruction) is now available. + - Node processing on demand and JSON translation on demand of CNFNode's (TREE instruction) is now available. Online demo made available. * (2023-05-13) - v.2.8, has new instructions VARIABLE, to streamline under one tag like CONST, but for anons. Has better tag mauling algorithm. PLUGIN code has been improved, particularly the synchronizing and the linking of properties. -* (2022-11-18) - PerlCNF now provides custom test manager and test cases. +* (2022-11-18) - PerlCNF now provides custom test manager and test cases. - That will in future be used for all projects as an copy from this project. This is all available in the ./test directory and is not a Perl module. @@ -54,14 +56,14 @@ It is at current v.3.0 version, project is specification implemented, and test d * cd ~/dev/PerlCNF; #Perl tests and project directory is required to be the starting location. ```sh - sudo ./install_cpan_modules_required.pl + sudo ./install_cpan_modules_required.pl ``` ## Usage * Copy the system/modules/CNFParser.pm module into your project. * From your project you can modify and adopt, access it. -* You can also make an perl bash script. +* You can also make an perl bash script. ```perl use lib "system/modules"; diff --git a/system/modules/CNFNode.pm b/system/modules/CNFNode.pm index 28bb4fa..01d27f8 100644 --- a/system/modules/CNFNode.pm +++ b/system/modules/CNFNode.pm @@ -394,56 +394,60 @@ sub process { 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 '/') { - $parent = $sub; - do{$parent = $parent -> parent() if $parent -> parent()}while(--$bck_p>0); - if ($sel[0] eq ''){ - $sub = $parent; next - } + 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'; + } + if ($sel[0] eq ''){ + $sub = $parent; next } - $t = $sel[0]; $t=~s/[\s_]*$//g; - $sub = CNFNode->new({'_' => $t, '@' => $parent}); - my @elements = exists $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; - 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 - } - next - }elsif($sel[4] !~ /^\s*\#/ ){ - my $parent = $sub ? $sub->parent() : $property; - if (exists $parent->{'#'}){ - $parent->{'#'} .= "\n" . $sel[4] - }else{ - $parent->{'#'} = $sel[4] - } - # $sub =""; - } + $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; + 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 + } + next + }elsif($sel[4] !~ /^\s*\#/ ){ + my $parent = defined $sub ? $sub : $property; + #my $ref = ref($parent); $parent = $$parent if $ref eq 'REF'; + + if (exists $parent->{'#'}){ + $parent->{'#'} .= "\n" . $sel[4] + }else{ + $parent->{'#'} = $sel[4] + } + } + } }#while $isShortifeScript = 0; }else{ @@ -512,9 +516,9 @@ sub process { my @nodes; my $prev = $self->{'@$'}; if($prev) { - @nodes = @$prev; + @nodes = @$prev; }else{ - @nodes = (); + @nodes = (); } $nodes[@nodes] = $property; $self->{'@$'} = \@nodes; @@ -759,8 +763,13 @@ sub toScript { foreach my $nd (@$nodes) { my $ref = ref($nd); $nd = $$nd if ($ref eq 'REF'); - if (ref($nd) eq 'CNFNode'){ + $ref = ref($nd); + if ($ref eq 'CNFNode'){ $script .= toScript($nd, $nested+1); + }elsif ($ref eq 'ARRAY'){ + foreach my $itm (@$nd) { + $script .= toScript($itm, $nested+1); + } } } } diff --git a/test.cnf b/test.cnf index a7e7092..25f7faf 100644 --- a/test.cnf +++ b/test.cnf @@ -1,18 +1,17 @@ < content> >> diff --git a/tests/TestManager.pm b/tests/TestManager.pm index a0c5f59..4f95fad 100644 --- a/tests/TestManager.pm +++ b/tests/TestManager.pm @@ -151,7 +151,7 @@ sub isZeroOrEqual{ print GREEN."\t$stab YDef ".$self->{test_cnt} .'.'. ++$self->{sub_cnt}.": Passed -> Scalar [$var] is ZeroOrEqual.\n" }else{ ++$self->{sub_err}; - print BLINK. BRIGHT_RED."\t$stab YDef ".$self->{test_cnt} .'.'. ++$self->{sub_cnt}. ": Failed!"." ($self->{sub_err}) ".RESET. RED."Scalar [$var] is not defined!\n"; + print BLINK. BRIGHT_RED."\t$stab YDef ".$self->{test_cnt} .'.'. ++$self->{sub_cnt}. ": Failed!"." ($self->{sub_err}) ".RESET. RED."Scalar [$var] is not equal!\n"; return 0; } return 1; diff --git a/tests/bitcoin.cnf b/tests/bitcoin.cnf new file mode 100644 index 0000000..4d01b2e --- /dev/null +++ b/tests/bitcoin.cnf @@ -0,0 +1,41 @@ +< +CREATE TABLE IF NOT EXISTS public.bitcoin +( + date timestamp without time zone NOT NULL, + value integer NOT NULL, + CONSTRAINT bitcoin_pkey PRIMARY KEY (date) +) + +TABLESPACE pg_default; + +ALTER TABLE IF EXISTS public.bitcoin + OWNER to lifelog; +>> +< + +CREATE OR REPLACE VIEW public."AVG_BITCOIN_LAST_7_DAYS" + AS + SELECT date(t.date) AS date, + max(t.value) AS max, + min(t.value) AS min, + avg(t.value::double precision)::numeric(10,2) AS avg + FROM bitcoin t + WHERE t.date >= ((CURRENT_DATE AT TIME ZONE 'UTC'::text) - '7 days'::interval) + GROUP BY (date(t.date)) + ORDER BY (date(t.date)) DESC; + +ALTER TABLE public."AVG_BITCOIN_LAST_7_DAYS" + OWNER TO lifelog; +>> + +< +SELECT + current_date as From_Date_Minus_Seven, + max(view.max) AS max, + min(view.min) AS min, + avg(view.avg)::numeric(10,0) AS avg +FROM +(SELECT max, min, avg + FROM public."AVG_BITCOIN_LAST_7_DAYS") as view; +>> + diff --git a/tests/testCNFNode.pl b/tests/testCNFNode.pl index 7af46c9..d1e2cda 100644 --- a/tests/testCNFNode.pl +++ b/tests/testCNFNode.pl @@ -127,16 +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(); # } catch{ $test -> dumpTermination($@); - $test->doneFailed(); + $test -> doneFailed(); } diff --git a/tests/testCNFNodeShortiefs.pl b/tests/testCNFNodeShortiefs.pl new file mode 100644 index 0000000..21e1eac --- /dev/null +++ b/tests/testCNFNodeShortiefs.pl @@ -0,0 +1,66 @@ +#!/usr/bin/env perl +use warnings; use strict; +use v5.35; +use lib "tests"; +use lib "system/modules"; + +require TestManager; +require CNFParser; +require CNFNode; + +my $test = TestManager->new($0); +package Constants; +#<- Global Typeglob declared creates +# read only references but these are NOT constants. +*GlobelTroter = \"TEST"; +package main; +use Syntax::Keyword::Try; try { + + ### + $test -> case("Test typeglob as attribute type of constance."); + $test -> evaluate('Is *Globetroter main attribute eq to "TEST"', + 'TEST', $Constants::GlobelTroter); + # man:: package GlobelTroter; + *GlobelTroter = \"TEST2"; + our $GlobelTroter; + # Not allowed -> our $GlobelTroter = 'change'; + # however this is allowed, change the pointer to a new value, Perl allows it: + *Constants::GlobelTroter = \"TEST2"; + say "\t\tGlobeltroter is:". $Constants::GlobelTroter; + $test -> evaluate('Is *GlobeTroter equal',$GlobelTroter, $Constants::GlobelTroter); + ### + $test->nextCase(); + ### + + ### + $test -> case("Test shortife from file test.cnf."); + my $parser = CNFParser->new('test.cnf'); + my @para_instructed = $parser->list("paragraphs"); + my @paragraphs = $parser->listProcessed("paragraphs"); + my %anons = %{$parser->anon()}; + $test -> evaluate("Are there 3 \@para_instructed?",3,scalar(@para_instructed)); + $test -> evaluate("Are there 3 \@paragraphs listed?",3,scalar(@paragraphs)); + ### + $test->nextCase(); + ### + $test -> case("Test CNF frome test.cnf."); + my $node = $parser->anon("paragraphs0"); + $test-> isDefined("\$node",$node); + +#TODO Currently doesn't work with shortifes parsed nodes to return expected -> my $divs = $node->find("content/div/*"); + my $content = $node->find('content/div'); + my @divs = @{$content->{'@$'}}; + say scalar @divs; + $test -> evaluate("Does [".$content->name()."] have 2 'div' child nodes?",2,scalar(@divs)); +#TODO Following not working at the moment: + my $div1 = $node->find('content/div/div1'); + $test->failed('content/div/div1 not found!') if $test->isZeroOrEqual("div1",scalar(@{$div1}),0); + say $node->toScript(); + ### + $test->done(); + # +} +catch{ + $test -> dumpTermination($@); + $test -> doneFailed(); +} -- 2.34.1