From: Will Budic Date: Tue, 18 Mar 2025 18:01:18 +0000 (+1100) Subject: Linking in Shortifs implemented. X-Git-Url: https://lifelog.hopto.org/gitweb/?a=commitdiff_plain;h=a907e9033e25d2a1e94a3c61b4aa37d3dd59bc8f;p=PerlCNF.git Linking in Shortifs implemented. --- diff --git a/system/modules/GenericInstructionHandler.pm b/system/modules/GenericInstructionHandler.pm new file mode 100644 index 0000000..20e1b20 --- /dev/null +++ b/system/modules/GenericInstructionHandler.pm @@ -0,0 +1,40 @@ +package GenericInstructionHandler; + +use strict; +use warnings; no warnings qw(experimental::signatures); +use feature qw(signatures); + +sub new {my ($class, $args) = @_; + bless $args, $class; +} + +package CNFGenericProperty{ + my $value; + sub new ($class, $args, $val){ + $value = $val; + return bless $args, $class; + } + + sub val{ + return $value; + } +} + + +sub instruct ($self, $parser, $instruction, $body){ + my ($obj, %args, $value); + $body =~ s/^\s*|\s*$//; + foreach my $ln(split(/\n/,$body)){ + my @pair = $ln =~ /\s*(\w+)[:=](.*)\s*/; + if(!$value && $pair[1]){ + $args{$pair[0]} = $pair[1] if $pair[0] =~ /[a-z]/i + }else{ + $ln =~ s/^\s*|\s*$//; + $value .= $ln . "\n"; + } + } + $value =~ s/\s*$//; + return CNFGenericProperty -> new(\%args,$value) +} + +1; \ No newline at end of file diff --git a/system/modules/MarkdownPlugin.pm b/system/modules/MarkdownPlugin.pm index bd8dfff..f35c1aa 100644 --- a/system/modules/MarkdownPlugin.pm +++ b/system/modules/MarkdownPlugin.pm @@ -17,7 +17,7 @@ use Clone qw(clone); use constant VERSION => '1.1'; our $TAB = ' 'x4; -our $PARSER; + ### # Constances for CSS CNF tag parts. See end of this file for package internal provided defaults CSS. ### @@ -45,7 +45,7 @@ sub new ($class, $plugin){ sub convert ($self, $parser, $property) { try{ my ($item, $script) = $parser->anon($property); - $PARSER = $parser; + die "Property not found [$property]!" if !$item; my $ref = ref($item); my $escaped = 0; $script = $item; @@ -57,26 +57,71 @@ try{ }elsif($script !~ /\n/ and -e $script ){ my $file = $parser->anon($property); $script = do { - open my $fh, '<:encoding(UTF-8)', $script or MarkdownPluginException->throw("File not avaliable: $script"); + open my $fh, '<:encoding(UTF-8)', $script or MarkdownPluginException->throw("File not available: $script"); local $/; <$fh>; }; } if($escaped){ - $script =~ s/\\/>/gs; - #$script =~ s/\n/
/gs; + $script =~ s/\\/>/gs; + } + my $macro_instructions = $self -> {instructions}; + if($macro_instructions){ + my $tree = $parser->anon($macro_instructions); + my $links = $tree->node('links'); + foreach my $link($links->nodes()){ + my $tag = $link->name(); + my $rep = "[".$link->{desc}."](".$link->{url}.")"; + $script =~ s/\[\$\$\$\[\s*$tag\s*\]\$\$\$\]/$rep/gex + } + + my $images = $tree->node('links'); + foreach my $img($images->nodes()){ + my $tag = $img->name(); + my $rep = "![".$img->{desc}."](".$img->{url}.")"; + $script =~ s/\[\$\$\$\[\s*$tag\s*\]\$\$\$\]/$rep/gex + } + + + my $val = $tree->val(); + if($val){ + $script =~ s/\[\$\$\$\[\s*$macro_instructions\s*\]\$\$\$\]/$val/gex + } } - my @doc = @{parse($self,$script)}; + my @doc = @{parse($self, $parser, $script)}; $parser->data()->{$property} = $doc[0]; - $parser->data()->{$property.'_headings'} = $doc[1]; + $parser->data()->{$property.'_headings'} = [__PACKAGE__,'toHTML_headings',$doc[1]]; }catch($e){ MarkdownPluginException->throw(error=>$e ,show_trace=>1); }} +sub toHTML_headings($self,$hdrs) { + my @headings = @$hdrs; + my $bf; + my $level = 0; + for my $i(0..$#headings){ + my @spec = @{$headings[$i]}; + my $cnt = $i+1; + my $lvl = $spec[1]; + my $lnk = "".$spec[0].""; + if($lvl!=$level){ + if($lvl>$level){ + $bf .= ""; + } + $level = $lvl; + } + $bf .= qq(
  • $lnk
    • ) + } + while($level-->0){$bf .= ""}; + return $bf; +} + ### -# Helper package to resolve the output of HTML lists in order of apperance in some MD script. +# Helper package to resolve the output of HTML lists in order of appearance in some MD script. # It is a very complex part of the parsing algorithm routine. # This mentioned, here look as the last place to correct any possible translation errors. # @CREATED 20230709 @@ -154,11 +199,11 @@ sub setCodeTag($tag, $class){ return [$class, $tag] } -sub parse ($self, $script){ +sub parse ($self, $parser, $script){ try{ my ($buff, $para, $ol, $lnc); my $list_end; my $ltype=0; my $nix=0; my $nplen=0; my $list_item; my $list_root; - my @titels;my $code = 0; my ($tag, $class); my $pml_val = 0; my ($bqte, $bqte_nested,$bqte_tag); + my @titles;my $code = 0; my ($tag, $class); my $pml_val = 0; my ($bqte, $bqte_nested,$bqte_tag); $script =~ s/^\s*|\s*$//; foreach my $ln(split(/\n/,$script)){ $ln =~ s/\t/$TAB/gs; $lnc++; @@ -222,19 +267,20 @@ try{ next } if(!$code && $ln =~ /^\s*(#+)\s*(.*)/){ - my $h = 'h'.length($1); + my $L = length($1); + my $h = 'h'.$L; my $title = $2; - $titels[@titels] = {$lnc,$title}; + $titles[@titles] = [$title,$L,$lnc]; if($list_root){ # Has been previously gathered and hasn't been buffered yet. $buff .= $list_root -> toString(); undef $list_root; undef $list_item; } - $buff .= qq(<$h>$title\n" + $buff .= qq(<$h>$title\n" } elsif(!$code && ($ln =~ /^(\s*)(\d+)\.\s(.*)/ || $ln =~ /^(\s*)([-+*])\s(.*)/)){ my $spc = length($1); - my $val = $3 ? ${style($3)} : ""; + my $val = $3 ? ${style($parser,$3)} : ""; my $new = HTMLListItem->new(($2=~/[-+*]/?'ul':'ol'), $val, $spc); if(!$list_root){ $list_end = 0; @@ -282,10 +328,10 @@ try{ }else{ if($bqte_tag eq 'p'){ $ln =~ s/^\s*//g; - $bqte .= ${style($ln)}."
    "; + $bqte .= ${style($parser,$ln)}."
    "; }else{ $ln =~ s/^\s*[-+*]\s*|^\s*\d+\.\s*//g; - $bqte .= "
  • ".${style($ln)}."
    • \n"; + $bqte .= "
  • ".${style($parser,$ln)}."
    • \n"; } } } @@ -310,7 +356,7 @@ try{ $para .= inlineCNF($v,$spc)."
    \n" }else{ $spc =~ s/\s/ /g; - $para .= $spc.code2HTML($v)."
    \n" + $para .= $spc.code2HTML($parser,$v)."
    \n" } }else{ $v = inlineCNF($v,$spc); @@ -399,7 +445,7 @@ try{ undef $bqte; } if($list_root && $spc>0){ - my $new = HTMLListItem -> new('dt', ${style($v)}, $spc); + my $new = HTMLListItem -> new('dt', ${style($parser,$v)}, $spc); if($spc>$nplen){ $list_item -> add($new); $list_item = $new; @@ -416,7 +462,7 @@ try{ } $list_end = 0; }else{ - $para .= ${style($v)}."\n" + $para .= ${style($parser,$v)}."\n" } } }else{ @@ -457,12 +503,12 @@ try{ $buff .= $list_root-> toString(); } $buff .= qq(

    $para

    \n) if $para; -return [\$buff,\@titels] +return [\$buff,\@titles] }catch($e){ MarkdownPluginException->throw(error=>$e ,show_trace=>1); }} -sub code2HTML($val){ +sub code2HTML($parser, $val){ my ($v,$cmnt)=($val,""); $v =~ s/(.*?)(\#.*)/$2<\/span>/g; @@ -475,7 +521,7 @@ sub code2HTML($val){ my @strs = ($v =~ m/(['"].*?['"])/g); foreach(0..$#strs){ my $r = $strs[$_]; $r =~ s/\[/\\[/; - $PARSER->log($r); + $parser->log($r); my $w = "\f$_\f"; $v =~ s/$r/$w/ge; } @@ -495,7 +541,7 @@ sub code2HTML($val){ return "$v$cmnt"; } -sub inlineCNF($v,$spc){ +sub inlineCNF($parser, $v, $spc){ $v =~ m/(<{2,3})(.*?)(>{2,3})(.*)/g; my $oo = $1;$oo =~s/\s+//;#<- fall through expression didin't match @@ -556,7 +602,7 @@ sub inlineCNF($v,$spc){ my $end =$4; if($end){ my $changed = ($end =~ s/(>|<)$//g); - if($PARSER -> isReservedWord($end)){ + if($parser -> isReservedWord($end)){ $v = "$end"; $v .= "".($1 eq '<'?"<":">")."" if $changed }else{ if (!$var){$v = "$r"}else{$v=""} @@ -617,7 +663,7 @@ if(!$oo && !$cc){ $val =~ /(.*)(>$)/; if($1&&$2){ my $v = $1; my $i = $2; - if($PARSER->isReservedWord($v)){ + if($parser->isReservedWord($v)){ $v = "$v" }else{ $v =~ s/(\w+)(\$+)/$1<\/span>$2<\/span>/g; @@ -625,7 +671,7 @@ if(!$oo && !$cc){ } $val=$v; $cc = ">"; - }elsif($PARSER->isReservedWord($var)){ + }elsif($parser->isReservedWord($var)){ $var = "$var"; $val =~ s//>/g; @@ -649,7 +695,7 @@ if(!$oo && !$cc){ if(!$7){ $t =~ /(\w*)(\\\w*|\s*)(.*)/; my $i = $1; - if($PARSER->isReservedWord($i)){ + if($parser->isReservedWord($i)){ $i = "$i" }else{ $i = "$i" @@ -700,14 +746,14 @@ sub propValCNF($v){ } -sub style ($script){ +sub style ($parser, $script){ MarkdownPluginException->throw(error=>"Invalid argument passed as script!",show_trace=>1) if !$script; #Links $script =~ s/<(http[:\/\w.]*)>/$1<\/a>/g; $script =~ s/(\*\*([^\*]*)\*\*)/\$2<\/em\>/gs; if($script =~ m/[<\[]\*[<\[](.*)[\]>]\*[\]>]/){#It is a CNF link not part of standard Markup. my $link = $1; - my $find = $PARSER->obtainLink($link); + my $find = $parser->obtainLink($link); $find = $link if(!$find); $script =~ s/[<\[]\*[<\[](.*)[\]>]\*[\]>]/$find/gs; } @@ -734,7 +780,7 @@ return qq($desc) } ### -# Style sheet used for HTML conversion. NOTICE - Style sheets overide sequentionaly in order of apperance. +# Style sheet used for HTML conversion. NOTICE - Style sheets override sequentially in order of appearance. # Link with: <**> in a TREE instructed property. ### use constant CSS => q/ diff --git a/system/modules/TestInstructor.pm b/system/modules/TestInstructor.pm index 3218dbe..97edb66 100644 --- a/system/modules/TestInstructor.pm +++ b/system/modules/TestInstructor.pm @@ -6,7 +6,7 @@ use Syntax::Keyword::Try; sub new {my ($class, $args) = @_; bless $args, $class; } -sub instruct { my ($self,$parser,$instruction, $body) = @_; +sub instruct { my ($self,$parser, $instruction, $body) = @_; print "$body"; } #As PROCESSOR this is the function. diff --git a/tests/dbSQLSetup.cnf b/tests/dbSQLSetup.cnf index 125cd22..5f88ea5 100644 --- a/tests/dbSQLSetup.cnf +++ b/tests/dbSQLSetup.cnf @@ -119,10 +119,10 @@ ID`address`state`city`postcode`country~ property : @directories >> ## List of local directories to search for config files to stat and put into the db. -## Array defined propery like this is placed as an collection obtained method. +## Array defined property like this is placed as an collection obtained method. ## The plugin currently using it, has been programed and expecting it like that. -## This flat config approuch is very useful, in the long run. -## As other application might be using and accessing as well, and we want to avoid props repetition and redundancey. +## This flat config approach is very useful, in the long run. +## As other application might be using and accessing as well, and we want to avoid props repetition and redundancy. ## Don't we? ## <<@<@directories> diff --git a/tests/testCNFAnons.pl b/tests/testCNFAnons.pl index 45f450a..bd58d00 100644 --- a/tests/testCNFAnons.pl +++ b/tests/testCNFAnons.pl @@ -126,6 +126,8 @@ try{ $test-> nextCase(); # + + $test->case("Test older anon cases v.2.4 compatibility."); ### # Test older cases v.2.4 compatibility. ## @@ -158,7 +160,7 @@ CNFParser->new()->parse(undef,qq( my $cnf = CNFParser->new("./old/databaseAnonsTest.cnf"); my $find = $cnf->anon('GET_SUB_URL',CNFParser->META); die "Failed finding GET_SUB_URL" if not $find; -die "Missmatched found in GET_SUB_URL" if $find ne 'https://www.THE_ONE.acme.com/$$$2$$$'; +die "Mismatched found in GET_SUB_URL" if $find ne 'https://www.THE_ONE.acme.com/$$$2$$$'; # Let's try som JSON crap, lol. $find = $cnf->anon('GET_SUB_URL',CNFParser->META_TO_JSON); diff --git a/tests/testCNFNode.pl b/tests/testCNFNode.pl index 34bdc32..0dc49b0 100644 --- a/tests/testCNFNode.pl +++ b/tests/testCNFNode.pl @@ -278,7 +278,7 @@ __/ >ListNodes> )); my $plist = $node -> node('ListNodes')->list(); - $test->evaluate("ListNodes has three elemenet?", 3, scalar(@$plist)); + $test->evaluate("ListNodes has three element?", 3, scalar(@$plist)); $test->evaluate("ListNodes[0] is 1?", 1, @$plist[0]->val()); $test->evaluate("ListNodes[0] is 2?", 2, @$plist[1]->val()); $test->evaluate("ListNodes[0] is 3?", 3, @$plist[2]->val()); diff --git a/tests/testCNFNodeShortiefs.pl b/tests/testCNFNodeShortiefs.pl index a07b65f..0282310 100644 --- a/tests/testCNFNodeShortiefs.pl +++ b/tests/testCNFNodeShortiefs.pl @@ -17,11 +17,14 @@ package main; use Syntax::Keyword::Try; try { + my $parser = CNFParser->new(); + + $test -> case("Test process list parsing shortif directly.", '1' ); $test -> subcase("Multiline value."); my $nd1 = CNFNode::_createNode('root'); - CNFNode::_parseShortife( \$nd1, q( + CNFNode::_parseShortife($parser, \$nd1, q( A __\ sub __\ Contains this paragraph, @@ -51,7 +54,7 @@ Giving no advice. __/ __/ >>>)); - $test->isDefined("CNF sequential anon format 'listed' is defined?",$parse_listed->anon('listed')); + $test->isDefined("CNF sequential anon format 'listed' is it defined?",$parse_listed->anon('listed')); $parse_listed = $parse_listed->anon('listed'); $test->evaluate("CNF sequential anon format 'listed' has two itens?",2,scalar(@{$parse_listed->list()})); @@ -64,14 +67,14 @@ Giving no advice. $test -> case("Test Shortif regexp directly.",'3'); my $nd_root = CNFNode::_createNode('root'); - CNFNode::_parseShortife( \$nd_root, q( + CNFNode::_parseShortife($parser, \$nd_root, q( div__\ test __\ _______// )); - CNFNode::_parseShortife( \$nd_root, q( + CNFNode::_parseShortife($parser, \$nd_root, q( div__\ a:1 b:2 @@ -126,7 +129,7 @@ Giving no advice. ### $test -> case("Test shortife from file test.cnf.",'5'); - my $parser = CNFParser->new('test.cnf'); + $parser = CNFParser->new('test.cnf'); my @para_instructed = $parser->list("paragraphs"); my @paragraphs = $parser->listProcessed("paragraphs"); my %anons = %{$parser->anon()}; diff --git a/tests/testCRONSchedular.pl b/tests/testCRONSchedular.pl index c9bd94b..f802b6a 100644 --- a/tests/testCRONSchedular.pl +++ b/tests/testCRONSchedular.pl @@ -40,7 +40,7 @@ ID`DUE_DATE __DATE__`NOTIFIED __DATE__`ACTIVE __BOOL__`REACCURING`NOTIFICATION~ package : DatabaseCentralPlugin subroutine : main property : DB_SCHEMA ->>< +>>< __HAS_PROCESSING_PRIORITY_ # The DB_SYNCH is per table updating and inserting from CNFData in this script to the store. # So might not be suitable for multiple table with id relationships or for large data. diff --git a/tests/testExperimental.pl b/tests/testExperimental.pl index d2ef227..39d8398 100644 --- a/tests/testExperimental.pl +++ b/tests/testExperimental.pl @@ -117,7 +117,7 @@ Hello World!`~ ## # Following is the same inconvetional format. Notice how we untagged it as it isn't used. # So no commenting out of code in CNF, you just untag. -< +< __HAS_PROCESSING_PRIORITY__ table_prefix: Test_Experimental diff --git a/tests/testHTMLMarkdown.pl b/tests/testHTMLMarkdown.pl index af18590..ecf9efd 100644 --- a/tests/testHTMLMarkdown.pl +++ b/tests/testHTMLMarkdown.pl @@ -14,7 +14,7 @@ my $test = TestManager -> new($0); use Syntax::Keyword::Try; try { - + my $parser = CNFParser -> new(); ### $test->case("Markdown Instance"); @@ -22,7 +22,7 @@ use Syntax::Keyword::Try; try { $test->case("Test ordered lists"); - my $doc = $plugin->parse(qq( + my $doc = $plugin->parse($parser,qq( **Links** [Duck Duck Go](https://duckduckgo.com) )); @@ -30,7 +30,7 @@ use Syntax::Keyword::Try; try { my $txt = @{$doc}[0]; $test->case("Markdown Parser"); - $doc = $plugin->parse(qq( + $doc = $plugin->parse($parser,qq( # Hello You *fool* listening to **politics**! diff --git a/tests/testHTMLPossibleTagged.pl b/tests/testHTMLPossibleTagged.pl index 0a876bc..9cb6408 100644 --- a/tests/testHTMLPossibleTagged.pl +++ b/tests/testHTMLPossibleTagged.pl @@ -77,7 +77,7 @@ use Syntax::Keyword::Try; try { <@< dynamic_paragraphs >@> >> -< +< __HAS_PROCESSING_PRIORITY__ [meta[ <@@< tag : meta_1 @@ -126,7 +126,7 @@ ut error itaque eum doloribus sint.`~ ### # Test instance creation. ### - die $test->failed() if not my $cnf = CNFParser->new(); + die $test->failed() if not $cnf = CNFParser->new(); $test->case("Passed new instance for CNFParser."); # diff --git a/tests/testMarkDownPlugin_MD2HTMLConversion.pl b/tests/testMarkDownPlugin_MD2HTMLConversion.pl index 5d17a86..b5728e8 100644 --- a/tests/testMarkDownPlugin_MD2HTMLConversion.pl +++ b/tests/testMarkDownPlugin_MD2HTMLConversion.pl @@ -1,7 +1,7 @@ use warnings; use strict; use lib "tests"; -use lib "system/modules/"; +use lib "system/modules"; require TestManager; require CNFParser; @@ -48,16 +48,16 @@ use Syntax::Keyword::Try; try { $test->isDefined('$html',$html); #dereference and trim $html=$$html;$html=~s/\n$//g; - $test->evaluate('test property is valid html?',$html,q(

    Hello World!

    )); + $test->evaluate('test property is valid html?',$html,q(

    Hello World!

    )); # - $test->subcase("Check embeded link to a perl constance <**>"); + $test->subcase("Check embedded link to a perl constance <**>"); my $style = $parser->anon('HTML_STYLE'); $test->isDefined('$style',$style); my @ret = $style->search('Content/MarkdownPlugin::CSS'); my $script = $ret[0]; if($test->isDefined('$script',$script)){ if ($script->val() !~ m/\.B\s\{/gm){ - $test->failed("Script value doesn't contain expexted text.") + $test->failed("Script value doesn't contain expected text.") } } # @@ -86,7 +86,7 @@ use Syntax::Keyword::Try; try { foreach (@cases){ my @case = @$_; $test->subcase($case[0]); - $html = MarkdownPlugin::inlineCNF($case[0],""); + $html = MarkdownPlugin::inlineCNF($parser,$case[0],""); $test->isDefined($case[0],$html); say $test->failed("$case[0] CNF format has not properly converted!") if $html !~ /^evaluate($case[0],$html,$case[1]); diff --git a/tests/testSQL.pl b/tests/testSQL.pl index c1222d7..a757b9e 100644 --- a/tests/testSQL.pl +++ b/tests/testSQL.pl @@ -100,16 +100,16 @@ try{ property : VIEW_TBL_A >> -# This is the table spec for an unknow to this script physical SQL database table. -# Its slection statment is mapped with __MAP_CNF_DB_VIEW__ VIEW_TBL_A, without this meta instruction -# auto resolwing will not work. +# This is the table spec for an unknown to this script physical SQL database table. +# Its selection statement is mapped with __MAP_CNF_DB_VIEW__ VIEW_TBL_A, without this meta instruction +# auto resolving will not work. # < __MAP_CNF_DB_VIEW__ VIEW_TBL_A ID _INT_`NAME _TEXT_~ >> # It is more readable not to map the above to an CNF instruction. -# The following statment can be both table and a view, which is recomended. +# The following statement can be both table and a view, which is recommended. # <select ID, Name from TBL_A;>> ));