From 68914db2ff2c839345f51cb89916edb2e15a6c36 Mon Sep 17 00:00:00 2001 From: Will Budic Date: Wed, 14 Jun 2023 08:29:40 +1000 Subject: [PATCH] Imp. CNFMeta and CNFtoJSON. --- .../cgi-bin/system/modules/MarkdownPlugin.pm | 260 ++++++++++++++---- htdocs/cgi-bin/system/modules/PerlKeywords.pm | 4 +- 2 files changed, 203 insertions(+), 61 deletions(-) diff --git a/htdocs/cgi-bin/system/modules/MarkdownPlugin.pm b/htdocs/cgi-bin/system/modules/MarkdownPlugin.pm index b196eff..254a6bd 100644 --- a/htdocs/cgi-bin/system/modules/MarkdownPlugin.pm +++ b/htdocs/cgi-bin/system/modules/MarkdownPlugin.pm @@ -34,7 +34,7 @@ try{ $PARSER = $parser; die "Property not found [$property]!" if !$item; - my $ref = ref($item); my $escaped = 0; + my $ref = ref($item); my $escaped = 0; $script = $item; if($ref eq 'CNFNode'){ $script = $item->{script} }elsif($ref eq 'InstructedDataItem'){ @@ -83,9 +83,11 @@ package HTMLListItem { my $t = $self->{type}; my $isRootItem = $self -> {spc} == 0 ? 1 : 0; my $hasItems = $self->hasItems() ? 1 : 0; - my $ret = "
  • ".$self -> {item}."
    • \n"; - if($hasItems){ - $ret = "
  • ".$self -> {item}."<$t>\n"; + my $ret; + if($hasItems&&!$isRootItem){ + $ret = "
  • ".$self -> {item}."<$t>\n" + }else{ + $ret = "
  • ".$self -> {item}."
    • \n" } foreach my $item(@{$self->{list}}){ if($item->hasItems()){ @@ -127,8 +129,7 @@ try{ my @titels;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++; + $ln =~ s/\t/$TAB/gs; $lnc++; if($ln =~ /^```(\w*)\s(.*)```$/g){ $tag = $1; $ln = $2; @@ -136,6 +137,7 @@ try{ $buffer .= qq(<$code_tag[1] class='$code_tag[0]'>$ln\n); next }elsif($ln =~ /^\s*```(\w*)/){ + my $bfCode; if(!$tag){ my @code_tag = @{ setCodeTag($1, $1) }; $class = $code_tag[0]; @@ -143,22 +145,33 @@ try{ } if($code){ if($para){ - $buffer .= "$para\n" + $bfCode .= "$para\n" } - $buffer .= "
    "; undef $para; + $bfCode .= "
    "; undef $para; $code = 0; undef $tag; + if($list_item){ + $bfCode = $list_item -> {item} . $bfCode; + $list_item -> {item} = "$bfCode\n"; + next; + } }else{ - $buffer .= "<$tag class='$class'>"; + $bfCode .= "<$tag class='$class'>"; if($class eq 'perl'){ - $buffer .= qq(

    $class

    ); + $bfCode .= qq(

    $class

    ); $code = 2; }else{ if($class eq 'cnf' or $class eq 'html'){ - $buffer .= '

    '.uc $class.'

    ' + $bfCode .= '

    Perl '.uc $class.'

    ' } $code = 1 } } + if($list_item){ + $list_item -> {item} = $list_item -> {item}.'

    '.$bfCode; + + }else{ + $buffer .= "$bfCode\n"; + } }elsif(!$code && $ln =~ /^\s*(#+)\s*(.*)/){ my $h = 'h'.length($1); my $title = $2; @@ -240,7 +253,11 @@ try{ }elsif($code == 2){ $para .= code2HTML($v)."
    \n"; }else{ - + $v = inlineCNF($v); + if(length($v) > length($ln)){ + $para .= qq($v
    ); + next + } $v =~ m/ ^(<{2,3}) ([\$@%]*\w*)$ | ^(>{2,3})$ @@ -251,14 +268,14 @@ try{ my $t = $1; my $i = $2; $t =~ s/$t$i
    ); + $para .= qq($t$i
    ); $pml_val = 1; next; }elsif($3){ my $t = $3; $t =~ s/>/>/g; - $para .= "$t
    \n"; + $para .= "$t
    \n"; $pml_val = 0; next; }elsif($4&&$5&&6){ @@ -266,8 +283,8 @@ try{ my $v = $5; my $i = $6; $t =~ s/$t$v - <$i>
    ); + $para .= qq($t$v + <$i>
    ); $pml_val = 1; next; @@ -289,31 +306,31 @@ try{ $t =~ s//>/g; $pml_val = 1; - $para .= qq($t$v<$i$c
    ); + $para .= qq($t$v<$i$c
    ); }elsif($5&&$6){ my $t = $5; my $i = $6; $t =~ s/$t$i
    ); + $para .= qq($t$i
    ); }elsif($1 && $2 && $3){ $pml_val = 1; - $para .= qq(<<$2<\/span>$3><\/span>
    ); + $para .= qq(<<$2<\/span>$3><\/span>
    ); }elsif($8){ my $t = $8; $t =~ s/>/>/g; $pml_val = 0; - $para .= "$t
    \n"; + $para .= "$t
    \n"; } else{ if($pml_val){ $v =~ m/(.*)([=:])(.*)/gs; if($1&&$2&&$3){ - $para .= "$1 $2 $3
    \n"; + $para .= "$1 $2 $3
    \n"; }else{ - $para .= " $v
    \n"; + $para .= " $v
    \n"; } }else{ $para .= "$v
    \n"; @@ -337,7 +354,7 @@ try{ $buffer .= $_->toString()."\n"; } $buffer .= "{type}.">\n"; - undef @list + undef @list; undef $list_item; } elsif($para){ if($code){ @@ -372,12 +389,127 @@ return [\$buffer,\@titels] sub code2HTML($v){ $v =~ s/([,;=\(\)\{\}\[\]]|->)/$1<\/span>/g; $v =~ s/(['"].*['"])/$1<\/span>/g; - $v =~ s/(my|our|local|use|lib|require|new|while|for|foreach|while|if|else|elsif)/$1<\/span>/g; - $v =~ s/(\$\w+)/$1<\/span>/g; + $v =~ s/(my|our|local|use|lib|require|new|while|for|foreach|while|if|else|elsif)/$1<\/span>/g; + $v =~ s/(\$\w+)/$1<\/span>/g; return $v } +sub inlineCNF($v){ + + # $v =~ m/ ^(<<) ([@%]<) ([\$@%]?\w+) ([<>]) + # |^(<{2,3}) + # ([^>]+) + # ( (<|>\w*>) | [<|>] (\w*) | (>{2,3})\s*)$ + # /gmx; + + $v =~ m/ ^(<<) ([@%]<) ([\$@%]?\w+) ([<>]) + |^(<{2,3}) + ([^>]+) + ( + (<|>\w*>?) | [<|>] (\w*) + ) + |(>{2,3})$ + /gmx; + + if($5&&$6&&$7){ + my ($o,$oo,$i,$isVar,$sep,$var,$prop,$c,$cc); + $oo = $5; $var = $6; $cc = $7; + + if($cc=~/^([<|>])([\w ]*)(>+)/){ + $o = $1; + $i = $2; + $c = $3; + if($i && $i ne $c){ + $o =~ s//>/g; + my $iv = $i; + if($var=~/^(\w+)([<|>])(\w+)/){ + $var = $1; + $sep = $2; + $i = $3; + $sep =~ s//>/g; + $prop = qq($var$sep$i>$iv); + $cc =~ s/$iv//; + }elsif($PARSER->isReservedWord($i)){ + $prop = qq($var$o$i$c); + }else{ + $prop = qq($var$o$i); + $cc =~ s/$i//; + } + }elsif($var=~/^(\w+)([<|>])(\w+)/){ + $var = $1; + $sep = $2; + $i = $3; + $sep =~ s//>/g; + $prop = qq($var$sep$i); + }else{ + $cc .='>' if length($oo) != length($cc) + } + } + $oo =~ s//>/g; + + if(!$prop){ + $v = $var; + $v =~ m/^(\w+\$*)\s*([<|>])*([^>]+)*/; + $var = $1; + $isVar = $2; + $i = $3 if $3; + $prop = $v; + if($isVar){ + $isVar =~ s//>/g; + if($i){ + $v =~ s/^\w+\s*\s*(<|>)*([^>]*)*/$var<\/span>$isVar<\/span>$i<\/span>/; + }else{ + $v =~ s/^\w+\s*\s*(<|>)*/$var$isVar<\/span><\/span>/; + } + $prop = $v + }else{ + if($PARSER->isReservedWord($var)){ + $prop = propValCNF($i); + $v =~ s/\s$i$/$prop/; + $v =~ s/^\w+/$var<\/span>/; + $prop = $v; + }else{ + $prop = propValCNF($i); + $v =~ s/\s$i$/$prop/; + $v =~ s/^\w+/$var<\/span>/; + $prop = $v; + } + + } + } + + $v = qq($oo$prop$cc); + } + elsif($5&&$6){ + my $t = $5; + my $i = $6; + my $c = $7; $c = $8 if !$c; + $t =~ s//>/g if $c; + $v = qq($t$i$c); + } + elsif($1 && $2 && $3){ + my $ins = $2; + my $prop = propValCNF($3); + $v = qq(<<$ins<\/span>$prop><\/span>); + } + return $v +} +sub propValCNF($v){ + $v =~ m/(.*)([=:])(.*)/gs; + if($1&&$2&&$3){ + $v = " $1$2$3"; + }else{ + $v = " $v"; + } + return $v; +} sub style ($script){ MarkdownPluginException->throw(error=>"Invalid argument passed as script!",show_trace=>1) if !$script; @@ -396,39 +528,7 @@ sub style ($script){ #Inline code $ret =~ m/```(.*)```/g; if($1){ - my $v = $1; - $v =~ m/ ^(<<) ([@%]<) ([\$@%]?\w+) ([<>]) - |^(<{2,3}) - ([^>]+) - ( (<[\W\w ]*>) | (>{2,3})$ ) - /gx; - if($5&&$6&&$7){ - my $t = $5; - $v = $6; - my $c = $7; - $t =~ s//>/g; - $v=~m/^(\w+)/; - my $w = $1; - - if($PARSER->isReservedWord($w)){ - $v =~ s/^(\w+)/$w<\/span>/; - - } - $v = qq($t$v$c); - - }elsif($5&&$6){ - my $t = $5; - my $i = $6; - my $c = $7; $c = $8 if !$c; - $t =~ s//>/g if $c; - $v = qq($t$i$c); - } - elsif($1 && $2 && $3){ - $v = qq(<<$2<\/span>$3><\/span>); - - } + my $v = inlineCNF($1); $ret =~ s/```(.*)```/\$v<\/span\>/; } @@ -439,9 +539,51 @@ sub style ($script){ return \$ret; } -# +### +# Style sheet used for HTML conversion. +# Link with <**> in a TREE instructed property. +### +use constant CSS => q/ +div .cnf { + background: aliceblue; +} +.cnf h1 span { + color:#05b361; + background: aliceblue; +} + .B { + color: #c60000; + padding: 2px; + } + + .Q { + color: #b7ae21; + font-weight: bold; + } + + .pn { + color: #6800ff; + } + + .pv { + color: #883ac8; + } + + .pi { + color: #18a7c8;; + font-weight: bold; + } + .opr { + color: yellow; + } + + .str { + color: red; + font-weight: bold; + } +/; 1; \ No newline at end of file diff --git a/htdocs/cgi-bin/system/modules/PerlKeywords.pm b/htdocs/cgi-bin/system/modules/PerlKeywords.pm index e14967c..0a34562 100644 --- a/htdocs/cgi-bin/system/modules/PerlKeywords.pm +++ b/htdocs/cgi-bin/system/modules/PerlKeywords.pm @@ -7,7 +7,7 @@ our @EXPORT_OK = qw(%RESERVED_WORDS %KEYWORDS %FUNCTIONS @REG_EXP &matchForCSS & our %RESERVED_WORDS = map +($_, 1), qw{ CONST CONSTANT VARIABLE VAR FILE TABLE TREE INDEX - VIEW SQL MIGRATE DO + VIEW SQL MIGRATE DO LIB PLUGIN MACRO %LOG INCLUDE INSTRUCTOR }; @@ -82,7 +82,7 @@ sub matchForCSS { ### # Translate any code script int HTML colored version for output to the silly browser. ### -sub span_to_html { my ($script,$css, $code_tag_contain) = @_; if($css .=" "){}else{$css=""} # $css if specified we need to give it some space in its short life. +sub span_to_html { my ($script,$css, $code_tag_contain) = @_; if($css){$css.=" "}else{$css=""} # $css if specified we need to give it some space in its short life. my $out; my $SPC = " "; my $SPAN = qq(