--- /dev/null
+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
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.
###
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;
}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/\\>/>/gs;
- #$script =~ s/\n/<br>/gs;
+ $script =~ s/\\</</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 = "<a href=\"#$cnt\">".$spec[0]."</a>";
+ if($lvl!=$level){
+ if($lvl>$level){
+ $bf .= "<ul>";
+ }else{
+ $bf .= "</ul>";
+ }
+ $level = $lvl;
+ }
+ $bf .= qq(<li>$lnk</li>)
+ }
+ while($level-->0){$bf .= "</ul>"};
+ 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
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++;
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</$h><a name=").scalar(@titels)."\"></a>\n"
+ $buff .= qq(<a name=").scalar(@titles)."\"></a><$h>$title</$h>\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;
}else{
if($bqte_tag eq 'p'){
$ln =~ s/^\s*//g;
- $bqte .= ${style($ln)}."<br>";
+ $bqte .= ${style($parser,$ln)}."<br>";
}else{
$ln =~ s/^\s*[-+*]\s*|^\s*\d+\.\s*//g;
- $bqte .= "<li>".${style($ln)}."</li>\n";
+ $bqte .= "<li>".${style($parser,$ln)}."</li>\n";
}
}
}
$para .= inlineCNF($v,$spc)."<br>\n"
}else{
$spc =~ s/\s/ /g;
- $para .= $spc.code2HTML($v)."<br>\n"
+ $para .= $spc.code2HTML($parser,$v)."<br>\n"
}
}else{
$v = inlineCNF($v,$spc);
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;
}
$list_end = 0;
}else{
- $para .= ${style($v)}."\n"
+ $para .= ${style($parser,$v)}."\n"
}
}
}else{
$buff .= $list_root-> toString();
}
$buff .= qq(<p>$para</p>\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/(.*?)(\#.*)/<span class='cmnt'>$2<\/span>/g;
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;
}
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
my $end =$4;
if($end){
my $changed = ($end =~ s/(>|<)$//g);
- if($PARSER -> isReservedWord($end)){
+ if($parser -> isReservedWord($end)){
$v = "<span ".C_PI.">$end</span>"; $v .= "<span ".C_B.">".($1 eq '<'?"<":">")."</span>" if $changed
}else{
if (!$var){$v = "<span ".C_PA.">$r</span>"}else{$v=""}
$val =~ /(.*)(>$)/; if($1&&$2){
my $v = $1;
my $i = $2;
- if($PARSER->isReservedWord($v)){
+ if($parser->isReservedWord($v)){
$v = "<span ".C_PI.">$v</span>"
}else{
$v =~ s/(\w+)(\$+)/<span class='pa'>$1<\/span><span class='ps'">$2<\/span>/g;
}
$val=$v; $cc = "<span ".C_B.">></span>";
- }elsif($PARSER->isReservedWord($var)){
+ }elsif($parser->isReservedWord($var)){
$var = "<span ".C_PI.">$var</span>";
$val =~ s/</</g;
$val =~ s/>/>/g;
if(!$7){
$t =~ /(\w*)(\\\w*|\s*)(.*)/;
my $i = $1;
- if($PARSER->isReservedWord($i)){
+ if($parser->isReservedWord($i)){
$i = "<span ".C_PI.">$i</span>"
}else{
$i = "<span ".C_PA.">$i</span>"
}
-sub style ($script){
+sub style ($parser, $script){
MarkdownPluginException->throw(error=>"Invalid argument passed as script!",show_trace=>1) if !$script;
#Links <https://duckduckgo.com>
$script =~ s/<(http[:\/\w.]*)>/<a href=\"$1\">$1<\/a>/g;
$script =~ s/(\*\*([^\*]*)\*\*)/\<em\>$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;
}
}
###
-# 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: <*<MarkdownPlug::CSS>*> in a TREE instructed property.
###
use constant CSS => q/
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.
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>
$test-> nextCase();
#
+
+ $test->case("Test older anon cases v.2.4 compatibility.");
###
# Test older cases v.2.4 compatibility.
##
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);
>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());
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,
__/
__/
>>>));
- $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()}));
$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
###
$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()};
package : DatabaseCentralPlugin
subroutine : main
property : DB_SCHEMA
->><<DB_SCHEMA <TREE>
+>><<DB_SCHEMA <TREE> __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.
##
# 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.
-<<DB_SCHEMA <TREE>
+<<DB_SCHEMA <TREE> __HAS_PROCESSING_PRIORITY__
table_prefix: Test_Experimental
use Syntax::Keyword::Try; try {
-
+ my $parser = CNFParser -> new();
###
$test->case("Markdown Instance");
$test->case("Test ordered lists");
- my $doc = $plugin->parse(qq(
+ my $doc = $plugin->parse($parser,qq(
<b><https://duckduckgo.com></b>
**Links** [Duck Duck Go](https://duckduckgo.com)
));
my $txt = @{$doc}[0];
$test->case("Markdown Parser");
- $doc = $plugin->parse(qq(
+ $doc = $plugin->parse($parser,qq(
# Hello
You *fool*
listening to **politics**!
<@< dynamic_paragraphs >@>
>>
-<<App <TREE>
+<<App <TREE> __HAS_PROCESSING_PRIORITY__
[meta[
<@@<
tag : meta_1
###
# 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.");
#
use warnings; use strict;
use lib "tests";
-use lib "system/modules/";
+use lib "system/modules";
require TestManager;
require CNFParser;
$test->isDefined('$html',$html);
#dereference and trim
$html=$$html;$html=~s/\n$//g;
- $test->evaluate('test property is valid html?',$html,q(<h1>Hello World!</h1><a name="1"></a>));
+ $test->evaluate('test property is valid html?',$html,q(<a name="1"></a><h1>Hello World!</h1>));
#
- $test->subcase("Check embeded link to a perl constance <*<MarkdownPlugin::CSS>*>");
+ $test->subcase("Check embedded link to a perl constance <*<MarkdownPlugin::CSS>*>");
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.")
}
}
#
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 !~ /^<span class/;
$test->evaluate($case[0],$html,$case[1]);
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.
#
<<SPEC_TBL_A<TABLE> __MAP_CNF_DB_VIEW__ VIEW_TBL_A
ID _INT_`NAME _TEXT_~
>>
# It is more readable not to map the above to an CNF <VIEW> 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.
#
<<VIEW_TBL_A<SQL>select ID, Name from TBL_A;>>
));
lifelog.hopto.org / PerlCNF.git / commitdiff