From: Will Budic Date: Thu, 20 Jul 2023 11:09:03 +0000 (+1000) Subject: prep. for 2.5 finale. X-Git-Url: https://lifelog.hopto.org/gitweb/?a=commitdiff_plain;h=a7bb7864da6ea8e4e8d7b16a227854f156a3e555;p=LifeLog.git prep. for 2.5 finale. --- diff --git a/dbLifeLog/main.cnf b/dbLifeLog/main.cnf index 4d631f6..8a340c3 100644 --- a/dbLifeLog/main.cnf +++ b/dbLifeLog/main.cnf @@ -81,7 +81,7 @@ BankingPlugin->banking.pl # Use/see anon properties before, enabling changing settings from this actual config file. # < -00|$RELEASE_VER = 2.4`LifeLog Application Version. +00|$RELEASE_VER = 2.5`LifeLog Application Version. 01|$REC_LIMIT = 25`Records shown per page. 03|$TIME_ZONE = Australia/Sydney`Time zone of your country and city. 05|$PRC_WIDTH = 80`Default presentation width for pages. @@ -105,6 +105,7 @@ BankingPlugin->banking.pl 42|$DISP_ALL = 1`Display whole log entry, default -> 1=true, 0=false for display single line only. 44|$TRANSPARENCY= 1`Should log panel be transparent, default is yes or on. 50|$CURR_SYMBOL = $`Currency symbol. +52|$AUDIO_ENABLED=1`Enable/Disable audio on some events and actions. >> < 01|Unspecified `For quick uncategorized entries. diff --git a/htdocs/cgi-bin/config.cgi b/htdocs/cgi-bin/config.cgi index 8204b4b..da10bb5 100755 --- a/htdocs/cgi-bin/config.cgi +++ b/htdocs/cgi-bin/config.cgi @@ -289,7 +289,7 @@ while ( my @row = $dbs->fetchrow_array() ) { ); } - elsif ( $n eq "DISP_ALL" ) { + elsif ( $n eq "DISP_ALL" or $n eq 'AUDIO_ENABLED') { my ( $l, $u ) = ( "", "" ); if ( $v == 0 ) { $l = "SELECTED"; @@ -306,8 +306,7 @@ while ( my @row = $dbs->fetchrow_array() ) { or $n eq 'TRACK_LOGINS' or $n eq 'DEBUG' or $n eq 'TRANSPARENCY' - or $n eq 'AUTO_LOGOFF' ) - { + or $n eq 'AUTO_LOGOFF') { my ( $l, $u ) = ( "", "" ); if ( $v == 0 ) { $l = "SELECTED"; diff --git a/htdocs/cgi-bin/index.cgi b/htdocs/cgi-bin/index.cgi index 9a755b9..7110fe1 100755 --- a/htdocs/cgi-bin/index.cgi +++ b/htdocs/cgi-bin/index.cgi @@ -14,7 +14,6 @@ use strict; use warnings; use Exception::Class ('LifeLogException'); use Syntax::Keyword::Try; -use DateTime; ## # We use dynamic perl compilations. The following ONLY HERE required to carp to browser on # system requirments or/and unexpected perl compiler errors. @@ -30,6 +29,7 @@ BEGIN { } + use lib "system/modules"; require CNFParser; require CNFNode; diff --git a/htdocs/cgi-bin/index.cnf b/htdocs/cgi-bin/index.cnf index 62e998e..40da716 100644 --- a/htdocs/cgi-bin/index.cnf +++ b/htdocs/cgi-bin/index.cnf @@ -319,8 +319,6 @@ function loadDocResult(content){ < -```cnf - ### INFO \> This Page is the Documentation listing coming with the [LifeLog](https://github.com/wbudic/LifeLog) Application. \> @@ -341,21 +339,3 @@ function loadDocResult(content){ >> <<1>> -//Following for debug purposess and tests. - -```CNF - - -\<\<\\>\> - -\<\\> -\<\\> - -\<\<$APP_DESCRIPTION\ -This application presents just -a nice multi-line template. -\>\> -``` \ No newline at end of file diff --git a/htdocs/cgi-bin/main.cgi b/htdocs/cgi-bin/main.cgi index 8edec27..7be1247 100755 --- a/htdocs/cgi-bin/main.cgi +++ b/htdocs/cgi-bin/main.cgi @@ -1100,7 +1100,21 @@ my $help = &help; ################################## # Final Page Output from here! # ################################## - +my $audio = &Settings::audioEnabled ? qq( + + + +):""; toBuf ( qq( $sideMenu @@ -1120,20 +1134,7 @@ $tail - - - -) +$audio) ); outputPage(); diff --git a/htdocs/cgi-bin/system/modules/MarkdownPlugin copy.pm b/htdocs/cgi-bin/system/modules/MarkdownPlugin copy.pm new file mode 100644 index 0000000..f299fbd --- /dev/null +++ b/htdocs/cgi-bin/system/modules/MarkdownPlugin copy.pm @@ -0,0 +1,593 @@ +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 diff --git a/htdocs/cgi-bin/system/modules/MarkdownPlugin.pm b/htdocs/cgi-bin/system/modules/MarkdownPlugin.pm index ddd53fb..100da6e 100644 --- a/htdocs/cgi-bin/system/modules/MarkdownPlugin.pm +++ b/htdocs/cgi-bin/system/modules/MarkdownPlugin.pm @@ -169,13 +169,13 @@ try{ foreach my $ln(split(/\n/,$script)){ $ln =~ s/\t/$TAB/gs; $lnc++; if($ln =~ /^```(\w*)\s(.*)```$/g){ - $tag = $1; - $ln = $2; + $tag = $1; + $ln = $2; $list_end=0; my @code_tag = @{ setCodeTag($tag, "") }; $buff .= qq(<$code_tag[1] class='$code_tag[0]'>$ln\n); next }elsif($ln =~ /^\s*```(\w*)/){ - my $bfCode; + my $bfCode; if(!$tag){ my @code_tag = @{ setCodeTag($1, $1) }; $class = $code_tag[0]; @@ -231,8 +231,7 @@ try{ }elsif($spc>$nplen){ $list_item -> add($new); $list_item = $new; - $nplen = $spc; - $list_end = 0; + $nplen = $spc; }else{ my $isEq = $list_item->{spc} == $spc; while($list_item->{spc} >= $spc && $list_item -> parent()){ @@ -243,6 +242,7 @@ try{ $list_item -> add($new); $list_item = $new; } + $list_end = 0; }elsif(!$code && $ln =~ /(^|\\G)[ ]{0,3}(>+) ?/){ my $nested = length($2); $ln =~ s/^\s*\>+//; @@ -283,22 +283,21 @@ try{ $buff .= qq(
    \n) } } - elsif($ln =~ /^\s*(.*)/ && length($1)>0){ + elsif($ln =~ /^(\s*)(.*)/ && length($2)>0){ if($code){ - my $v=$1; + my $v=$2; my $spc=$1; $list_end =0; if($tag eq 'pre' && $code == 1){ $v =~ s//>/g; $para .= "$v\n"; }elsif($code == 2){ if($ln =~/^\s*\<+.*>+$/){ - $para .= inlineCNF($v)."
    \n" - + $para .= inlineCNF($v,$spc)."
    \n" }else{ $para .= code2HTML($v)."
    \n" } }else{ - $v = inlineCNF($v); + $v = inlineCNF($v,$spc); if(length($v) > length($ln)){ $para .= qq($v
    ); next @@ -383,7 +382,7 @@ try{ $para .= $bqte; undef $bqte; } - $para .= ${style($1)}."\n" + $para .= ${style($2)}."\n" } }else{ if($list_root && ++$list_end>1){ @@ -424,7 +423,7 @@ sub code2HTML($val){ } $v =~ s/([,;=\-\+]+)/$1<\/span>/gx; - $v =~ s/(my|our|local|use|lib|require|new|while|for|foreach|while|if|else|elsif|eval)/$1<\/span>/g; + $v =~ s/(my|our|local|do|use|lib|require|new|while|for|foreach|while|if|else|elsif|eval)/$1<\/span>/g; $v =~ s/(\$\w+)/$1<\/span>/g; $v =~ s/([\(\)\{\}\[\]] | ->)/$1<\/span>/gx; foreach(0..$#strs){ @@ -437,37 +436,91 @@ sub code2HTML($val){ return $v } -sub inlineCNF($v){ - +sub inlineCNF($v,$spc){ + $spc =~ s/\s/ /g; $v =~ m/ (<{2,3})(.*?)(>{2,3}) (.*) /gmx; my $oo = $1; my $body = $2; my $cc = $3; - my $restIfAny = $4; - return $v if !$1 || !$2 || !$3; + my $restIfAny = $4; $restIfAny="" if not $restIfAny; - $oo =~ s/[#[" + } + elsif($v=~m/\]\#\]/){ + return "$spc]#]" + } + elsif($v=~m/^\[(\w*)\[/ && $1){ + return "$spc[$1[" + } + elsif($v=~m/\](\w*)\]/ && $1){ + return "$spc]$1]" + } + elsif($v=~m/^<{1}(\w*)<{1}/ && $1){ + return "$spc<$1<" + }elsif($v=~m/^>{1}(\w*)>{1}/ && $1){ + return "$spc>$1>" + }elsif($v=~m/^<\*<.*>\*>$/){ + my $r = ">*>"; + $body=~s/>\*>$/$r/; + $r = "<*<"; + $body=~s/^<\*>'){ + return "$spc>>\n" } + else{ + $v=~/(>+)$/;if($1){ + $cc=$1; + #$body =~ s/>/>/g; + }else{ + $oo =~ s/$oo$1" + }elsif($v=~m/^(<{2,3})(.*?)([><])(.*)/){ + return "$spc$oo$1>$2$3"; + }else{ + return propValCNF($v) + } + } + } +} + $oo =~ s//>/g; - $body =~ m/ ([@%]<) ([\$@%]?\w+) ([<>]) | ([^<>]+) ([><])? (.*) /gmx; if($4&&$5&&$6){ my ($o,$var,$val, $prop); - $var = $4; $o=$5; $val=$6; - if($PARSER->isReservedWord($var)){ - $var = "$var" + $var = $4; $o=$5; $val=$6; + $val =~ /(.*)(>$)/; if($1&&$2){ + my $v = $1; + my $i = $2; + if($PARSER->isReservedWord($v)){ + $v = "$v" + }else{ + $v =~ s/(\w+)(\$+)/$1<\/span>$2<\/span>/g; + $v = "$i" if !$2; + } + $val=$v; $cc = ">"; + + }elsif($PARSER->isReservedWord($var)){ + $var = "$var"; + $val =~ s//>/g; }else{ $var =~ s/(\w+)(\$+)/$1<\/span>$2<\/span>/g; $var = "$var" if !$2; + $val =~ s//>/g; } my $r = "<"; $o =~ s/^>"; $o =~ s/^>/$r/ge; - $val =~ s//>/g; $prop = "$var$o$val"; @@ -498,16 +551,16 @@ sub inlineCNF($v){ my $prop = propValCNF($3); $v = "$oo$ins<\/span>$prop$cc" } - return $v.$restIfAny + return $spc.$v.$restIfAny } sub propValCNF($v){ $v =~ m/(.*)([=:])(.*)/gs; if($1&&$2&&$3){ - $v = " $1$2$3"; + return " $1$2$3"; }else{ - $v = " $v"; + return " $v"; } return $v; } @@ -524,7 +577,7 @@ sub style ($script){ #Inline code $ret =~ m/```(.*)```/g; if($1){ - my $v = inlineCNF($1); + my $v = inlineCNF($1,""); $ret =~ s/```(.*)```/\$v<\/span\>/; } diff --git a/htdocs/cgi-bin/system/modules/Settings.pm b/htdocs/cgi-bin/system/modules/Settings.pm index 3b954f8..de935ba 100644 --- a/htdocs/cgi-bin/system/modules/Settings.pm +++ b/htdocs/cgi-bin/system/modules/Settings.pm @@ -51,32 +51,34 @@ use constant META => '^CONFIG_META'; # DEFAULT SETTINGS HERE! These settings kick in if not found in config file. i.e. wrong config file or has been altered, things got missing. -our $RELEASE_VER = '2.5'; -our $TIME_ZONE = 'Australia/Sydney'; -our $LANGUAGE = 'English'; -our $PRC_WIDTH = '60'; -our $LOG_PATH = '../../dbLifeLog/'; -our $SESSN_EXPR = '+30m'; -our $DATE_UNI = '0'; -our $AUTHORITY = ''; -our $IMG_W_H = '210x120'; -our $REC_LIMIT = 25; -our $AUTO_WRD_LMT = 1000; -our $AUTO_WRD_LEN = 17; #Autocompletion word length limit. Internal. -our $AUTO_LOGOFF = 0; -our $VIEW_ALL_LMT = 1000; -our $DISP_ALL = 1; -our $FRAME_SIZE = 0; -our $RTF_SIZE = 0; -our $THEME = 'Standard'; -our $TRANSPARENCY = 1; -our $TRANSIMAGE = 'wsrc/images/std-log-lbl-bck.png'; -our $TRACK_LOGINS = 1; -our $KEEP_EXCS = 0; -our $COMPRESS_ENC = 0; #HTTP Compressed encoding. -our $DBI_SOURCE = "DBI:SQLite:"; -our $DBI_LVAR_SZ = 1024; -our $CURR_SYMBOL = '$';#'$'; +our $RELEASE_VER = '2.5'; +our $TIME_ZONE = 'Australia/Sydney'; +our $LANGUAGE = 'English'; +our $PRC_WIDTH = '60'; +our $LOG_PATH = '../../dbLifeLog/'; +our $SESSN_EXPR = '+30m'; +our $DATE_UNI = '0'; +our $AUTHORITY = ''; +our $IMG_W_H = '210x120'; +our $REC_LIMIT = 25; +our $AUTO_WRD_LMT = 1000; +our $AUTO_WRD_LEN = 17; #Autocompletion word length limit. Internal. +our $AUTO_LOGOFF = 0; +our $AUDIO_ENABLED = 1; +our $VIEW_ALL_LMT = 1000; +our $DISP_ALL = 1; +our $FRAME_SIZE = 0; +our $RTF_SIZE = 0; +our $THEME = 'Standard'; +our $TRANSPARENCY = 1; +our $TRANSIMAGE = 'wsrc/images/std-log-lbl-bck.png'; +our $TRACK_LOGINS = 1; +our $KEEP_EXCS = 0; +our $COMPRESS_ENC = 0; #HTTP Compressed encoding. +our $DBI_SOURCE = "DBI:SQLite:"; +our $DBI_LVAR_SZ = 1024; +our $CURR_SYMBOL = '$'; + my ($cgi, $sss, $sid, $alias, $pass, $dbname, $pub); our $DSN; @@ -127,6 +129,7 @@ sub recordLimit {$REC_LIMIT} sub autoWordLimit {$AUTO_WRD_LMT} sub autoWordLength {$AUTO_WRD_LEN} sub autoLogoff {$AUTO_LOGOFF} +sub audioEnabled {$AUDIO_ENABLED} sub viewAllLimit {$VIEW_ALL_LMT} sub displayAll {$DISP_ALL} sub trackLogins {$TRACK_LOGINS} @@ -436,30 +439,31 @@ sub getConfiguration { my ($db, $hsh) = @_; my $st = $db->prepare("SELECT ID, NAME, VALUE FROM CONFIG;"); $st->execute(); while ( @r = $st->fetchrow_array() ){ given ( $r[1] ) { - when ("RELEASE_VER") {$RELEASE_VER = $r[2]} - when ("TIME_ZONE") {$TIME_ZONE = $r[2]} - when ("PRC_WIDTH") {$PRC_WIDTH = $r[2]} - when ("SESSN_EXPR") {$SESSN_EXPR = timeFormatSessionValue($r[2])} - when ("DATE_UNI") {$DATE_UNI = $r[2]} - when ("LANGUAGE") {$LANGUAGE = $r[2]} - when ("LOG_PATH") {} # Ommited and code static can't change for now. - when ("IMG_W_H") {$IMG_W_H = $r[2]} - when ("REC_LIMIT") {$REC_LIMIT = $r[2]} - when ("AUTO_WRD_LMT"){$AUTO_WRD_LMT = $r[2]} - when ("AUTO_LOGOFF") {$AUTO_LOGOFF = $r[2]} - when ("VIEW_ALL_LMT"){$VIEW_ALL_LMT = $r[2]} - when ("DISP_ALL") {$DISP_ALL = $r[2]} - when ("FRAME_SIZE") {$FRAME_SIZE = $r[2]} - when ("RTF_SIZE") {$RTF_SIZE = $r[2]} - when ("THEME") {$THEME = $r[2]} - when ("TRANSPARENCY"){$TRANSPARENCY = $r[2]} - when ("TRANSIMAGE") {$TRANSIMAGE = $r[2]} - when ("DEBUG") {$DEBUG = $r[2]} - when ("KEEP_EXCS") {$KEEP_EXCS = $r[2]} - when ("TRACK_LOGINS"){$TRACK_LOGINS = $r[2]} - when ("COMPRESS_ENC"){$COMPRESS_ENC = $r[2]} - when ("CURR_SYMBOL") {$CURR_SYMBOL = $r[2]} - default {$anons{$r[1]} = $r[2]} + when ("RELEASE_VER") { $RELEASE_VER = $r[2] } + when ("TIME_ZONE") { $TIME_ZONE = $r[2] } + when ("PRC_WIDTH") { $PRC_WIDTH = $r[2] } + when ("SESSN_EXPR") { $SESSN_EXPR = timeFormatSessionValue( $r[2] ) } + when ("DATE_UNI") { $DATE_UNI = $r[2] } + when ("LANGUAGE") { $LANGUAGE = $r[2] } + when ("LOG_PATH") {} # Ommited and code static can't change for now. + when ("IMG_W_H") { $IMG_W_H = $r[2] } + when ("REC_LIMIT") { $REC_LIMIT = $r[2] } + when ("AUTO_WRD_LMT") { $AUTO_WRD_LMT = $r[2] } + when ("AUTO_LOGOFF") { $AUTO_LOGOFF = $r[2] } + when ("AUDIO_ENABLED") { $AUDIO_ENABLED = $r[2] } + when ("VIEW_ALL_LMT") { $VIEW_ALL_LMT = $r[2] } + when ("DISP_ALL") { $DISP_ALL = $r[2] } + when ("FRAME_SIZE") { $FRAME_SIZE = $r[2] } + when ("RTF_SIZE") { $RTF_SIZE = $r[2] } + when ("THEME") { $THEME = $r[2] } + when ("TRANSPARENCY") { $TRANSPARENCY = $r[2] } + when ("TRANSIMAGE") { $TRANSIMAGE = $r[2] } + when ("DEBUG") { $DEBUG = $r[2] } + when ("KEEP_EXCS") { $KEEP_EXCS = $r[2] } + when ("TRACK_LOGINS") { $TRACK_LOGINS = $r[2] } + when ("COMPRESS_ENC") { $COMPRESS_ENC = $r[2] } + when ("CURR_SYMBOL") { $CURR_SYMBOL = $r[2] } + default { $anons{ $r[1] } = $r[2] } } } #Anons are murky grounds. -- @bud