]> lifelog.hopto.org Git - PerlCNF.git/commitdiff
CNFNode changes readopted.
authorWill Budic <redacted>
Wed, 5 Feb 2025 22:50:46 +0000 (09:50 +1100)
committerWill Budic <redacted>
Wed, 5 Feb 2025 22:50:46 +0000 (09:50 +1100)
system/modules/DatabaseCentralPlugin.pm
system/modules/HTMLIndexProcessorPlugin.pm
system/modules/HTMLProcessorPlugin.pm
system/modules/TestManagerOld.pm [deleted file]
test.cnf

index c117d77bf933f00aca0cae3ed05b49d31d66b584..6e9b32babfc4d710670f42b44caf1d39c93d8c0b 100644 (file)
@@ -136,7 +136,7 @@ sub main ($self, $parser, $property) {
 
     my $ref = ref($schema_node);
 if($ref eq 'CNFNode'){
-       my @NodesTable = @{$schema_node -> find('/table/*')};
+       my @NodesTable = @{$schema_node -> search('/table/*')};
        warn "Not found any 'table/*' path elements for CNF property :". $schema_node->toPath() if not @NodesTable;
 ###
        my $cnf_data = $parser->data();
@@ -623,7 +623,7 @@ sub createSQLStatements($self, $parser, $schema,$table_name, $table_data, $node)
             return 1
         }
     }else{  # Automation create sql from the schema node tree mapping not actual data header scripted. Not recomended approcah but here we go!
-            my @columns = @{$node->find('cols/@@')};
+            my @columns = @{$node->search('cols/@@')};
             die "[$cnf_property] -> $table_name Not found any 'cols/@@' path elements for CNF node script ->".$node->toScript if not @columns;
             my($tins,$vins,$upds,$sels,$IDName);
             if(!@header){
index 9b3ea7610f182735d879f5e8e4f13c35e69b0450..95969f7c6bfcbf40a5ee3c7d98f6403be96cefdc 100644 (file)
@@ -63,22 +63,22 @@ try{
         my (@hhshCSS,@hhshJS);
         if($link){
         if(ref($link) eq 'CNFNode'){
-                my $arr = $link->find('CSS/@@');
+                my $arr = $link->search('CSS/@@');
                 foreach (@$arr){                
                     push  @hhshCSS, {-type => 'text/css', -src => $_->val()};                
                 }
-                $arr = $link->find('JS/@@');
+                $arr = $link->search('JS/@@');
                 foreach (@$arr){                
                     push  @hhshJS, {-type => 'text/javascript', -src => $_->val()};                
                 } 
-                $arr = $link  -> find('STYLE');
+                $arr = $link  -> search('STYLE');
                 if(ref($arr) eq 'ARRAY'){
                     foreach (@$arr){
                         $give_me .= "\n<style>\n".$_ -> val()."\n</style>\n"
                     }}else{
                         $give_me .= "\n<style>\n".$arr -> val()."\n</style>\n"
                 }
-                $arr = $link  -> find('SCRIPT');
+                $arr = $link  -> search('SCRIPT');
                 if(ref($arr) eq 'ARRAY'){
                     foreach (@$arr){ 
                         $give_me .= "\n<script>\n".$_ -> val()."\n</script>\n"
index 96168f7d39ce10070065a4d115c775dbb5dd8a4d..062d80c83eb8b9b2969a97a34311d60f357a467e 100644 (file)
@@ -39,22 +39,22 @@ try{
     $body_attrs .= " ". $tree -> {'Body'} if exists $tree -> {'Body'};
     if($link){
        if(ref($link) eq 'CNFNode'){
-            my $arr = $link->find('CSS/@@');
+            my $arr = $link->search('CSS/@@');
             foreach (@$arr){
                 my $v = $_->val();
                 $bfHDR .= qq(\t<link rel="stylesheet" type="text/css" href="$v" />\n);
             }
-            $arr = $link->find('JS/@@');
+            $arr = $link->search('JS/@@');
             foreach (@$arr){
                 my $v = $_->val();
                 $bfHDR .= qq(\t<script src="$v"></script>\n);
             } 
             # Glob find '/*'  now has guaranteed array cast derefence return. Even if nothing found. Some folks will cringe on that. Ahahaha!
-            $arr = $link  -> find('STYLE/*'); 
+            $arr = $link  -> search('STYLE/*'); 
             foreach (@$arr){
                 $style = "\n<style>\n".  $_ -> val()."</style>"
             }
-            $arr = $link  -> find('JAVASCRIPT/*');
+            $arr = $link  -> search('JAVASCRIPT/*');
             foreach (@$arr){
                 $jscript = "\n<script>\n".  $_ -> val()."</script>"
             }            
diff --git a/system/modules/TestManagerOld.pm b/system/modules/TestManagerOld.pm
deleted file mode 100644 (file)
index 8c4393a..0000000
+++ /dev/null
@@ -1,49 +0,0 @@
-#!/usr/bin/perl -w
-#
-# Test Manager to make test case source code more readable and organised. 
-# This is initial version, not supporting fall through and multiple test files and cases.
-#
-# Programed by: Will Budić
-# Open Source License -> https://choosealicense.com/licenses/isc/
-#
-package TestManager;
-
-use strict;
-use warnings;
-
-use Test::More;
-use Test::Vars;
-
-our $case;
-our $case_cnt = 0; 
-
-sub construct { my ($class, $self_args) = @_;
-    die 'Arguments not passed -> {name=?:Name of this Manger., count=?:Current test count.}' if not $self_args;
-    bless $self_args, $class;    
-    return $self_args;
-}
-
-sub checkPackage {my ($self, $package)=@_;
-    print "Checking package $package";
-    vars_ok $package;
-}
-sub startCase {my ($self, $case)=@_;
-    $self->{case}=$case;
-    print "TestCase ".++$case_cnt.": Started -> $case\n"
-}
-sub info { my ($self, $info)=@_;
-    print "TestCase ".$case_cnt.":info: $info\n"
-}
-sub endCase {my ($self, $package)=@_;
-    print "TestCase $case_cnt: Ended -> $self->{case} PASSED!\n"
-}
-sub eval { my ($self, $a, $b, $c)=@_;
-    if ($c) {my $swp = $a; $a = $b; $b= $c; $c = $swp}else{$c=""};
-    die "$0 Test on ->". $self->{case} .", Failed!\n\neval(\n\$a->$a\n\$b->$b\n)\n" unless $a eq $b;
-    print "\tTest " .++$self->{count}.": Passed -> $c [$a] equals [$b]\n"
-}
-sub finish {my $self = shift;
-    print "\nALL TESTS HAVE PASSED for ". $self->{name}. " Totals ->  test cases: ".$case_cnt. " test count: ".$self->{count}."\n";
-    done_testing;
-}
-1;
\ No newline at end of file
index 25f7fafb25add9843b96ceb10c13859b91751f4e..1da88ec68a956a52a8b12f780009549d90f2dd9d 100644 (file)
--- a/test.cnf
+++ b/test.cnf
@@ -1,17 +1,20 @@
-<<paragraphs$$<TREE>
-<content< __IN_SHORTIFE__
+<<paragraphs$$<TREE> __HAS_PROCESSING_PRIORITY__
+<content<
  class : main
-    div__\
+ pass:true
+    div__\ __IN_SHORTIFE__
       class: paragraphs
       div1__\
         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.
-    div2__//
-    class: paragraph
-    Second parapgraph here.
+          It is easier to the eye, and more readable. You can be the judge. __~
+        __/
+       div2__\
+        class: paragraph
+        Second paragraph here. __~ # A sub node values has to be terminated, otherwise will get skipped.
+        __//
 >content>
 >>
 
@@ -21,5 +24,19 @@ test list type anon with instructions.
 >content>
 >>
 
-<<paragraphs$$<Simple format of annon.>>>
-<<paranormal$$>value>>
\ No newline at end of file
+<<paragraphs$$<Simple format of anon.>>>
+<<paranormal$$>value>>>
+
+<<<TREE __IN_SHORTIFE__ meta __\
+  @@ __\
+      header __\
+          link __\
+              rel  = stylesheet
+              href = wsrc/main.css
+              Its Text 
+  ________///  
+  @@ __\
+      tag: css_style
+      property: <*<MarkdownPlugin::CSS>*>
+   __/
+__/ >>>
\ No newline at end of file