From 29a571fc3e60f1048013602bfd8046b599924f80 Mon Sep 17 00:00:00 2001 From: Will Budic Date: Tue, 30 Apr 2024 17:52:30 +1000 Subject: [PATCH] CNFNode find method and other enhancements. --- ...{CNF_DBProgressTest.pl => CNF_DBPGTest.pl} | 10 +-- old/CNF_GD_PLOT.pl | 5 -- old/databaseBitcoinPlot.cnf | 30 +++---- ...tabaseProgresSQL.cnf => databasePGSQL.cnf} | 2 +- system/modules/CNFNode.pm | 87 +++++++++++++++++-- system/modules/CNFParser.pm | 2 +- tests/testCNFNode.pl | 62 ++++++++++++- tests/testCNFNodeShortiefs.pl | 7 +- vs_code_extensions.lst | 79 +++++++++++++++++ 9 files changed, 243 insertions(+), 41 deletions(-) rename old/{CNF_DBProgressTest.pl => CNF_DBPGTest.pl} (81%) rename old/{databaseProgresSQL.cnf => databasePGSQL.cnf} (97%) create mode 100644 vs_code_extensions.lst diff --git a/old/CNF_DBProgressTest.pl b/old/CNF_DBPGTest.pl similarity index 81% rename from old/CNF_DBProgressTest.pl rename to old/CNF_DBPGTest.pl index 6ca8586..571c567 100644 --- a/old/CNF_DBProgressTest.pl +++ b/old/CNF_DBPGTest.pl @@ -25,7 +25,7 @@ sub BEGIN { $pwd = `pwd`; $pwd =~ s/\/*\n*$//; } -my $cnf = new CNFParser('databaseProgresSQL.cnf'); +my $cnf = new CNFParser('old/databasePGSQL.cnf'); print "resw".$cnf->isReservedWord('TABLE'); print "resw:".$cnf->isReservedWord(); @@ -35,14 +35,14 @@ my $alin= $cnf->anon('AUTO_LOGIN'); my ($u,$p) = split '/', $alin; my $db = DBI->connect($DSN, $u, $p, {AutoCommit => 1, RaiseError => 1, PrintError => 0, show_trace=>1}); -$cnf->initiDatabase(\$db); -foreach my $const(keys %{$cnf->constants()}){ - print $const, "\n"; +#$cnf->initiDatabase(\$db); +foreach my $const(keys %$cnf){ + print $const." =". $cnf->{$const}, "\n"; } -our $APP_VER = $cnf->constant('$APP_VER'); $APP_VER++; +our $APP_VER = $cnf->{'$APP_VER'}; $APP_VER++; print $APP_VER, "\n"; our $APP_VER1 = $cnf->constant('$APP_VER'); print $APP_VER1, "\n"; diff --git a/old/CNF_GD_PLOT.pl b/old/CNF_GD_PLOT.pl index f4ed815..183d8f7 100755 --- a/old/CNF_GD_PLOT.pl +++ b/old/CNF_GD_PLOT.pl @@ -9,7 +9,6 @@ use GD::Graph::lines; #DEFAULT SETTINGS HERE! #LanguageServer doesn't like -> $ENV{'PWD'} settings.json should not be set for it withn an pwd. -#use lib "system/modules/"; use lib "system/modules"; require CNFParser; @@ -46,7 +45,3 @@ open $OUT, ">","./BitcoinCurrentLast30Days.png" or die "Couldn't open for output binmode($OUT); print $OUT $gd->png(); close $OUT; - - - - diff --git a/old/databaseBitcoinPlot.cnf b/old/databaseBitcoinPlot.cnf index 13e066c..f2994c7 100644 --- a/old/databaseBitcoinPlot.cnf +++ b/old/databaseBitcoinPlot.cnf @@ -6,7 +6,7 @@ $APP_VER= 1.0 $RELEASE_VER = 1.0`Current CNF version under test. >> -<>> +<>> <>> <my $date = `date +%c`;>> <<@<@DIM_SET_BITCOIN>1200,480>> @@ -15,7 +15,7 @@ $RELEASE_VER = 1.0`Current CNF version under test. title = 'Current Bitcoin Price State $$$CNF_PROCESSING_DATE$$$' x_label = 'Days' y_label = 'Price' -y_max_value = 67000 +y_max_value = 76000 #<- TODO algorithmically calculate. y_tick_number = 10 x_all_ticks = 1 y_all_ticks = 1 @@ -28,25 +28,25 @@ line_width = 2 Columns max,min,avg are the plot lines, dt is the x period line in last 30 days < -SELECT +SELECT concat(date_part('day', dt), '/', date_part('month', dt)), - max::numeric(10,2), - min::numeric(10,2), - avg::numeric(10,2) -FROM public."DAILY_AVG_BITCOIN" + max::numeric(10,2), + min::numeric(10,2), + avg::numeric(10,2) +FROM public."DAILY_AVG_BITCOIN" WHERE dt >= (now() - '30 days'::interval)::date ORDER BY dt DESC; >> < -SELECT +SELECT concat(date_part('day', dt), '/', date_part('month', dt)), - max::numeric(10,2), - min::numeric(10,2), - avg::numeric(10,2) -FROM public."DAILY_AVG_BITCOIN" - WHERE dt >= (now() - '3 month'::interval)::date + max::numeric(10,2), + min::numeric(10,2), + avg::numeric(10,2) +FROM public."DAILY_AVG_BITCOIN" + WHERE dt >= (now() - '3 month'::interval)::date ORDER BY dt; >> @@ -84,12 +84,12 @@ export XAUTHORITY="$HOME/.Xauthority" echo -e $(date +"%D %T") $(basename $0) "Started" stor=$($HOME/uvar.sh -r BITCOIN_PRICE); -grab=$(curl -s rate.sx./1btc | cut -d. -f1) +grab=$(curl -s rate.sx./1btc | cut -d. -f1) record=0 if [ -z $stor ] || [ $stor -ne $grab ]; then $HOME/uvar.sh -n BITCOIN_PRICE -v $grab; stor=$grab; record=1; -fi +fi grab=$(printf "US $%'.2f", $grab) /usr/bin/notify-send "BITCON PRICE" "$grab" if [ $record == 1 ]; then diff --git a/old/databaseProgresSQL.cnf b/old/databasePGSQL.cnf similarity index 97% rename from old/databaseProgresSQL.cnf rename to old/databasePGSQL.cnf index 2df58fa..6f86a94 100644 --- a/old/databaseProgresSQL.cnf +++ b/old/databasePGSQL.cnf @@ -3,7 +3,7 @@ --- Prerequisite is that CNF_TEST_DB is created and assigned to user postgres or what ever stated bellow: -<>> +<>> <>> <>> diff --git a/system/modules/CNFNode.pm b/system/modules/CNFNode.pm index 01d27f8..98767ba 100644 --- a/system/modules/CNFNode.pm +++ b/system/modules/CNFNode.pm @@ -13,6 +13,10 @@ sub new { my $self = \%$attrs; bless $self, $class; } +sub _isNode { + return ref(shift) eq 'CNFNode' +} + use constant PRIVATE_FIELDS => qr/@\$|[@#_~^&]/o; use constant EMPTY => new CNFNode; @@ -142,10 +146,17 @@ sub items(){ # NOTICE - 20221222 Future versions might provide also for more complex path statements with regular expressions enabled. ### sub find { - my ($self, $path, $ret, $prev, $seekArray,$ref)=@_; my @arr; + my ($self, $path, $ret, $prev, $seekArray,$ref)=@_; my (@arr,$seekPName); foreach my $name(split(/\//, $path)){ - if( $name eq "*" && @arr){ - return \@arr # The path instructs to return an array, which is set but return is set to single only found element. + 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; + # } + $seekPName = $self->{'_'} if ref($self) eq 'CNFNode'; + $seekArray = 1; + $ret = \@arr; + next; } elsif(ref($self) eq "ARRAY"){ if($name eq '#'){ @@ -187,7 +198,7 @@ sub find { if (!$seekArray){ # This will initiate further search in subproperties names. $ret = $self->{'@$'}; - @arr = (); + @arr = () } } } @@ -196,10 +207,29 @@ sub find { my $found = 0; undef $prev; foreach my $ele(@$ret){ + my $r = ref($ele); + if($r eq 'ARRAY'){#TODO Is this to account here allso for rest of search path? + $ele = @{$ele}[0] + } if($seekArray && exists $ele->{'@$'}){ foreach my$node(@{$ele->{'@$'}}){ if ($node->{'_'} eq $name){ $arr[@arr] = $ele = $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($ref eq 'CNFNode'){ + $ele = $seek; + } } } if(@arr>1){ @@ -230,9 +260,11 @@ sub find { $ret = $ele->{$name}; $found = 1 } + }elsif($ele->{'_'} eq $name){ + $ret = $ele } } - if(!$found && $name ne '@$' && exists $self->{$name}){ + if(!$found && $name ne '@$' && $ref ne 'ARRAY' && exists $self->{$name}){ $ret = $self->{$name} }else{ undef $ret if !$found @@ -244,6 +276,24 @@ sub find { } return !$ret?\@arr:$ret; } +## +# Convinence method to find lastChild or all chidren by a certain name. +## +sub findChildrenByName { + my ($self, $name, $ret,@arr)=@_; + if($self->{'_'} eq $name){ + return $self; + } + foreach my $child(@{$self->{'@$'}}){ + my $find = $child -> findChildrenByName($name); + $arr[@arr] = $find if $find + } + if(@arr>1){ + return \@arr; + } + return $arr[0]; +} + ### # Similar to find, put simpler node by path routine. # Returns first node found based on path. @@ -276,6 +326,9 @@ sub node { } return $ret } + + + ### # Outreached subs list of collected node links found in a property. my @linked_subs; @@ -716,7 +769,19 @@ sub equals { } return 0; } - +### +# Obtaine the full path of this node. +### +sub toPath { + my($self, @arr)= @_; + if(exists $self -> {'@'}){ + return ${$self -> {'@'}} -> toPath() . '/'. $self->{_} + } + return $self -> {'_'} +} +### +# Convert this node to CNF Script. +### sub toScript { my($self,$nested,$script)= @_; my($isParent,$tag,$tab); $nested=1 if!$nested; $tab =3*$nested; $tab = ' 'x$tab; @@ -757,7 +822,6 @@ sub toScript { $script .= "$tab <@@<$_>@@>\n" } } - my $nodes = $self->{'@$'}; if($nodes){ foreach my $nd (@$nodes) { @@ -768,7 +832,14 @@ sub toScript { $script .= toScript($nd, $nested+1); }elsif ($ref eq 'ARRAY'){ foreach my $itm (@$nd) { - $script .= toScript($itm, $nested+1); + $ref = ref($itm); + if ($ref eq 'CNFNode'){ + $script .= toScript($itm, $nested+1); + }else{ + foreach my $itm2 (@$itm) { + $script .= toScript($itm2, $nested+1); + } + } } } } diff --git a/system/modules/CNFParser.pm b/system/modules/CNFParser.pm index e2af36b..69f766d 100644 --- a/system/modules/CNFParser.pm +++ b/system/modules/CNFParser.pm @@ -1423,8 +1423,8 @@ sub dumpENV{ } sub SQL { + my $self = shift; if(!$SQL){##It is late compiled package on demand. - my $self = shift; my $data = shift; require CNFSQL; $SQL = CNFSQL->new({parser=>$self}); } diff --git a/tests/testCNFNode.pl b/tests/testCNFNode.pl index d1e2cda..3a0ec54 100644 --- a/tests/testCNFNode.pl +++ b/tests/testCNFNode.pl @@ -1,5 +1,5 @@ #!/usr/bin/env perl -use warnings; use strict; +use warnings; use strict; use v5.35; use lib "tests"; use lib "system/modules"; @@ -128,11 +128,67 @@ use Syntax::Keyword::Try; try { $test -> nextCase(); # - # # + $test -> case("Find path test for selecting children by certain name."); + + $node -> process( CNFParser->new(),q( + #> + >div> + #> + >div> + div> + div> + ]has_div_children] + text> + >div> + text> + >div> + >div> + >div> + >div> + >div> + >parent> + )); + + my $find = $node->find('/parent/has_div_children/@$'); + $test -> isDefined("\@find[/parent/has_div_children/@@]",$find); + $test -> evaluate("\$find[0]"," One ",$find->[0]->val()); + $test -> evaluate("\$find[0]"," Two ",$find->[1]->val()); + $test -> evaluate("\$find[0]","Three",$find->[2]->val()); + $test -> evaluate("\$find[0]"," Four ",$find->[3]->val()); + + $find = $node->find('/parent/div/*/text'); + $test -> isZeroOrEqual("\$find",CNFNode::_isNode($find)); + foreach(@$find){ + my $path = $_->toPath(); + say "<<$path<", $_->val(),">>>"; + $test -> failed("Path:$path not recognise!") + if $path ne 'node/parent/div/div/div/text' & + $path ne 'node/parent/div/div/div/div/div/text' + } + $test -> evaluate("\$find[/parent/div/*/text]","Deeply Nested!",$find->[0]->val()); + $test -> evaluate("\$find[/parent/div/*/text]","This Too!",$find->[1]->val()); + + + + # + $test -> nextCase(); + # + + # $test->done(); # } catch{ $test -> dumpTermination($@); - $test -> doneFailed(); + $test->doneFailed(); } diff --git a/tests/testCNFNodeShortiefs.pl b/tests/testCNFNodeShortiefs.pl index 21e1eac..0f3a949 100644 --- a/tests/testCNFNodeShortiefs.pl +++ b/tests/testCNFNodeShortiefs.pl @@ -50,11 +50,12 @@ use Syntax::Keyword::Try; try { #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)); + $test -> evaluate("Does [".$content->name()."] have 2 child nodes?",2,scalar(@divs)); #TODO Following not working at the moment: +#say $node->toScript(); my $div1 = $node->find('content/div/div1'); - $test->failed('content/div/div1 not found!') if $test->isZeroOrEqual("div1",scalar(@{$div1}),0); + $test->failed('content/div/div1 not found!') if not $test->isDefined("div1",$div1); + $test->evaluate('content/div/div1[class] value matches?','paragraph',$div1->{class}); say $node->toScript(); ### $test->done(); diff --git a/vs_code_extensions.lst b/vs_code_extensions.lst new file mode 100644 index 0000000..b4b2b76 --- /dev/null +++ b/vs_code_extensions.lst @@ -0,0 +1,79 @@ +alefragnani.project-manager +angular.ng-template +awehook.vscode-blink-mind +bianxianyang.htmlplay +bibhasdn.git-easy +bierner.markdown-mermaid +bierner.markdown-preview-github-styles +bpruitt-goddard.mermaid-markdown-syntax-highlighting +bscan.perlnavigator +codezombiech.gitignore +conradludgate.rust-playground +davidanson.vscode-markdownlint +dbaeumer.vscode-eslint +donjayamanne.git-extension-pack +donjayamanne.githistory +dustypomerleau.rust-syntax +dzhavat.bracket-pair-toggler +eamodio.gitlens +ecmel.vscode-html-css +esbenp.prettier-vscode +felipecaputo.git-project-manager +firefox-devtools.vscode-firefox-debug +formulahendry.auto-rename-tag +fractalboy.pls +george-alisson.html-preview-vscode +github.github-vscode-theme +github.remotehub +github.vscode-pull-request-github +gruntfuggly.todo-tree +harryhopkinson.vs-code-runner +hediet.vscode-drawio +howardzuo.vscode-git-tags +irongeek.vscode-env +james-yu.latex-workshop +jeff-hykin.better-perl-syntax +jorol.perl-completions +letmaik.git-tree-compare +mdickin.markdown-shortcuts +mhutchie.git-graph +mikestead.dotenv +ms-azuretools.vscode-docker +ms-edgedevtools.vscode-edge-devtools +ms-python.debugpy +ms-python.isort +ms-python.python +ms-python.vscode-pylance +ms-toolsai.jupyter +ms-toolsai.jupyter-keymap +ms-toolsai.jupyter-renderers +ms-toolsai.vscode-jupyter-cell-tags +ms-toolsai.vscode-jupyter-slideshow +ms-vscode-remote.remote-containers +ms-vscode-remote.remote-ssh +ms-vscode-remote.remote-ssh-edit +ms-vscode.azure-repos +ms-vscode.cpptools +ms-vscode.live-server +ms-vscode.makefile-tools +ms-vscode.remote-explorer +ms-vscode.remote-repositories +ms-vscode.vscode-speech +nopeslide.vscode-drawio-plugin-mermaid +richterger.perl +ritwickdey.liveserver +rust-lang.rust-analyzer +s2junn.git-essentials +serayuzgur.crates +shaharkazaz.git-merger +smallcloud.codify +solnurkarim.html-to-css-autocompletion +streetsidesoftware.code-spell-checker +swellaby.rust-pack +tamasfe.even-better-toml +thekalinga.bootstrap4-vscode +thinker.properties +valentjn.vscode-ltex +wbudic.perlcnf +xabikos.javascriptsnippets +ziyasal.vscode-open-in-github -- 2.34.1