From 47fe5de73863820f8d3eb2ea937185604964b12d Mon Sep 17 00:00:00 2001 From: Will Budic Date: Wed, 20 Sep 2023 09:32:31 +1000 Subject: [PATCH] . --- .../system/modules/MarkdownPlugin copy.pm | 593 ------------------ 1 file changed, 593 deletions(-) delete mode 100644 htdocs/cgi-bin/system/modules/MarkdownPlugin copy.pm diff --git a/htdocs/cgi-bin/system/modules/MarkdownPlugin copy.pm b/htdocs/cgi-bin/system/modules/MarkdownPlugin copy.pm deleted file mode 100644 index f299fbd..0000000 --- a/htdocs/cgi-bin/system/modules/MarkdownPlugin copy.pm +++ /dev/null @@ -1,593 +0,0 @@ -package MarkdownPlugin; - -use strict; -use warnings; -no warnings qw(experimental::signatures); -use Syntax::Keyword::Try; -use Exception::Class ('MarkdownPluginException'); -use feature qw(signatures); -use Date::Manip; -##no critic ControlStructures::ProhibitMutatingListFunctions - -our $TAB = ' 'x4; -our $PARSER; - -sub new ($class, $fields={Language=>'English',DateFormat=>'US'}){ - - if(ref($fields) eq 'REF'){ - warn "Hash reference required as argument for fields!" - } - my $lang = $fields->{'Language'}; - my $frmt = $fields->{'DateFormat'}; - Date_Init("Language=$lang","DateFormat=$frmt"); - $fields->{'disk_load'} = 0 if not exists $fields->{'disk_load'}; - - return bless $fields, $class -} - -### -# Process config data to contain expected fields and data. -### -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; - if($ref eq 'CNFNode'){ - $script = $item->{script} - }elsif($ref eq 'InstructedDataItem'){ - $script = $item->{val}; - $escaped = $item->{ins} eq 'ESCAPED' - }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"); - local $/; - <$fh>; - }; - } - if($escaped){ - $script =~ s/\\/>/gs; - #$script =~ s/\n/
/gs; - } - my @doc = @{parse($self,$script)}; - $parser->data()->{$property} = $doc[0]; - $parser->data()->{$property.'_headings'} = $doc[1]; - -}catch($e){ - MarkdownPluginException->throw(error=>$e ,show_trace=>1); -}} - - -package HTMLListItem { - sub new{ - my $class = shift; - my ($type,$item,$spc) = @_; - my @array = (); - return bless{type=>$type,item=>$item,spc=>$spc,list=>\@array},$class; - } - sub parent($self) { - return exists($self->{parent}) ? $self->{parent} : undef - } - sub add($self, $item){ - push @{$self->{list}}, $item; - $item ->{parent} = $self; - } - sub hasItems($self){ - return @{$self->{list}}>0 - } - sub toString($self){ - my $t = $self->{type}; - my $isRootItem = $self -> {spc} == 0 ? 1 : 0; - my $hasItems = $self->hasItems(); - my $hasParent = exists($self->{parent}); - my ($ret,$recurse)=("",0); - if ($hasItems) { - if($isRootItem) { - $ret = "<$t>\n
  • ".$self -> {item}."\n"; - }else{ - $ret = "<$t>\n
  • ".$self -> {item}."
    • \n" - } - }else{ - $ret = "
  • ".$self -> {item}."
    • \n" - } - foreach my $item(@{$self->{list}}){ - if($item->hasItems()){ - $ret .= $item->toString(); $recurse++ - }else{ - my $it = $item->{type}; - $it = 'li' if $it eq 'ol' || $it eq 'ul'; - $ret .= "<$it>".$item->{item}."\n"; - $isRootItem = $item->{spc}; - } - } - if($hasItems){ - if($isRootItem) { - $ret .= "\n" - }else{ - $ret .= "\n" - } - } - return $ret - } -} - -sub setCodeTag($tag, $class){ - if($tag){ - $tag = lc $tag; - if($tag eq 'html' or $tag eq 'cnf' or $tag eq 'code' or $tag eq 'perl'){ - $class = $tag; - $tag = 'div'; - }else{ - $tag = 'pre' if($tag eq 'sh' or $tag eq 'bash'); - } - if($tag eq 'perl'){ - $class='perl'; - $tag ='div'; - } - }else{ - $tag = $class = 'pre'; - } - return [$class, $tag] -} - -sub parse ($self, $script){ -try{ - my ($buffer, $para, $ol, $lnc); - my @list; my $list_end; my $ltype=0; my $nix=0; my $nplen=0; my $list_item; - 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++; - if($ln =~ /^```(\w*)\s(.*)```$/g){ - $tag = $1; - $ln = $2; - my @code_tag = @{ setCodeTag($tag, "") }; - $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]; - $tag = $code_tag[1] if !$tag; - } - if($code){ - if($para){ - $bfCode .= "$para\n" - } - $bfCode .= ""; undef $para; - $code = 0; undef $tag; - if($list_item){ - $list_item -> {item} = $list_item -> {item} . $bfCode.'
    '; - $list_item = $list_item -> parent(); - next; - } - }else{ - $bfCode .= "<$tag class='$class'>"; - if($class eq 'perl'){ - $bfCode .= qq(

    $class

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

    Perl '.uc $class.'

    ' - } - $code = 1 - } - } - if($list_item){ - my $new = HTMLListItem->new('dt', "
    $bfCode", $list_item ->{spc}); - $list_item -> add($new); - $list_item = $new; - $list_end=0; - }else{ - $buffer .= "$bfCode\n"; - } - }elsif(!$code && $ln =~ /^\s*(#+)\s*(.*)/){ - my $h = 'h'.length($1); - my $title = $2; - $titels[@titels] = {$lnc,$title}; - $buffer .= qq(<$h>$title\n" - } - elsif(!$code && ($ln =~ /^(\s*)(\d+)\.\s(.*)/ || $ln =~ /^(\s*)([-+*])\s(.*)/)){ - - my $spc = length($1); - my $val = $3 ? ${style($3)} : ""; - my $new = HTMLListItem->new(($2=~/[-+*]/?'ul':'ol'), $val, $spc); - - if(!$list_item){ - $list_item = $new; - $list[@list] = $list_item; - $nplen = $spc; - $list_end = 0; - - }elsif($spc>$nplen || $list_end){ - $list_item -> add($new); - $list_item = $new; - $nplen = $spc; - $list_end = 1; - }else{ - while($list_item->{spc}>=$spc && $list_item -> parent()){ - $list_item = $list_item -> parent(); - } - if ( !$list_item ){ - $list_item = $new; - $list_end = 0; - }else{ - $list_item -> add($new); - $list_item = $new; - } - } - }elsif(!$code && $ln =~ /(^|\\G)[ ]{0,3}(>+) ?/){ - my $nested = length($2); - $ln =~ s/^\s*\>+//; - ($ln =~ /^(\s+) (\d+) \.\s (.*)/x || $ln =~ /^(\s*) ([-+*]) \s(.*)/x); - if($2 && $2 =~ /[-+*]/){ - $bqte_tag = "ul"; - }elsif($2){ - $bqte_tag = "ol"; - }else{ - $bqte_tag = "p"; - } - if(!$bqte_nested){ - $bqte_nested = $nested; - $bqte .="
    <$bqte_tag>\n" - }elsif($bqte_nested<$nested){ - $bqte .="
    <$bqte_tag>"; - $bqte_nested = $nested; - }elsif($bqte_nested>$nested){ - $bqte .="
    <$bqte_tag>"; - $bqte_nested--; - } - if($ln !~ /(.+)/gm){ - $bqte .= "\n

    \n" - }else{ - if($bqte_tag eq 'p'){ - $ln =~ s/^\s*//g; - $bqte .= ${style($ln)}."
    "; - }else{ - $ln =~ s/^\s*[-+*]\s*|^\s*\d+\.\s*//g; - $bqte .= "

  • ".${style($ln)}."
    • \n"; - } - } - } - elsif(!$code && $ln =~ /^\s*\*\*\*/){ - if($para){ - $para .= qq(
    \n) - }else{ - $buffer .= qq(
    \n) - } - } - elsif($ln =~ /^\s*(.*)/ && length($1)>0){ - if($code){ - my $v=$1; - if($tag eq 'pre' && $code == 1){ - $v =~ s//>/g; - $para .= "$v\n"; - }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})$ - | (<<) ([\$@%]*\w*) <(\w+)> - /gx; - - if($1&&$2){ - my $t = $1; - my $i = $2; - $t =~ s/$t$i
    ); - $pml_val = 1; - next; - - }elsif($3){ - my $t = $3; - $t =~ s/>/>/g; - $para .= "$t
    \n"; - $pml_val = 0; - next; - }elsif($4&&$5&&6){ - my $t = $4; - my $v = $5; - my $i = $6; - $t =~ s/$t$v - <$i>
    ); - $pml_val = 1; - next; - - } - - $v =~ m/ ^(<<) ([@%]<) ([\$@%]?\w+) ([<>]) - |^(<{2,3}) - ([\$@%\w]+)\s* - <*([^>]+) - (>{2,3})$ - - /gx;# and my @captured = @{^CAPTURE}; - - if($5&&$6&&$7&&$8){ - my $t = $5; - my $v = $6; - my $i = $7; - my $c = $8; - $t =~ s//>/g; - $pml_val = 1; - $para .= qq($t$v<$i$c
    ); - - }elsif($5&&$6){ - my $t = $5; - my $i = $6; - $t =~ s/$t$i
    ); - - }elsif($1 && $2 && $3){ - - $pml_val = 1; - $para .= qq(<<$2<\/span>$3><\/span>
    ); - - }elsif($8){ - my $t = $8; - $t =~ s/>/>/g; $pml_val = 0; - $para .= "$t
    \n"; - } - else{ - if($pml_val){ - $v =~ m/(.*)([=:])(.*)/gs; - if($1&&$2&&$3){ - $para .= "$1 $2 $3
    \n"; - }else{ - $para .= " $v
    \n"; - } - }else{ - $para .= "$v
    \n"; - } - } - } - - }else{ - if($bqte){ - while($bqte_nested-->0){$bqte .="\n"} - $para .= $bqte; - undef $bqte; - } - $para .= ${style($1)}."\n" - } - }else{ - - if(@list && ++$list_end>1){ - foreach (@list){ - $buffer .= $_-> toString() - } - undef @list; undef $list_item; - } - elsif($para){ - if($code){ - $buffer .= $para; - }else{ - $buffer .= qq(

    $para


    \n); - } - $para="" - } - } - } - if($bqte){ - while($bqte_nested-->0){$bqte .="\n
    \n"} - $buffer .= $bqte; - } - if(@list){ - foreach (@list){ - $buffer .= $_-> toString() - } - } - $buffer .= qq(

    $para

    \n) if $para; - -return [\$buffer,\@titels] -}catch($e){ - MarkdownPluginException->throw(error=>$e ,show_trace=>1); -}} - -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; - 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{ - $prop = propValCNF($i); - $i =~ s/\{/\\\}/; - $v =~ s/\s$i$/$prop/; - if($PARSER->isReservedWord($var)){ - $v =~ s/^\w+/$var<\/span>/; - }else{ - $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; - #Links - $script =~ s/<(http[:\/\w.]*)>/$1<\/a>/g; - $script =~ s/(\*\*([^\*]*)\*\*)/\$2<\/em\>/gs; - $script =~ s/(\*([^\*]*)\*)/\$2<\/strong\>/gs; - $script =~ s/__(.*)__/\$1<\/del\>/gs; - $script =~ s/~~(.*)~~/\$1<\/strike\>/gs; - my $ret = $script; - #Inline code - $ret =~ m/```(.*)```/g; - if($1){ - my $v = inlineCNF($1); - $ret =~ s/```(.*)```/\$v<\/span\>/; - } - - #Images - $ret =~ s/!\[(.*)\]\((.*)\)/\
    \"$1\"\/<\/div>/; - #Links [Duck Duck Go](https://duckduckgo.com) - $ret =~ s/\[(.*)\]\((.*)\)/\$1\<\/a\>/; - 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 -- 2.34.1