Config diff --git a/htdocs/cgi-bin/contact.cnf b/htdocs/cgi-bin/contact.cnf new file mode 100644 index 0000000..facd110 --- /dev/null +++ b/htdocs/cgi-bin/contact.cnf @@ -0,0 +1,37 @@ +!CNF3.0 + +<<@<%WEB_SERVICE_SETTINGS> + $LOG_PATH = ../../dbLifeLog/ + user =admin + pass = admin + dbi_source = DBI:SQLite: + dbi_store= contacts.db +>> + +<< CONTACTS + ID INTEGER NOT NULL UNIQUE, + ID_FOR INTEGER NOT NULL UNIQUE, + Date TEXT NOT NULL, + FullName TEXT NOT NULL, + Message TEXT NOT NULL, + Status INTEGER, + PRIMARY KEY("ID" AUTOINCREMENT) +>> +<< ECHASH_HOLDERS

+ ID INTEGER NOT NULL UNIQUE, + Alias INTEGER NOT NULL UNIQUE, + ECHSH CHARACTER(16) NOT NULL, + Name varchar(64), + Email TEXT NOT NULL, + Details TEXT, PRIMARY KEY("ID" AUTOINCREMENT) +>> + +< +ID`Alias`ECHSH`Name`Image`Email`Details~ +#`webadmin`990MWWLWM8C2MI8K`Will Budic`images/webadmin.png`webadmin@fake.demo-email.com`Administrive Technical Contact.`~ +#`admin`990MWWLWM8C2MI8K`Will Budic`images/webadmin.png`webadmin@fake.demo-email.com`Engeenering site Owner Contact`~ +#`secretary`2435GG2G87HJLKLA`Rachel Zegler`images/zagler.png`zaglerr@fake.demo-email.com`Marketing Officer`~ +>> + +<<1>> + diff --git a/htdocs/cgi-bin/docs/EContactHashSpecs.md b/htdocs/cgi-bin/docs/EContactHashSpecs.md new file mode 100644 index 0000000..382cf83 --- /dev/null +++ b/htdocs/cgi-bin/docs/EContactHashSpecs.md @@ -0,0 +1,22 @@ +# Electronic Contact Hash Message Specifications + + ECMessage is an alternative to E-Mail postboxes, utilizing a webservice to provide + fast and secure one way contact messages for a website. To the website owner ore admin. + + With this system in place, website scanners or email ants + have no way of accessing emails for illegal purposes. + + +## ECHMessage Provides + + * No Email server/client requirements. + * Secure service to service channel, if required. + * Spam prevention mechanism and message size limitation. + * ECHMessage to real email proxy, if setup. + * One Message store for multiple aliases, for easier management. + * Cross internetwork messaging closed away from the cloud. + * Strict private and public info store and presentation. + * private is email, real, name and address. + * public is alias and the hash. + * Hash is not global or domain centralized at all. + diff --git a/htdocs/cgi-bin/index.cnf b/htdocs/cgi-bin/index.cnf index 5abe045..8d0d9af 100644 --- a/htdocs/cgi-bin/index.cnf +++ b/htdocs/cgi-bin/index.cnf @@ -2,7 +2,7 @@ <<@<%WEBAPP_SETTINGS> $LOG_PATH = ../../dbLifeLog/ - //We are reading only the css property, old way is the following hash, preserved as reminder. + //TODO We are reading only the css property, old way is the following hash, preserved as reminder. $THEME = css => wsrc/main.css, colBG => #c8fff8, colSHDW => #9baec8 >> @@ -50,7 +50,14 @@ margin:5px; background: rgba(0, 223, 246, 0.13); } - + .textual { + width: 40%; + } + .textual p::first-letter { + color: blueviolet; + initial-letter: 3 2; + padding-right: 5pt; + } #content ul { padding-left: 20px; } @@ -310,7 +317,6 @@ function loadDocResult(content){ Index

Life Log

RSS Feeds - >#> >div> Index

Demo

Feeds

+ Contact

$frm diff --git a/htdocs/cgi-bin/system/modules/CNFDateTime.pm b/htdocs/cgi-bin/system/modules/CNFDateTime.pm index fbc49a5..f46515e 100644 --- a/htdocs/cgi-bin/system/modules/CNFDateTime.pm +++ b/htdocs/cgi-bin/system/modules/CNFDateTime.pm @@ -53,6 +53,7 @@ sub toSchlong($self){ } sub _toCNFDate ($formated, $timezone) { my $dt = DateTime::Format::DateParse->parse_datetime($formated, $timezone); + die "Unable to parse date:" if not $dt; return new('CNFDateTime',{epoch => $dt->epoch, datetime=>$dt, TZ=>$timezone}); } sub _listAvailableCountryCodes(){ diff --git a/htdocs/cgi-bin/system/modules/CNFJSON.pm b/htdocs/cgi-bin/system/modules/CNFJSON.pm index 8954ba3..51e944e 100644 --- a/htdocs/cgi-bin/system/modules/CNFJSON.pm +++ b/htdocs/cgi-bin/system/modules/CNFJSON.pm @@ -1,8 +1,6 @@ +### # SQL Processing part for the Configuration Network File Format. -# Programed by : Will Budic -# Source Origin : https://github.com/wbudic/PerlCNF.git -# Open Source License -> https://choosealicense.com/licenses/isc/ -# +### package CNFJSON; use strict;use warnings;#use warnings::unused; @@ -132,4 +130,15 @@ sub jsonToCNFNode { return $ret; } -1; \ No newline at end of file +1; + +=begin copyright +Programed by : Will Budic +EContactHash : 990MWWLWM8C2MI8K (https://github.com/wbudic/EContactHash.md) +Source : https://github.com/wbudic/PerlCNF.git +Documentation : Specifications_For_CNF_ReadMe.md + This source file is copied and usually placed in a local directory, outside of its repository project. + So it could not be the actual or current version, can vary or has been modiefied for what ever purpose in another project. + Please leave source of origin in this file for future references. +Open Source Code License -> https://github.com/wbudic/PerlCNF/blob/master/ISC_License.md +=cut copyright \ No newline at end of file diff --git a/htdocs/cgi-bin/system/modules/CNFMeta.pm b/htdocs/cgi-bin/system/modules/CNFMeta.pm index d16018b..e56910f 100644 --- a/htdocs/cgi-bin/system/modules/CNFMeta.pm +++ b/htdocs/cgi-bin/system/modules/CNFMeta.pm @@ -13,20 +13,7 @@ use strict; use warnings; ### -# TREE instuction meta. -use constant HAS_PRIORITY => "HAS_PROCESSING_PRIORITY"; # Schedule to process before the rest in synchronous line of instructions. - -# -### -# DO instruction meta. -# -use constant ON_DEMAND => "ON_DEMAND"; #Postpone to evaluate on demand. -use constant SHELL => "SHELL"; #Execute via system shell. - -# - -### -# Returns the regular expresion for any of this meta constances. +# Returns the regular expresion for any of the meta constances. ## sub _meta { my $constance = shift; @@ -35,26 +22,94 @@ sub _meta { } $constance; } +# + ### # Priority order no. for instructions. use constant PRIORITY => qr/(\s*\_+PRIORITY\_(\d+)\_+\s*)/o; -### -# Tree instruction has been scripted in collapsed nodes shorthand format. -# Shortife is parsed faster and with less recursion, but can be prone to script errors, -# resulting in unintended placings. -use constant IN_SHORTIFE => qr/(\s*\_+IN_SHORTIFE\_+\s*)/o; -sub import { +sub import { my $caller = caller; no strict "refs"; { - *{"${caller}::meta"} = \&_meta; - *{"${caller}::meta_has_priority"} = sub {return _meta(HAS_PRIORITY)}; + + # TREE instuction meta. + *{"${caller}::meta_has_priority"} = sub {return _meta("HAS_PROCESSING_PRIORITY")}; + # Schedule to process before the rest in synchronous line of instructions. *{"${caller}::meta_priority"} = \&PRIORITY; - *{"${caller}::meta_on_demand"} = sub {return _meta(ON_DEMAND)}; - *{"${caller}::meta_node_in_shortife"} =\&IN_SHORTIFE; - *{"${caller}::SHELL"} = \&SHELL; + #Postpone to evaluate on demand. + *{"${caller}::meta_on_demand"} = sub {return _meta("ON_DEMAND")}; + # Process or load last (includes0. + *{"${caller}::meta_process_last"} = sub {return _meta("PROCESS_LAST")}; + *{"${caller}::meta_const"} = sub {return _meta("CONST")}; + ### + # Tree instruction has been scripted in collapsed nodes shorthand format. + # Shortife is parsed faster and with less recursion, but can be prone to script errors, + # resulting in unintended placings. + *{"${caller}::meta_node_in_shortife"} = sub {return _meta("IN_SHORTIFE")}; + # Execute via system shell. + *{"${caller}::SHELL"} = sub {return _meta("SHELL")}; + # Returns the regular expresion for any of the meta constances. + *{"${caller}::meta"} = \&_meta; } - return 1; + return 1; +} +### +# CNF DATA instruction headers can contain extra expected data type meta info. +# This will strip them out and build the best expected SQL create table body, based on this meta. +# I know, this is crazy stuff, skips having to have to use the TABLE instruction in most cases. +### +sub _metaTranslateDataHeader { + my $isPostgreSQL = shift; + my @array = @_; + my ($idType,$body,$primary)=('NONE'); + my ($INT,$BOOL,$TEXT,$DATE,$ID, $CNFID, $INDEX) = ( + _meta('INT'),_meta('BOOL'),_meta('TEXT'),_meta('DATE'), + _meta('ID'),_meta('CNF_ID'),_meta('CNF_INDEX') + ); + for my $i (0..$#array){ + my $hdr = $array[$i]; + if($hdr eq 'ID'){ + if($isPostgreSQL){ + $body .= "\"$hdr\" INT UNIQUE PRIMARY KEY GENERATED ALWAYS AS IDENTITY,\n"; + #$primary = "PRIMARY KEY(ID)" + }else{ + $body .= "\"$hdr\" INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT,\n"; + } + # DB provited sequence, you better don't set this when inserting a record. + $idType = 'AUTOINCREMENT' + }elsif($hdr =~ s/$CNFID/""/ei){ + #This is where CNF provides the ID uinque int value (which doesn't have to be autonumbered i.e. '#', but must be unique). + $body .= "\"$hdr\" INTEGER NOT NULL PRIMARY KEY CHECK (\"$hdr\">0),\n"; + $idType = 'CNF_INDEX' + }elsif($hdr =~ s/$ID/""/ei){ + #This is ID prefix to some other data id stored in this table, usually one to one/many relationship. + $body .= "\"$hdr\" INTEGER CHECK (\"$hdr\">0),\n"; + }elsif($hdr =~ s/$INDEX/""/ei){ + # This is where CNF instructs to make a indexed lookup type field, + # for inside database fast selecting, hashing, caching and other queries. + $body .= "\"$hdr\" varchar(64) NOT NULL PRIMARY KEY,\n"; + }elsif($hdr =~ s/$INT/""/ei){ + $body .= "\"$hdr\" INTEGER NOT NULL,\n"; + }elsif($hdr =~ s/$BOOL/''/ei){ + if($isPostgreSQL){ + $body .= "\"$hdr\" BOOLEAN NOT NULL,\n"; + }else{ + $body .= "\"$hdr\" BOOLEAN NOT NULL CHECK (\"$hdr\" IN (0, 1)),\n"; + } + }elsif($hdr =~ s/$TEXT/""/ei){ + $body .= "\"$hdr\" TEXT NOT NULL CHECK (length(\"$hdr\")<=2024),\n"; + }elsif($hdr =~ s/$DATE/""/ei){ + $body .= "\"$hdr\" TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP,\n"; + }else{ + $body .= "\"$hdr\" TEXT NOT NULL,\n"; + } + $array[$i] = $hdr; + } + if($primary){ + $body .= $primary; + }else{ + $body =~ s/,$// + } +return [\@array,\$body,$idType]; } - 1; \ No newline at end of file diff --git a/htdocs/cgi-bin/system/modules/CNFParser.pm b/htdocs/cgi-bin/system/modules/CNFParser.pm index 752d7c1..24ff05f 100644 --- a/htdocs/cgi-bin/system/modules/CNFParser.pm +++ b/htdocs/cgi-bin/system/modules/CNFParser.pm @@ -8,6 +8,7 @@ use Exception::Class ('CNFParserException'); use Syntax::Keyword::Try; use Hash::Util qw(lock_hash unlock_hash); use File::ReadBackwards; +use File::Copy; require CNFMeta; CNFMeta::import(); require CNFNode; @@ -23,15 +24,18 @@ our @files; our %lists; our %properties; our %instructors; +our $SQL; ### # Package fields are always global in perl! ### our %ANONS; #private -> Instance fields: - my $anons; - my %includes; + my $anons; + my @includes; my $CUR_SCRIPT; my %instructs; + my $IS_IN_INCLUDE_MODE; + my $LOG_TRIM_SUB; ### # CNF Instruction tag covered reserved words. # You can't use any of these as your own possible instruction implementation, unless in lower case. @@ -85,10 +89,13 @@ sub new { my ($class, $path, $attrs, $del_keys, $self) = @_; $self->{STRICT} = 1 if not exists $self->{STRICT}; #make strict by default if missing. $self->{ENABLE_WARNINGS} = 1 if not exists $self->{ENABLE_WARNINGS}; $self->{HAS_EXTENSIONS} = 0 if not exists $self->{HAS_EXTENSIONS}; - $self->{RUN_PROCESSORS} = 1 if not exists $self->{RUN_PROCESSORS}; #Bby default enabled, disable during script dev. + $self->{RUN_PROCESSORS} = 1 if not exists $self->{RUN_PROCESSORS}; #By default enabled, disable during script dev. + # Autoload the data type properties placed in a separate file, from a FILE instruction. + $self->{AUTOLOAD_DATA_FILES} =1 if not exists $self->{AUTOLOAD_DATA_FILES}; $self->{CNF_VERSION} = VERSION; $self->{__DATA__} = {}; - bless $self, $class; $self->parse($path, undef, $del_keys) if($path); + undef $SQL; + bless $self, $class; $self -> parse($path, undef, $del_keys) if($path); return $self; } # @@ -108,6 +115,10 @@ sub import { our $meta_has_priority = meta_has_priority(); our $meta_priority = meta_priority(); our $meta_on_demand = meta_on_demand(); +our $meta_process_last = meta_process_last(); +our $meta_const = meta_const(); + + ### # The metaverse is that further this can be expanded, # to provide further dynamic meta processing of the property value of an anon. @@ -144,7 +155,7 @@ __JSON sub _isTrue{ my $value = shift; return 0 if(not $value); - return ($value =~ /1|true|yes|on/i) + return ($value =~ /1|true|yes|on|t|da/i) } ### # Post parsing instructed special item objects. They have lower priority to Order of apperance and from CNFNodes. @@ -247,7 +258,6 @@ sub anon { my ($self, $n, $args)=@_; } } $ret = $args->process($n,$ret); - }elsif($ref eq 'HASHREF'){ foreach my $key(keys %$args){ if($ret =~ m/\$\$\$$key\$\$\$/g){ @@ -281,7 +291,10 @@ sub anon { my ($self, $n, $args)=@_; # Returns undef if it doesn't exist, and exception if constance required is set; sub const { my ($self,$c)=@_; return $self->{$c} if exists $self->{$c}; - CNFParserException->throw("Required constants variable ' $c ' not defined in config!") if $CONSTREQ; + if ($CONSTREQ){CNFParserException->throw("Required constants variable ' $c ' not defined in config!")} + # Let's try to resolve. As old convention makes constances have a '$' prefix all upprercase. + $c = '$'.$c; + return $self->{$c} if exists $self->{$c}; return; } @@ -300,7 +313,7 @@ return property(@_); ### # Collection now returns the contained type dereferenced and is concidered a property. # Make sure you use the appropriate Perl type on the receiving end. -# Note, if properties contain any scalar key entry, it sure hasn't been set by this parser. +# Note, if properties contain any scalar key row, it sure hasn't been set by this parser. # sub property { my($self, $name) = @_; if(exists($properties{$name})){ @@ -393,10 +406,8 @@ sub template { my ($self, $property, %macros) = @_; #private to parser sub. sub doInstruction { my ($self,$e,$t,$v) = @_; - my $DO_ENABLED = $self->{'DO_ENABLED'}; my $priority = 0; $t = "" if not defined $t; - if($t eq 'CONST' or $t eq 'CONSTANT'){#Single constant with mulit-line value; # It is NOT allowed to overwrite constant. if (not $self->{$e}){ @@ -411,48 +422,7 @@ sub doInstruction { my ($self,$e,$t,$v) = @_; $anons->{$e} = $v; } elsif($t eq 'DATA'){ - $v=~ s/^\n//; - foreach(split /~\n/,$v){ - my @a; - $_ =~ s/\\`/\\f/g;#We escape to form feed the found 'escaped' backtick so can be used as text. - foreach my $d (split /`/, $_){ - $d =~ s/\\f/`/g; #escape back form feed to backtick. - $d =~ s/~$//; #strip dangling ~ if there was no \n - $t = substr $d, 0, 1; - if($t eq '$'){ - $v = $d; #capture specked value. - $d =~ s/\$$|\s*$//g; #trim any space and system or constant '$' end marker. - if($v=~m/\$$/){ - $v = $self->{$d}; $v="" if not $v; - } - else{ - $v = $d; - } - push @a, $v; - } - else{ - if($t =~ /^\#(.*)/) {#First is usually ID a number and also '#' signifies number. - $d = $1;#substr $d, 1; - $d=0 if !$d; #default to 0 if not specified. - push @a, $d - } - else{ - push @a, $d; - } - } - } - - my $existing = $self->{'__DATA__'}{$e}; - if(defined $existing){ - my @rows = @$existing; - push @rows, [@a] if scalar @a >0; - $self->{'__DATA__'}{$e} = \@rows - }else{ - my @rows; push @rows, [@a]; - $self->{'__DATA__'}{$e} = \@rows if scalar @a >0; - } - } - + $self->doDataInstruction_($e,$v) }elsif($t eq 'DATE'){ if($v && $v !~ /now|today/i){ $v =~ s/^\s//; @@ -462,96 +432,46 @@ sub doInstruction { my ($self,$e,$t,$v) = @_; $v = CNFDateTime::_toCNFDate($v,$self->{'TZ'}); }else{ - $v = CNFDateTime->new(TZ=>$self->{'TZ'}); + $v = CNFDateTime->new({TZ=>$self->{'TZ'}}); } $anons->{$e} = $v; }elsif($t eq 'FILE'){#@TODO Test case this - my ($i,$path,$cnf_file) = (0,"",$self->{CNF_CONTENT}); - $v=~s/\s+//g; - $path = substr($path, 0, rindex($cnf_file,'/')) .'/'.$v; - push @files, $path; - next if !$self->{'$AUTOLOAD_DATA_FILES'}; - open(my $fh, "<:perlio", $path ) or CNFParserException->throw("Can't open $path -> $!"); - read $fh, my $content, -s $fh; - close $fh; - my @tags = ($content =~ m/<<(\w*<(.*?).*?>>)/gs); - foreach my $tag (@tags){ - next if not $tag; - my @kv = split />"); - } - else{ - $v = substr $t, $i+1, (rindex $t, ">>")-($i+1); - $t = substr $t, 0, $i; - } - if($t eq 'DATA'){ - foreach(split /~\n/,$v){ - my @a; - $_ =~ s/\\`/\\f/g;#We escape to form feed the found 'escaped' backtick so can be used as text. - foreach my $d (split(/`/, $_)){ - $d =~ s/\\f/`/g; #escape back form feed to backtick. - $t = substr $d, 0, 1; - if($t eq '$'){ - $v = $d; #capture spected value. - $d =~ s/\$$|\s*$//g; #trim any space and system or constant '$' end marker. - if($v=~m/\$$/){ - $v = $self->{$d}; $v="" if not $v; - } - else{ - $v = $d; - } - push @a, $v; - } - else{ - if($t =~ /^\#(.*)/) {#First is usually ID a number and also '#' signifies number. - $d = $1;#substr $d, 1; - $d=0 if !$d; #default to 0 if not specified. - push @a, $d - } - else{ - push @a, $d; - } - } - my $existing = $self->{'__DATA__'}{$e}; - if(defined $existing){ - my @rows = @$existing; - push @rows, [@a] if scalar @a >0; - $self->{'__DATA__'}{$e} = \@rows - }else{ - my @rows; push @rows, [@a]; - $self->{'__DATA__'}{$e} = \@rows if scalar @a >0; - } - } - } - } - } + $self->doLoadDataFile($e,$v); }elsif($t eq 'INCLUDE'){ - $includes{$e} = {loaded=>0,path=>$e,v=>$v}; + if (!$v){ + $v=$e + }else{ + $anons = $v; + } + my $prc_last = ($v =~ s/($meta_process_last)/""/ei)?1:0; + if (includeContains($v)){ + $self->warn("Skipping adding include $e, path already is registered for inclusion -> $v"); + return; + } + $includes[@includes] = {script=>$v,local=>$CUR_SCRIPT,loaded=>0, prc_last=>$prc_last}; }elsif($t eq 'TREE'){ my $tree = 0; if (!$v){ $v = $e; $e = 'LAST_DO'; } - if( $v =~ s/($meta_has_priority)/""/ei){ + if( $v =~ s/($meta_has_priority)/""/ei ){ $priority = 1; } - if( $v =~ s/$meta_priority/""/sexi){ + if( $v =~ s/$meta_priority/""/sexi ){ $priority = $2; } $tree = CNFNode->new({'_'=>$e,'~'=>$v,'^'=>$priority}); $tree->{DEBUG} = 1 if $self->{DEBUG}; $instructs{$e} = $tree; - }elsif($t eq 'TABLE'){ # This has now be late bound and send to the CNFSQL package. since v.2.6 - SQL()->createTable($e,$v) } # It is hardly been used. But in future this might change. - elsif($t eq 'INDEX'){ SQL()->createIndex($v)} + }elsif($t eq 'TABLE'){ # This all have now be late bound and send via the CNFSQL package. since v.2.6 + # It is hardly been used. But in the future this might change. + my $type = "NONE"; if ($v =~ 'AUTOINCREMENT'){$type = "AUTOINCREMENT"} + $self->SQL()->createTable($e,$v,$type) } + elsif($t eq 'INDEX'){ $self->SQL()->createIndex($v)} elsif($t eq 'VIEW'){ SQL()->createView($e,$v)} - elsif($t eq 'SQL'){ SQL($e,$v)} - elsif($t eq 'MIGRATE'){SQL()->migrate($e, $v) + elsif($t eq 'SQL'){ $self->SQL($e,$v)} + elsif($t eq 'MIGRATE'){$self->SQL()->migrate($e, $v) } elsif($t eq 'DO'){ if($DO_ENABLED){ @@ -560,13 +480,13 @@ sub doInstruction { my ($self,$e,$t,$v) = @_; $v = $e; $e = 'LAST_DO'; } - if( $v =~ s/($meta_has_priority)/""/ei){ + if( $v =~ s/($meta_has_priority)/""/ei ){ $priority = 1; } - if( $v =~ s/($meta_priority)/""/sexi){ + if( $v =~ s/($meta_priority)/""/sexi ){ $priority = $2; } - if($v=~ s/($meta_on_demand)/""/ei){ + if( $v=~ s/($meta_on_demand)/""/ei ){ $anons->{$e} = CNFNode -> new({'_'=>$e,'&'=>$v,'^'=>$priority}); return; } @@ -652,6 +572,104 @@ sub doInstruction { my ($self,$e,$t,$v) = @_; } } } +sub doLoadDataFile { my ($self,$e,$v)=@_; + my ($path,$cnf_file) = ("",$self->{CNF_CONTENT}); + $v=~s/\s+//g; + if(! -e $v){ + $path = substr($path, 0, rindex($cnf_file,'/')) .'/'.$v; + } + foreach(@files){ + return if $_ eq $path + } + return if not _isTrue($self->{AUTOLOAD_DATA_FILES}); + # + $self->loadDataFile($e,$path) +} +sub loadDataFile { my ($self,$e,$path,$v,$i)=@_; + + open(my $fh, "<:perlio", $path ) or CNFParserException->throw("Can't open $path -> $!"); + read $fh, my $content, -s $fh; + close $fh; + # + push @files, $path; + my @tags = ($content =~ m/<<(\w*<(.*?).*?>>)/gs); + foreach my $tag (@tags){ + next if not $tag; + my @kv = split />"); + } + else{ + $v = substr $tag, $i+1, (rindex $tag, ">>")-($i+1); + $tag = substr $tag, 0, $i; + } + if($tag eq 'DATA'){ + $self->doDataInstruction_($e,$v) + } + } +} +#private +sub doDataInstruction_{ my ($self,$e,$v,$t,$d)=@_; + my $add_as_SQLTable = $v =~ s/${meta('SQL_TABLE')}/""/sexi; + my $isPostgreSQL = $v =~ s/${meta('SQL_PostgreSQL')}/""/sexi; + my $isHeader = 0; + $v=~ s/^\s*//gm; + foreach my $row(split(/~\s/,$v)){ + my @a; + $row =~ s/\\`/\\f/g;#We escape to form feed the found 'escaped' backtick so can be used as text. + my @cols = $row =~ m/([^`]*)`{0,1}/gm;pop @cols;#<-regexp is special must pop last empty element. + foreach my $d(@cols){ + $d =~ s/\\f/`/g; #escape back form feed to backtick. + $d =~ s/^\s*|~$//g; #strip dangling ~ if there was no \n + $t = substr $d, 0, 1; + if($t eq '$'){ + $v = $d; #capture specked value. + $d =~ s/\$$|\s*$//g; #trim any space and system or constant '$' end marker. + if($v=~m/\$$/){ + $v = $self->{$d}; + } + else{ + $v = $d; + } + $v="" if not $v; + push @a, $v; + } + else{ + if($d =~ /^\#(.*)/) {#First is usually ID a number and also '#' signifies number. + $d = $1; + $d=0 if !$d; #default to 0 if not specified. + push @a, $d + } + else{ + $d="" if not $d; + push @a, $d; + } + } + } + if($add_as_SQLTable){ + my ($INT,$BOOL,$TEXT,$DATE) = (meta('INT'),meta('BOOL'),meta('TEXT'),meta('DATE')); + my $ret = CNFMeta::_metaTranslateDataHeader($isPostgreSQL,@a); + my @hdr = @$ret; + @a = @{$hdr[0]}; + $self->SQL()->createTable($e,${$hdr[1]},$hdr[2]); + $add_as_SQLTable = 0;$isHeader=1; + } + + my $existing = $self->{'__DATA__'}{$e}; + if(defined $existing){ + if($isHeader){$isHeader=0;next} + my @rows = @$existing; + push @rows, [@a] if scalar @a >0; + $self->{'__DATA__'}{$e} = \@rows + }else{ + my @rows; push @rows, [@a]; + $self->{'__DATA__'}{$e} = \@rows if scalar @a >0; + } + } +} ### # Parses a CNF file or a text content if specified, for this configuration object. @@ -664,11 +682,8 @@ sub parse { my ($self, $cnf_file, $content, $del_keys) = @_; }else{ $anons = $self->{'__ANONS__'}; } - #private %includes; for now we keep on possible multiple calls to parse. - #private instructs on this parse call. - %instructs = (); - # We control from here the constances, as we need to unlock them if previous parse was run. + # We control from here the constances, as we need to unlock them if a previous parse was run. unlock_hash(%$self); if(not $content){ @@ -677,13 +692,16 @@ sub parse { my ($self, $cnf_file, $content, $del_keys) = @_; close $fh; my @stat = stat($cnf_file); $self->{CNF_STAT} = \@stat; - $self->{CNF_CONTENT} = $cnf_file; + $self->{CNF_CONTENT} = $CUR_SCRIPT = $cnf_file; }else{ - my $type =Scalar::Util::reftype($content); + my $type = Scalar::Util::reftype($content); if($type && $type eq 'ARRAY'){ $content = join "",@$content; $self->{CNF_CONTENT} = 'ARRAY'; - }else{$self->{CNF_CONTENT} = 'script'}; + }else{ + $CUR_SCRIPT = \$content; + $self->{CNF_CONTENT} = 'script' + } } $content =~ m/^\!(CNF\d+\.\d+)/; my $CNF_VER = $1; $CNF_VER="Undefined!" if not $CNF_VER; @@ -702,27 +720,30 @@ sub parse { my ($self, $cnf_file, $content, $del_keys) = @_; if(isReservedWord($self,$t)){ my $isVar = ($t eq 'VARIABLE' || $t eq 'VAR'); if($t eq 'CONST' or $isVar){ #constant multiple properties. - foreach my $line(split '\n', $v) { - $line =~ s/^\s+|\s+$//; # strip unwanted spaces - $line =~ s/\s*>$//; - $line =~ m/([\$\w]*)(\s*=\s*)(.*)/g; - my $name = $1; - $line = $3; $line =~ s/^\s*(['"])(.*)\g{1}$/$2/;#strip quotes - if(defined $name){ - if($isVar){ - $anons ->{$name} = $line if $line - }else{ - if($line and not $self->{$name}){# Not allowed to overwrite constant. - $self->{$name} = $line; - }else{ - warn "Skipping and keeping previously set constance -> [$name] the new value ". - ($line eq $self->{$name})?"matches it":"dosean't match -> $line." - } + foreach my $line(split '\n', $v) { + my $isMETAConst = $line =~ s/$meta_const//se; + $line =~ s/^\s+|\s+$//; # strip unwanted spaces + $line =~ s/\s*>$//; + $line =~ m/([\$\w]*)(\s*=\s*)(.*)/g; + my $name = $1; + $line = $3; $line =~ s/^\s*(['"])(.*)\g{1}$/$2/ if $line;#strip quotes + if(defined $name){ + if($isVar && not $isMETAConst){ + $anons ->{$name} = $line if $line + }else{ + $name =~ s/^\$// if $isMETAConst; + # It is NOT allowed to overwrite a constant, so check an issue warning. + if($line and not $self->{$name}){ + $self->{$name} = $line; + }else{ my + $w = "Skipping and keeping a previously set constance of -> [$name] in ". $self->{CNF_CONTENT}." the new value "; + $w .= ($line eq $self->{$name})?"matches it":"dosean't match -> $line."; $self->warn($w) } } - } + } + } }else{ - doInstruction($self,$v,$t,undef); + doInstruction($self,$v,$t,undef); } }else{ $v =~ s/\s*>$//; @@ -799,6 +820,7 @@ sub parse { my ($self, $cnf_file, $content, $del_keys) = @_; # $t = $1; # $v = $2; # } + my $IsConstant = ($v =~ s/$meta_const/""/sexi); my @lst = ($isArray?split(/[,\n]/, $v):split('\n', $v)); $_=""; my @props = map { s/^\s+|\s+$//; # strip unwanted spaces @@ -822,7 +844,7 @@ sub parse { my ($self, $cnf_file, $content, $del_keys) = @_; my $macro = 0; if(exists($properties{$t})){ if($self->isReservedWord($t)){ - $self->warn("Skipped overwritting reserved property -> $t."); + $self->warn("Skipped a try to overwrite a reserved property -> $t."); next }else{ %hsh = %{$properties{$t}} @@ -837,6 +859,12 @@ sub parse { my ($self, $cnf_file, $content, $del_keys) = @_; next if (@pair != 2 || $pair[0] =~ m/^[#\\\/]+/m);#skip, it is a comment or not '=' delimited line. my $name = $pair[0]; my $value = $pair[1]; $value =~ s/^\s*["']|['"]$//g;#strip quotes + if($IsConstant && $p =~ m/\$[A-Z]+/){# if meta constant we check $p if signified to transfer into a CNF constance. + if(not exists $self->{$name}){ + $self->{$name} = $value; + next; + } + } if($macro){ my @arr = ($value =~ m/(\$\$\$.+?\$\$\$)/gm); foreach my $find(@arr) { @@ -858,8 +886,15 @@ sub parse { my ($self, $cnf_file, $content, $del_keys) = @_; doInstruction($self,$e,$t,$v) } } + # Do scripted includes first. As these might set properties imported and processed used by the main script. + if(@includes){ + $includes[@includes] = {script=>$CUR_SCRIPT,loaded=>1, prc_last=>0} if not includeContains($CUR_SCRIPT); #<- to prevent circular includes. + foreach (@includes){ + $self -> doInclude($_) if $_ && not $_->{prc_last} and not $_->{loaded} and $_->{local} eq $CUR_SCRIPT; + } + } ### Do the smart instructions and property linking. - if(%instructs){ + if(%instructs && not $IS_IN_INCLUDE_MODE){ my @items; foreach my $e(keys %instructs){ my $struct = $instructs{$e}; @@ -910,36 +945,62 @@ sub parse { my ($self, $cnf_file, $content, $del_keys) = @_; } undef %instructs; } - #Do scripted includes. - my @inc = sort values %includes; - $includes{$0} = {loaded=>1, path=>$self->{CNF_CONTENT}}; #<- to prevent circular includes. - foreach my $file(@inc){ - if(!$file->{loaded} && $file->{path} ne $self->{CNF_CONTENT}){ - if(open(my $fh, "<:perlio", $file->{path} )){ - read $fh, $content, -s $fh; - close $fh; - if($content){ - $file->{loaded} = 1; - $self->parse(undef, $content) - }else{ - $self->error("Include content is blank for -> ".$file->{path}) - } - }else{ - CNFParserException->throw("Can't open ".$file->{path}." -> $!") if $self->{STRICT}; - $file->{loaded} = 0; - $self->error("Script include not available -> ".$file->{path}) - } - } + + foreach (@includes){ + $self -> doInclude($_) if $_ && (not $_->{loaded} and $_->{local} eq $CUR_SCRIPT) } + undef @includes if not $IS_IN_INCLUDE_MODE; + foreach my $k(@$del_keys){ delete $self->{$k} if exists $self->{$k} } my $runProcessors = $self->{RUN_PROCESSORS} ? 1: 0; - lock_hash(%$self);#Make repository finally immutable. + $self = lock_hash(%$self);#Make repository finally immutable. runPostParseProcessors($self) if $runProcessors; + if ($LOG_TRIM_SUB){ + $LOG_TRIM_SUB->(); + undef $LOG_TRIM_SUB; + } return $self } # + sub includeContains{ + my $path = shift; + foreach(@includes){ + return 1 if $_&&$_->{script} eq $path + } + return 0 + } +### +# Loads and parses includes local to script. +### +sub doInclude { my ($self, $prp_file) = @_; + if(!$prp_file->{loaded}){ + my $file = $prp_file->{script}; + if(!-e $file){$file =~ m/.*\/(.*$)/; $file = $1} + if(open(my $fh, "<:perlio", $file)){ + read $fh, my $content, -s $fh; + close $fh; + if($content){ + my $cur_script = $CUR_SCRIPT; + $prp_file->{loaded} = 1; + $CUR_SCRIPT = $prp_file->{script}; + # Perl is not OOP so instructions are gathered into one place, time will tell if this is desirable rather then a curse. + # As per file processing of instructions is not encapsulated within a included file, but main includer or startup script. + $IS_IN_INCLUDE_MODE = 1; + $self->parse(undef, $content); + $IS_IN_INCLUDE_MODE = 0; + $CUR_SCRIPT = $cur_script; + }else{ + $self->error("Include content is blank for include -> ".$prp_file->{script}) + } + }else{ + $prp_file->{loaded} = 0; + $self->error("Script include not available for include -> ".$prp_file->{script}); + CNFParserException->throw("Can't open include ".$prp_file->{script}." -> $!") if $self->{STRICT}; + } + } +} sub instructPlugin { my ($self, $struct, $anons) = @_; @@ -1248,7 +1309,7 @@ sub log { $message = "$type $message" if $isWarning; - if($message =~ /^ERROR/ || $isWarning){ + if($message =~ /^ERROR/ || ($isWarning && $self->{ENABLE_WARNINGS})){ warn $time . " " .$message; } elsif(%log && $log{console}){ @@ -1261,15 +1322,18 @@ sub log { open (my $fh, ">>", $logfile) or die $!; print $fh $time . " - " . $message ."\n"; close $fh; - if(_isTrue($log{tail}) && $tail_cnt){ - my $fh = File::ReadBackwards->new($logfile) or die $!; - if($fh->{lines}>$tail_cnt){ - my $pos = do { - $fh->readline() for 1..$tail_cnt; - $fh->tell() - }; - truncate($logfile, $pos) or die $!; - } + if($tail_cnt>0 && !$LOG_TRIM_SUB){ + $fh = File::ReadBackwards->new($logfile) or die $!; + if($fh->{lines}>$tail_cnt){ + $LOG_TRIM_SUB = sub { + my $fh = File::ReadBackwards->new($logfile) or die $!; + my @buffer; $buffer[@buffer] = $fh->readline() for (1..$tail_cnt); + open (my $fhTemp, ">", "/tmp/$logfile") or die $!; + print $fhTemp $_ foreach (reverse @buffer); + close $fhTemp; + move("/tmp/$logfile",$logfile) + } + } } } } @@ -1305,10 +1369,11 @@ sub dumpENV{ foreach (keys(%ENV)){print $_,"=", "\'".$ENV{$_}."\'", "\n"} } -our $SQL; sub SQL { - if(!$SQL){##It is late compiled on demand. - require CNFSQL; $SQL = CNFSQL->new(); + if(!$SQL){##It is late compiled package on demand. + my $self = shift; + my $data = shift; + require CNFSQL; $SQL = CNFSQL->new({parser=>$self}); } $SQL->addStatement(@_) if @_; return $SQL; @@ -1318,9 +1383,9 @@ sub JSON { my $self = shift; if(!$JSON){ require CNFJSON; - $JSON = CNFJSON-> new({ CNF_VERSION=>$self->{CNF_VERSION}, - CNF_CONTENT=>$self->{CNF_CONTENT}, - DO_ENABLED =>$self->{DO_ENABLED} + $JSON = CNFJSON-> new({ CNF_VERSION => $self->{CNF_VERSION}, + CNF_CONTENT => $self->{CNF_CONTENT}, + DO_ENABLED => $self->{DO_ENABLED} }); } return $JSON; @@ -1349,6 +1414,7 @@ sub getTree { } sub END { +$LOG_TRIM_SUB->() if $LOG_TRIM_SUB; undef %ANONS; undef @files; undef %properties; diff --git a/htdocs/cgi-bin/system/modules/CNFSQL.pm b/htdocs/cgi-bin/system/modules/CNFSQL.pm new file mode 100644 index 0000000..e58aa91 --- /dev/null +++ b/htdocs/cgi-bin/system/modules/CNFSQL.pm @@ -0,0 +1,441 @@ +### +# SQL Processing part for the Configuration Network File Format. +### +package CNFSQL; + +use strict;use warnings;#use warnings::unused; +use Exception::Class ('CNFSQLException'); use Carp qw(cluck); +use Syntax::Keyword::Try; +use Time::HiRes qw(time); +use DateTime; +use DBI; +use Tie::IxHash; + +use constant VERSION => '2.0'; + +our %tables = (); our %tables_id_type = (); +our %views = (); +our %mig = (); +our @sql = (); +our @statements; +our %curr_tables = (); + +my $isPostgreSQL = 0; +my $hasRecords = 0; +my $TZ; + + +sub new { + my ($class, $attrs, $self) = @_; + $self = \%$attrs; + # By convention any tables and views as appearing in the CNF script should in that order also be created. + tie %tables, "Tie::IxHash"; + tie %views, "Tie::IxHash"; + bless $self, $class; +} + + +sub isPostgreSQL{shift; return $isPostgreSQL} + +## +# Required to be called when using CNF with an database based storage. +# This subrotine is also a good example why using generic driver is not recomended. +# Various SQL db server flavours meta info is def. handled differently and not updated in them. +# +# $map - In general is binding of an CNF table to its DATA property, header of the DATA instructed property is self column resolving. +# If assinged to an array the first element must contain the name, +# @TODO 20231018 - Specifications page to be provided with examples for this. +# +sub initDatabase { my($self, $db, $do_not_auto_synch, $map, $st) = @_; +#Check and set CNF_CONFIG +try{ + $hasRecords = 0; + $isPostgreSQL = $db-> get_info( 17) eq 'PostgreSQL'; + if($isPostgreSQL){ + my @tbls = $db->tables(undef, 'public'); #<- This is the proper way, via driver, doesn't work on sqlite. + foreach (@tbls){ + my $t = uc substr($_,7); $t =~ s/^["']|['"]$//g; + $curr_tables{$t} = 1; + } + } + else{ + my $pst = selectRecords($self, $db, "SELECT name FROM sqlite_master WHERE type='table' or type='view';"); + while(my @r = $pst->fetchrow_array()){ + $curr_tables{$r[0]} = 1; + } + } + + if(!$curr_tables{CNF_CONFIG}){ + my $stmt; + if($isPostgreSQL){ + $stmt = qq| + CREATE TABLE CNF_CONFIG + ( + NAME character varying(32) NOT NULL, + VALUE character varying(128) NOT NULL, + DESCRIPTION character varying(256), + CONSTRAINT CNF_CONFIG_pkey PRIMARY KEY (NAME) + )|; + }else{ + $stmt = qq| + CREATE TABLE CNF_CONFIG ( + NAME VCHAR(16) NOT NULL, + VALUE VCHAR(128) NOT NULL, + DESCRIPTION VCHAR(256) + )|; + } + $db->begin_work(); + $db->do($stmt); + $self->{parser}->log("CNFParser-> Created CNF_CONFIG table."); + $st = $db->prepare('INSERT INTO CNF_CONFIG VALUES(?,?,?);'); + foreach my $key(sort keys %{$self->{parser}}){ + my ($dsc,$val); + $val = $self->{parser}->const($key); + if(ref($val) eq ''){ + my @sp = split '`', $val; + if(scalar @sp>1){$val=$sp[0];$dsc=$sp[1];}else{$dsc=""} + $st->execute($key,$val,$dsc); + } + } + $db->commit(); + }else{ unless ($do_not_auto_synch){ + my $sel = $db->prepare("SELECT VALUE FROM CNF_CONFIG WHERE NAME LIKE ?;"); + my $ins = $db->prepare('INSERT INTO CNF_CONFIG VALUES(?,?,?);'); + foreach my $key(sort keys %{$self->{parser}}){ + my ($dsc,$val); + $val = $self->{parser}->const($key); + if(ref($val) eq ''){ + $sel->execute($key); + my @a = $sel->fetchrow_array(); + if(@a==0){ + my @sp = split '`', $val; + if(scalar @sp>1){$val=$sp[0];$dsc=$sp[1];}else{$dsc=""} + $ins->execute($key,$val,$dsc); + } + } + } + }} + # By default we automatically data insert synchronize script with database state on every init. + # If set $do_not_auto_synch = 1 we skip that if table is present, empty or not, + # and if has been updated dynamically that is good, what we want. It is of external config. implementation choice. + foreach my $tbl(keys %tables){ + if(!$curr_tables{$tbl}){ + $st = $tables{$tbl}; + $self->{parser}->log("CNFParser-> SQL: $st\n"); + try{ + $db->do($st); + $self->{parser}->log("CNFParser-> Created table: $tbl\n"); + $do_not_auto_synch = 0; + }catch{ + die "Failed to create:\n$st\nError:$@" + } + } + else{ + next if $do_not_auto_synch; + } + } + foreach my $tbl(keys %tables){ + next if $do_not_auto_synch; + my @table_info; + my $tbl_id_type = $tables_id_type{$tbl}; + if(isPostgreSQL()){ + $st = lc $tbl; #we lc, silly psql is lower casing meta and case sensitive for internal purposes. + $st="select ordinal_position, column_name, data_type from information_schema.columns where table_schema = 'public' and table_name = '$st';"; + $self->{parser}->log("CNFParser-> $st", "\n"); + $st = $db->prepare($st); + }else{ + $st = $db->prepare("pragma table_info($tbl)"); + } + $st->execute(); + while(my @row_info = $st->fetchrow_array()){ + $row_info[2] =~ /(\w+)/; + $table_info[@table_info] = [$row_info[1], uc $1 ] + } + my $t = $tbl; my ($sel,$ins,@spec,$q,$qinto); + $t = %$map{$t} if $map && %$map{$t}; + if(ref($t) eq 'ARRAY'){ + @spec = @$t; + $t = $spec[0]; shift @spec; + foreach(@spec){ $q.="\"$_\" == ? and " } + $q =~ s/\sand\s$//; + $st="SELECT * FROM $tbl WHERE $q;"; + $self->{parser}->log("CNFParser-> $st\n"); + $sel = $db -> prepare($st); + }else{ + my $prime_key = getPrimaryKeyColumnNameWherePart($db, $tbl); + $st="SELECT * FROM $tbl WHERE $prime_key"; + $self->{parser}->log("CNFParser-> $st\n"); + $sel = $db -> prepare($st); + my @r = $self->selectRecords($db,"select count(*) from $tbl;")->fetchrow_array(); + $hasRecords = 1 if $r[0] > 0 + } + + $q = $qinto = ""; my $qa = $tbl_id_type eq 'CNF_INDEX'; foreach(@table_info){ + if($qa || @$_[0] ne 'ID') { + $qinto .="\"@$_[0]\","; + $q.="?," + } + } + $qinto =~ s/,$//; + $q =~ s/,$//; + $ins = $db -> prepare("INSERT INTO $tbl ($qinto)\nVALUES ($q);"); + + + my $data = $self->{parser} -> {'__DATA__'}; + if($data){ + my $data_prp = %$data{$t}; + if(!$data_prp && $self->{data}){ + $data_prp = %{$self->{data}}{$t}; + } + if($data_prp){ + my @hdr; + my @rows = @$data_prp; + my $auto_increment=0; + $db->begin_work(); + for my $row_idx (0 .. $#rows){ + my @col = @{$rows[$row_idx]}; + if($row_idx==0){ + for my $i(0 .. $#col){ + $hdr[@hdr]={'_'=>$col[$i],'i'=>$i} + } + }elsif(@col>0){ + ## + #sel tbl section + if(@spec){ + my @trans = (); + foreach my $name (@spec){ + foreach(@hdr){ + my $hn = $_->{'_'}; + my $hi = $_->{'i'}; + if($name =~ m/ID/i){ + if($col[$hi]){ + $trans[@trans] = $col[$hi]; + }else{ + $trans[@trans] = $row_idx; # The row index is ID as default on autonumbered ID columns. + } + last + }elsif($name =~ m/$hn/i){ + $trans[@trans] = $col[$hi]; + last + } + } + } + next if @trans && hasEntry($sel, \@trans); + }else{ + next if hasEntry($sel, $row_idx); # ID is assumed autonumbered on by default + } + ## + my @ins = (); + foreach(@hdr){ + my $hn = $_->{'_'}; + my $hi = $_->{'i'}; + for my $i(0 .. $#table_info){ + if ($table_info[$i][0] =~ m/$hn/i){ + if($table_info[$i][0]=~/ID/i){ + if($col[$hi]){ + $ins[$i] = $col[$hi]; + }else{ + $ins[$i] = $row_idx; # The row index is ID as default on autonumbered ID columns. + } + $auto_increment=$i+1 if $tbl_id_type eq 'AUTOINCREMENT'; + }else{ + my $v = $col[$hi]; + if($table_info[$i][1] =~ /TIME/ || $table_info[$i][1] =~ /DATE/){ + $TZ = exists $self->{parser}->{'TZ'} ? $self->{parser}->{'TZ'} : CNFDateTime::DEFAULT_TIME_ZONE() if !$TZ; + if($v && $v !~ /now|today/i){ + if($self->{STRICT}&&$v!~/^\d\d\d\d-\d\d-\d\d/){ + $self-> warn("Invalid date format: $v expecting -> YYYY-MM-DD at start as possibility of DD-MM-YYYY or MM-DD-YYYY is ambiguous.") + } + $v = CNFDateTime::_toCNFDate($v,$TZ) -> toTimestamp() + }else{ + $v = CNFDateTime->new({TZ=>$TZ}) -> toTimestamp() + } + }elsif($table_info[$i][1] =~ m/^BOOL/){ + $v = CNFParser::_isTrue($v) ?1:0; + } + $ins[$i] = $v + } + last; + } + } + } + $self->{parser}->log("CNFParser-> Insert into $tbl -> ". join(',', @ins)."\n"); + if($auto_increment){ + $auto_increment--; + splice @ins, $auto_increment, 1 + } + $ins->execute(@ins); + } + } + $db->commit() + }else{ + $self->{parser}->log("CNFParser-> No data collection is available for $tbl\n"); + } + }else{ + $self->{parser}->log("CNFParser-> No data collection scanned for $tbl\n"); + } + + } + + foreach my $view(keys %views){ + if(!$curr_tables{$view}){ + $st = $views{$view}; + $self->{parser}->log("CNFParser-> SQL: $st\n"); + $db->do($st); + $self->{parser}->log("CNFParser-> Created view: $view\n") + } + } + undef %tables; undef %tables_id_type; + undef %views; +} +catch{ + CNFSQLException->throw(error=>$@, show_trace=>1); +} +return $self->{parser}-> const('$RELEASE_VER'); +} + +sub _connectDB { + my ($user, $pass, $source, $store, $path) = @_; + if($path && ! -e $path){ + $path =~ s/^\.\.\/\.\.\///g; + }else{ + $path = "" + } + my $DSN = $source .'dbname='.$path.$store; + try{ + return DBI->connect($DSN, $user, $pass, {AutoCommit => 1, RaiseError => 1, PrintError => 0, show_trace=>1}); + }catch{ + die "

Error->$@

DSN: $DSN

"; + } +} +sub _credentialsToArray{ + return split '/', shift +} + +sub createTable { my ($self, $name, $body, $idType) = @_; + $tables{$name} = "CREATE TABLE $name(\n$body);"; + $tables_id_type{$name} = $idType; +} +sub createView { my ($self, $name, $body) = @_; + $views{$name} = "CREATE VIEW $name AS $body;" +} +sub createIndex { my ($self, $body) = @_; + my $st = "CREATE INDEX $body;"; + push @sql, $st; +} +sub migrate { my ($self, $name, $value) = @_; + my @m = $mig{$name}; + @m = () if(!@m); + push @m, $value; + $mig{$name} = [@m]; +} +sub addStatement { my ($self, $name, $value) = @_; + $self->{$name}=$value; +} +sub getStatement { my ($self, $name) = @_; + return $self->{$name} if exists $self->{$name}; + return; +} +sub hasEntry{ my ($sel, $uid) = @_; + return 0 if !$hasRecords; + if(ref($uid) eq 'ARRAY'){ + $sel -> execute(@$uid) + }else{ + $uid=~s/^["']|['"]$//g; + $sel -> execute($uid) + } + my @r=$sel->fetchrow_array(); + return scalar(@r); +} + +sub getPrimaryKeyColumnNameWherePart { my ($db,$tbl) = @_; $tbl = lc $tbl; + my $sql = $isPostgreSQL ? +qq(SELECT a.attname, format_type(a.atttypid, a.atttypmod) AS data_type +FROM pg_index i +JOIN pg_attribute a ON a.attrelid = i.indrelid + AND a.attnum = ANY(i.indkey) +WHERE i.indrelid = '$tbl'::regclass +AND i.indisprimary;) : + +qq(PRAGMA table_info($tbl);); + + +my $st = $db->prepare($sql); $st->execute(); +my @r = $st->fetchrow_array(); +if(!@r){ + CNFSQLException->throw(error=> "Table missing or has no Primary Key -> $tbl", show_trace=>1); +} + if($isPostgreSQL){ + return "\"$r[0]\"=?"; + }else{ + # sqlite + # cid[0]|name|type|notnull|dflt_value|pk<--[5] + while(!$r[5]){ + @r = $st->fetchrow_array(); + if(!@r){ + CNFSQLException->throw(error=> "Table has no Primary Key -> $tbl", show_trace=>1); + } + } + return $r[1]."=?"; + } +} + +sub selectRecords { + my ($self, $db, $sql) = @_; + if(scalar(@_) < 2){ + die "Wrong number of arguments, expecting CNFParser::selectRecords(\$db, \$sql) got Settings::selectRecords('@_').\n"; + } + try{ + my $pst = $db->prepare($sql); + return 0 if(!$pst); + $pst->execute(); + return $pst; + }catch{ + CNFSQLException->throw(error=>"Database error encountered!\n ERROR->$@\n SQL-> $sql DSN:".$db, show_trace=>1); + } +} +#@deprecated +sub tableExists { my ($self, $db, $tbl) = @_; + try{ + $db->do("select count(*) from $tbl;"); + return 1; + }catch{} + return 0; +} +### +# Buffer loads initiated a file for sql data instructions. +# TODO 2020-02-13 Under development. +# +sub initLoadDataFile {# my($self, $path) = @_; +return 0; +} +### +# Reads next collection of records into buffer. +# returns 2 if reset with new load. +# returns 1 if done reading data tag value, last block. +# returns 0 if done reading file, same as last block. +# readNext is accessed in while loop, +# filling in a block of the value for a given CNF tag value. +# Calling readNext, will clear the previous block of data. +# TODO 2020-02-13 Under development. +# +sub readNext(){ +return 0; +} + +sub END { +undef %tables;undef %views; +} + +1; + +=begin copyright +Programed by : Will Budic +EContactHash : 990MWWLWM8C2MI8K (https://github.com/wbudic/EContactHash.md) +Source : https://github.com/wbudic/PerlCNF.git +Documentation : Specifications_For_CNF_ReadMe.md + This source file is copied and usually placed in a local directory, outside of its repository project. + So it could not be the actual or current version, can vary or has been modiefied for what ever purpose in another project. + Please leave source of origin in this file for future references. +Open Source Code License -> https://github.com/wbudic/PerlCNF/blob/master/ISC_License.md +=cut copyright \ No newline at end of file diff --git a/htdocs/cgi-bin/system/modules/ContactsPlugin.pm b/htdocs/cgi-bin/system/modules/ContactsPlugin.pm new file mode 100644 index 0000000..24bbc18 --- /dev/null +++ b/htdocs/cgi-bin/system/modules/ContactsPlugin.pm @@ -0,0 +1,161 @@ +package ContactsPlugin; + +use strict; +use warnings; +no warnings qw(experimental::signatures); +use feature qw(signatures); +use Syntax::Keyword::Try; +use Clone qw(clone); +use DBI; + +use constant VERSION => '1.0'; + +CNFParser::import(); + +sub new ($class, $plugin){ + my $settings; + if($plugin){ + $settings = clone $plugin; #clone otherwise will get hijacked with blessings. + } + return bless $settings, $class +} + +### +# Process config data to contain expected fields. +### +sub process ($self, $parser, $property) { + $self->{date} = now(); + my %S = $parser-> collection('%WEB_SERVICE_SETTINGS'); + my $SQL = $parser-> SQL(); + my $db = CNFSQL::_connectDB($S{user},$S{pass},$S{dbi_source},$S{dbi_store},$S{LOG_PATH}); + # The mighty CNFParser reads the plugin CNF property and sets our plugin, to scripted attribute bindings, for sql table and data. + $SQL -> initiDatabase($db,0,{$self->{table}=>$self->{data}}); + my %hdr = $SQL -> getDataHeaderMap($self->{table}); + my $cgi = $parser -> {CGI}; + my $action = $cgi -> param('action'); + my $buffer; + + if($action eq 'form'){ + my $st = $SQL -> selectRecords($db,"select * from $self->{table}"); + + $buffer = js().css().qq( +

Please select who you wish to send a contact message from the following table.

+ + + + + + + ); + while (my @row = $st->fetchrow_array()){ + my $details = $row[$hdr{Details}]; $details = "" if not $details;#driver returns empty string as undef from table. + $buffer .= qq( + + + + + + + ) + } + $buffer .= "\n

ID	Contact	ECHASH
$row[$hdr{ID}]	$row[$hdr{Alias}]	$row[$hdr{ECHSH}]
$details

"; + $buffer .= qq(

+ +

+ ); + } + $parser->data()->{PAGE} = \$buffer; + + #$parser->data()->{$property} = \@data +} +sub js{ +< + + + +JS +} +sub css{ +< + .styled-table { + display: block; + border-collapse: collapse; + margin: 25px 0; + font-size: 0.9em; + font-family: sans-serif; + box-shadow: 8px 10px 20px rgba(0, 0, 0, 0.572); +} +.styled-table thead tr { + background-color: #00fbff; + color: #121111; + text-align: left; + font-weight: bold; +} + +.styled-table td{ + border:1px solid black;padding: 5px;margin: 0; + padding: 12px 15px; +} +.styled-table a{ + cursor:pointer; +} +.styled-table tbody tr { + border-bottom: 1px solid #eff190; +} +.styled-table tbody tr:nth-of-type(even) { + background-color: #f9b5b5; +} +.styled-table tbody tr:last-of-type { + border-bottom: 1px solid #000000; + border-right: 1px solid #000000; +} +.styled-table tbody tr:hover { + font-weight: bold; + background-color: #98fce8; +} +.styled-table textarea{ + overflow-y: scroll; + overflow: scroll; + width:98%; +} +.styled-message{ + margin-left: 0; + font-weight: bold; + text-shadow: 8px 10px 20px rgba(0, 0, 0, 0.572)} + +CSS +} + +1; + + +=begin copyright +Programed by : Will Budic +EContactHash : 990MWWLWM8C2MI8K (https://github.com/wbudic/EContactHash.md) +Source : https://github.com/wbudic/PerlCNF.git +Documentation : Specifications_For_CNF_ReadMe.md + This source file is copied and usually placed in a local directory, outside of its repository project. + So it could not be the actual or current version, can vary or has been modiefied for what ever purpose in another project. + Please leave source of origin in this file for future references. +Open Source Code License -> https://github.com/wbudic/PerlCNF/blob/master/ISC_License.md +=cut copyright \ No newline at end of file diff --git a/htdocs/cgi-bin/system/modules/DataProcessorPlugin.pm b/htdocs/cgi-bin/system/modules/DataProcessorPlugin.pm new file mode 100644 index 0000000..d872b9d --- /dev/null +++ b/htdocs/cgi-bin/system/modules/DataProcessorPlugin.pm @@ -0,0 +1,126 @@ +package DataProcessorPlugin; + +use strict; +use warnings; + +use feature qw(signatures); +use Scalar::Util qw(looks_like_number); +use Clone qw(clone); +use Date::Manip; + +use constant VERSION => '1.0'; + +sub new ($class, $plugin){ + my $settings; + if($plugin){ + $settings = clone $plugin; #clone otherwise will get hijacked with blessings. + } + return bless $settings, $class +} + +### +# Process config data to contain expected fields and data. +### +sub process ($self, $parser, $property) { + my @data = $parser->data()->{$property}; +# +# The sometime unwanted side of perl is that when dereferencing arrays, +# modification only is visible withing the scope of the block. +# Following processes and creates new references on modified data. +# And is the reason why it might look ugly or has some unecessary relooping. +# + for my $did (0 .. $#data){ + my @entry = @{$data[$did]}; + my $ID_Spec_Size = 0; + my @SPEC; + my $mod = 0; + foreach (@entry){ + my @row = @$_; + $ID_Spec_Size = scalar @row; + for my $i (0..$ID_Spec_Size-1){ + if($row[$i] =~ /^#/){ + $SPEC[$i] = 1; + } + elsif($row[$i] =~ /^@/){ + $SPEC[$i] = 2; + } + else{ + $SPEC[$i] = 3; + } + }#rof + if($row[0]){ + # Cleanup header label row for the columns, if present. + shift @entry; + #we are done spec obtained from header just before. + last + } + } + my $size = $#entry; + my $padding = length($size); + for my $eid (0 .. $size){ + my @row = @{$entry[$eid]}; + if ($ID_Spec_Size){ + # If zero it is presumed ID field, corresponding to row number + 1 is our assumed autonumber. + if($row[0] == 0){ + my $times = $padding - length($eid+1); + $row[0] = zero_prefix($times,$eid+1); + $mod = 1 + } + if(@row!=$ID_Spec_Size){ + warn "Row data[$eid] doesn't match expect column count: $ID_Spec_Size\n @row"; + }else{ + for my $i (1..$ID_Spec_Size-1){ + if(not matchType($SPEC[$i], $row[$i])){ + warn "Row in row[$i]='$row[$i]' doesn't match expect data type, contents: @row"; + } + elsif($SPEC[$i]==2){ + my $dts = $row[$i]; + my $dt = UnixDate(ParseDateString($dts), "%Y-%m-%d %T"); + if($dt){ $row[$i] = $dt; $mod = 1 }else{ + warn "Row in row[$i]='$dts' has imporper date format, contents: @row"; + } + }else{ + my $v = $row[$i]; + $v =~ s/^\s+|\s+$//gs; + $row[$i] =$v; + } + } + } + $entry[$eid]=\@row if $mod; #<-- re-reference as we changed the row. Something hard to understand. + } + } + $data[$did]=\@entry if $mod; + } + $parser->data()->{$property} = \@data; +} +sub zero_prefix ($times, $val) { + if($times>0){ + return '0'x$times.$val; + }else{ + return $val; + } +} +sub matchType($type, $val, @rows) { + if ($type==1 && looks_like_number($val)){return 1} + elsif($type==2){ + if($val=~/\d*\/\d*\/\d*/){return 1} + else{ + return 1; + } + } + elsif($type==3){return 1} + return 0; +} + +1; + +=begin copyright +Programed by : Will Budic +EContactHash : 990MWWLWM8C2MI8K (https://github.com/wbudic/EContactHash.md) +Source : https://github.com/wbudic/PerlCNF.git +Documentation : Specifications_For_CNF_ReadMe.md + This source file is copied and usually placed in a local directory, outside of its repository project. + So it could not be the actual or current version, can vary or has been modiefied for what ever purpose in another project. + Please leave source of origin in this file for future references. +Open Source Code License -> https://github.com/wbudic/PerlCNF/blob/master/ISC_License.md +=cut copyright \ No newline at end of file diff --git a/htdocs/cgi-bin/system/modules/DataProcessorWorldCitiesPlugin.pm b/htdocs/cgi-bin/system/modules/DataProcessorWorldCitiesPlugin.pm new file mode 100644 index 0000000..04c9fb2 --- /dev/null +++ b/htdocs/cgi-bin/system/modules/DataProcessorWorldCitiesPlugin.pm @@ -0,0 +1,88 @@ +package DataProcessorWorldCitiesPlugin; + +use strict; +use warnings; + +use feature qw(signatures); +use Scalar::Util qw(looks_like_number); + + +sub new ($class,$plugin){ + return bless {}, $class +} + +### +# Process config data to contain expected fields and data. +### +sub process ($self, $parser, $property) { + + my @data = $parser->data()->{$property}; + + for my $did (0 .. $#data){ + my @entry = @{$data[$did]}; + my $Spec_Size = 0; + my $mod = 0; + # Cleanup header labels row. + shift @entry; + } + $parser->data()->{$property} = \@data; +} + +### +# Process config data directly from a raw data file containing no Perl CNF tags. +# This is prefered way if your data is over, let's say 10 000 rows. +### + +sub loadAndProcess ($self, $parser, $property) { + + my @data; + local $/ = undef; + my $file = $parser->anon($property); + open my $fh, '<', $file or die ("$!"); + foreach(split(/~\n/,<$fh>)){ + my @a; + $_ =~ s/\\`/\\f/g;#We escape to form feed the found 'escaped' backtick so can be used as text. + foreach my $d (split /`/, $_){ + $d =~ s/\\f/`/g; #escape back form feed to backtick. + $d =~ s/~$//; #strip dangling ~ if there was no \n + my $t = substr $d, 0, 1; + if($t eq '$'){ + my $v = $d; #capture spected value. + $d =~ s/\$$|\s*$//g; #trim any space and system or constant '$' end marker. + if($v=~m/\$$/){ + $v = $self->{$d}; $v="" if not $v; + } + else{ + $v = $d; + } + push @a, $v; + } + else{ + if($t =~ /^\#(.*)/) {#First is usually ID a number and also '#' signifies number. + $d = $1;#substr $d, 1; + $d=0 if !$d; #default to 0 if not specified. + push @a, $d + } + else{ + push @a, $d; + } + } + } + $data[@data]= \@a; + } + close $fh; + $parser->data()->{$property} = \@data; +} + +1; + +=begin copyright +Programed by : Will Budic +EContactHash : 990MWWLWM8C2MI8K (https://github.com/wbudic/EContactHash.md) +Source : https://github.com/wbudic/PerlCNF.git +Documentation : Specifications_For_CNF_ReadMe.md + This source file is copied and usually placed in a local directory, outside of its repository project. + So it could not be the actual or current version, can vary or has been modiefied for what ever purpose in another project. + Please leave source of origin in this file for future references. +Open Source Code License -> https://github.com/wbudic/PerlCNF/blob/master/ISC_License.md +=cut copyright \ No newline at end of file diff --git a/htdocs/cgi-bin/system/modules/HTMLIndexProcessorPlugin.pm b/htdocs/cgi-bin/system/modules/HTMLIndexProcessorPlugin.pm index f92cc76..afce2c1 100644 --- a/htdocs/cgi-bin/system/modules/HTMLIndexProcessorPlugin.pm +++ b/htdocs/cgi-bin/system/modules/HTMLIndexProcessorPlugin.pm @@ -26,61 +26,34 @@ sub new ($class, $plugin){ ### # Process config data to contain expected fields and data. ### -sub convert ($self, $parser, $property) { +sub convert ($self, $parser, $property) { my ($buffer,$title, $link, $body_attrs, $body_on_load, $give_me); my $cgi = CGI -> new(); - my $cgi_action = $cgi-> param('action'); - my $cgi_doc = $cgi-> param('doc'); + my $cgi_action = $cgi-> param('action'); + my $cgi_doc = $cgi-> param('doc'); my $tree = $parser-> anon($property); - die "Tree property '$property' is not available!" if(!$tree or ref($tree) ne 'CNFNode'); + die "Tree property '$property' is not available!" if(!$tree or ref($tree) ne 'CNFNode'); + try{ - #TODO 20231002 Move -> %WEBAPP_SETTINGS into utility. - my %THEME; - my %wsettings = $parser -> collection('%WEBAPP_SETTINGS'); - if(%wsettings){ - my $theme = $wsettings{THEME}; - my @els = split(/, /, $theme); - foreach (@els) { - my ($key,$val) = split(/\s*=>\s*/, $_); - $THEME{$key} = $val; - last if $key eq 'css' - } - my $theme_file = $wsettings{LOG_PATH}.'current_theme'; - $theme_file =~ /^\.\.\/\.\.\// if(-e $theme_file); - if(-e $theme_file){ - open my $fh, '<', $theme_file; - my $theme = <$fh>; - close($fh); - if($theme =~ m/standard/i){ - $THEME{css} = "wsrc/main.css" - }elsif($theme =~ m/moon/i){ - $THEME{css} = "wsrc/main_moon.css" - } - elsif($theme =~ m/sun/i){ - $THEME{css} = "wsrc/main_sun.css" - } - elsif($theme =~ m/earth/i){ - $THEME{css} = "wsrc/main_earth.css" - } - } - } - if (exists $parser->{'HTTP_HEADER'}){ + + if (exists $parser->{'HTTP_HEADER'}){ $buffer .= $parser-> {'HTTP_HEADER'}; - }else{ + }else{ if(exists $parser -> collections()->{'%HTTP_HEADER'}){ my %http_hdr = $parser -> collection('%HTTP_HEADER'); $buffer = $cgi->header(%http_hdr); } } - if ($cgi_action and $cgi_action eq 'load'){ - $buffer .= $cgi->start_html(); my + + if ($cgi_action and $cgi_action eq 'load'){ + $buffer .= $cgi->start_html(); my $load = loadDocument($parser, $cgi_doc); if($load){ - $buffer .= $$load if $load; + $buffer .= $$load if $load; }else{ $buffer .= "Document is empty: $cgi_doc\n" - } + } }else{ $title = $tree -> {'Title'} if exists $tree->{'Title'}; $link = $tree -> {'HEADER'}; @@ -91,17 +64,13 @@ try{ if($link){ if(ref($link) eq 'CNFNode'){ my $arr = $link->find('CSS/@@'); - foreach (@$arr){ - if($THEME{css} && $_->val() =~ /main.css$/){ - push @hhshCSS, {-type => 'text/css', -src => $THEME{css}}; - }else{ - push @hhshCSS, {-type => 'text/css', -src => $_->val()}; - } + foreach (@$arr){ + push @hhshCSS, {-type => 'text/css', -src => $_->val()}; } $arr = $link->find('JS/@@'); - foreach (@$arr){ - push @hhshJS, {-type => 'text/javascript', -src => $_->val()}; - } + foreach (@$arr){ + push @hhshJS, {-type => 'text/javascript', -src => $_->val()}; + } $arr = $link -> find('STYLE'); if(ref($arr) eq 'ARRAY'){ foreach (@$arr){ @@ -111,65 +80,51 @@ try{ } $arr = $link -> find('SCRIPT'); if(ref($arr) eq 'ARRAY'){ - foreach (@$arr){ - my $attributes = _nodeHTMLAtrributes($_); - $give_me .= "\n\n".$_ -> val()."\n\n" + foreach (@$arr){ + $give_me .= "\n\n" }}else{ - my $attributes = _nodeHTMLAtrributes($arr); - $give_me .= "\n\n".$arr -> val()."\n\n"; - + $give_me .= "\n\n" } - } - delete $tree -> {'HEADER'}; - } + } + delete $tree -> {'HEADER'}; + } $buffer .= $cgi->start_html( -title => $title, -onload => $body_on_load, - # -BGCOLOR => $colBG, + # -BGCOLOR => $colBG, -style => \@hhshCSS, -script => \@hhshJS, -head=>$give_me, $body_attrs ); - foreach my $node($tree->nodes()){ + foreach my $node($tree->nodes()){ $buffer .= build($parser, $node) if $node; } $buffer .= $cgi->end_html(); } $parser->data()->{$property} = \$buffer; }catch($e){ - HTMLIndexProcessorPluginException->throw(error=>$e); + HTMLIndexProcessorPluginException->throw(error=>$e ,show_trace=>1); } } - -sub _nodeHTMLAtrributes { - my $node = shift; - my $attributes =" "; - my @attrs = $node -> attributes(); - foreach my $a(@attrs){ - $attributes .= @$a[0] . " = \"" .@$a[1]."\"" - } - $attributes = "" if $attributes eq " "; - return $attributes -} # sub loadDocument($parser, $doc) { my $slurp = do { - open my $fh, '<:encoding(UTF-8)', $doc or HTMLIndexProcessorPluginException->throw(error=>"Document not avaliable -> \"$doc\" ", show_trace=>1); + open my $fh, '<:encoding(UTF-8)', $doc or HTMLIndexProcessorPluginException->throw("Document not avaliable: $doc"); local $/; - <$fh>; + <$fh>; }; if($doc =~/\.md$/){ - require MarkdownPlugin; - my @r = @{MarkdownPlugin->new(undef)->parse($slurp)}; + require MarkdownPlugin; + my @r = @{MarkdownPlugin->new()->parse($slurp)}; return $r[0]; } - return \$slurp + return \$slurp } ### # Builds the html version out of a CNFNode. -# CNFNode with specific tags here are converted also here, +# CNFNode with specific tags here are converted also here, # those that are out of the scope for normal standard HTML tags. # i.e. HTML doesn't have row and cell tags. Neither has meta links syntax. ### @@ -183,14 +138,14 @@ sub build { $bf .= "\t"x$tabs."\n"."\t"x$tabs."

"; foreach my $n($node->nodes()){ if($n->{'_'} ne '#'){ - my $b = build($parser, $n, $tabs+1); + my $b = build($parser, $n, $tabs+1); $bf .= "$b\n" if $b; } } if($node->{'#'}){ my $v = $node->val(); $v =~ s/\n\n+/\<\/br>\n/gs; - $bf .= "\t

\n\t

\n".$v."

\n\t

\n"; + $bf .= "\t

\n\t

\n".$v."

\n\t

\n"; } $bf .= "\t

\n" }elsif( $name eq 'row' || $name eq 'cell' ){ @@ -201,13 +156,13 @@ sub build { $bf .= "$b\n" if $b; } } - $bf .= $node->val()."\n" if $node->{'#'}; + $bf .= $node->val()."\n" if $node->{'#'}; $bf .= "\t"x$tabs."

" }elsif( $name eq 'img' ){ $bf .= "\t\t\n"; }elsif($name eq 'list_images'){ my $paths = $node->{'@@'}; - foreach my $ndp (@$paths){ + foreach my $ndp (@$paths){ my $path = $ndp -> val(); my @ext = split(',',"jpg,jpeg,png,gif"); my $exp = " ".$path."/*.". join (" ".$path."/*.", @ext); @@ -220,22 +175,22 @@ sub build { $bf .= qq(\t

); $bf .= qq(\t

$fn\n

\n); } - } + } }elsif($name eq '!'){ return "\n"; - + }elsif($node->{'*'}){ #Links are already captured, in future this might be needed as a relink from here for dynamic stuff? my $lval = $node->{'*'}; - if($name eq 'file_list_html'){ #Special case where html links are provided. + if($name eq 'file_list_html'){ #Special case where html links are provided. foreach(split(/\n/,$lval)){ $bf .= qq( [ $_ ] |) if $_ } $bf =~ s/\|$//g; }else{ #Generic included link value. #is there property data for it? - my $prop = $parser->data()->{$node->name()}; + my $prop = $parser->data()->{$node->name()}; #if not has it been passed as an page constance? - $prop = $parser -> {$node->name()} if !$prop; + $prop = $parser -> {$node->name()} if !$prop; if ( !$prop ) { if ( $parser->{STRICT} ) { die "Not found as property link -> " . $node->name()} else { warn "Not found as property link -> " . $node->name()} @@ -254,20 +209,20 @@ sub build { } else{ my $spaced = 1; - $bf .= "\t"x$tabs."<".$node->name().placeAttributes($node).">"; - foreach my $n($node->nodes()){ - my $b = build($parser, $n,$tabs+1); - if ($b){ + $bf .= "\t"x$tabs."<".$node->name().placeAttributes($node).">"; + foreach my $n($node->nodes()){ + my $b = build($parser, $n,$tabs+1); + if ($b){ if($b =~/\n/){ $bf =~ s/\n$//gs; $bf .= "\n$b\n" }else{ - $spaced=0; - $bf .= $b; + $spaced=0; + $bf .= $b; } - } + } } - + if ($node->{'#'}){ $bf .= $node->val(); $bf .= "name().">"; @@ -292,7 +247,7 @@ sub placeAttributes { if(@$_[0] ne '#' && @$_[0] ne '_'){ if(@$_[1]){ $ret .= " ".@$_[0]."=\"".@$_[1]."\""; - }else{ + }else{ $ret .= " ".@$_[0]." "; } } diff --git a/htdocs/cgi-bin/system/modules/HTMLProcessorPlugin.pm b/htdocs/cgi-bin/system/modules/HTMLProcessorPlugin.pm index b455f23..2977a31 100644 --- a/htdocs/cgi-bin/system/modules/HTMLProcessorPlugin.pm +++ b/htdocs/cgi-bin/system/modules/HTMLProcessorPlugin.pm @@ -1,14 +1,7 @@ ### # HTML converter Plugin from PerlCNF to HTML from TREE instucted properties. # Processing of these is placed in the data parsers data. -# Programed by : Will Budic -# Notice - This source file is copied and usually placed in a local directory, outside of its project. -# So it could not be the actual or current version, can vary or has been modiefied for what ever purpose in another project. -# Please leave source of origin in this file for future references. -# Source of Origin : https://github.com/wbudic/PerlCNF.git -# Documentation : Specifications_For_CNF_ReadMe.md -# Open Source Code License -> https://choosealicense.com/licenses/isc/ -# +### package HTMLProcessorPlugin; use strict; @@ -17,20 +10,16 @@ use Syntax::Keyword::Try; use Exception::Class ('HTMLProcessorPluginException'); use feature qw(signatures); use Scalar::Util qw(looks_like_number); -use Date::Manip; +use Clone qw(clone); use constant VERSION => '1.0'; -sub new ($class, $fields={Language=>'English',DateFormat=>'US'}){ - - if(ref($fields) eq 'REF'){ - warn "Hash reference required as argument for fields!" +sub new ($class, $plugin){ + my $settings; + if($plugin){ + $settings = clone $plugin; #clone otherwise will get hijacked with blessings. } - my $lang = $fields->{'Language'}; - my $frmt = $fields->{'DateFormat'}; - Date_Init("Language=$lang","DateFormat=$frmt"); - - return bless $fields, $class + return bless $settings, $class } ### @@ -60,10 +49,15 @@ try{ my $v = $_->val(); $bfHDR .= qq(\t\n); } - my $ps = $link -> find('STYLE'); - $style = "\n" if($ps); - $ps = $link -> find('JAVASCRIPT'); - $jscript = "\n" if($ps); + # Glob find '/*' now has guaranteed array cast derefence return. Even if nothing found. Some folks will cringe on that. Ahahaha! + $arr = $link -> find('STYLE/*'); + foreach (@$arr){ + $style = "\n" + } + $arr = $link -> find('JAVASCRIPT/*'); + foreach (@$arr){ + $jscript = "\n" + } } delete $tree -> {'HEADER'}; @@ -202,4 +196,15 @@ sub isParagraphName { -1; \ No newline at end of file +1; + +=begin copyright +Programed by : Will Budic +EContactHash : 990MWWLWM8C2MI8K (https://github.com/wbudic/EContactHash.md) +Source : https://github.com/wbudic/PerlCNF.git +Documentation : Specifications_For_CNF_ReadMe.md + This source file is copied and usually placed in a local directory, outside of its repository project. + So it could not be the actual or current version, can vary or has been modiefied for what ever purpose in another project. + Please leave source of origin in this file for future references. +Open Source Code License -> https://github.com/wbudic/PerlCNF/blob/master/ISC_License.md +=cut copyright \ 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 67da6fe..1636665 100644 --- a/htdocs/cgi-bin/system/modules/MarkdownPlugin.pm +++ b/htdocs/cgi-bin/system/modules/MarkdownPlugin.pm @@ -261,11 +261,11 @@ try{ $ln =~ s/^\s*\>+//; ($ln =~ /^(\s+) (\d+) \.\s (.*)/x || $ln =~ /^(\s*) ([-+*]) \s(.*)/x); if($2 && $2 =~ /[-+*]/){ - $bqte_tag = "ul"; + $bqte_tag = "ul" }elsif($2){ - $bqte_tag = "ol"; + $bqte_tag = "ol" }else{ - $bqte_tag = "p"; + $bqte_tag = "p" } if(!$bqte_nested){ $bqte_nested = $nested; diff --git a/htdocs/cgi-bin/system/modules/RSSFeedsPlugin.pm b/htdocs/cgi-bin/system/modules/RSSFeedsPlugin.pm index 920d275..d0fc97a 100644 --- a/htdocs/cgi-bin/system/modules/RSSFeedsPlugin.pm +++ b/htdocs/cgi-bin/system/modules/RSSFeedsPlugin.pm @@ -73,7 +73,7 @@ sub collectFeeds($self, $parser) { my $feed = $cgi->param('feed') if $cgi; $parser->log("Feed request:$feed"); for my $idx (0 .. $#data){ - my @col = @{$data[$idx]}; + my @col = @{$data[$idx]}; if($idx==0){ for my $i(0..$#col){ # Get the matching table column index names as scripted. $hdr{$col[$i]} = $i diff --git a/htdocs/cgi-bin/wsrc/feeds.js b/htdocs/cgi-bin/wsrc/feeds.js index adc795a..51e3249 100644 --- a/htdocs/cgi-bin/wsrc/feeds.js +++ b/htdocs/cgi-bin/wsrc/feeds.js @@ -7,7 +7,9 @@ function fetchFeeds(id){ ); pnl.show(); pnl.css('visibility','visible'); + if(ID === "#feeds"){ $(document).scrollTop( $("#rss_anchor").offset().top ); + } $.post('CNFServices.cgi', {service:'feeds',action:'list'}, displayFeeds).fail( function(response) { pnl.html(response.responseText); @@ -26,7 +28,7 @@ function fetchFeed(feed) { $.post('CNFServices.cgi', {service:'feeds', action:'read', feed:feed}, displayFeeds).fail( function(response) { pnl.html(response.responseText); - pnl.fadeOut(20000); + pnl.fadeOut(30000); } ); } @@ -35,7 +37,9 @@ function displayFeeds(content){ pnl.html(content); $("#index-content").css("height",'100%'); pnl.show(); - $(document).scrollTop( $("#rss_anchor").offset().top ); + if(ID === "#feeds"){ + $(document).scrollTop( $("#rss_anchor").offset().top ); + } } function demoLogin() { @@ -44,3 +48,26 @@ function demoLogin() { $('#frm_login input[name=passw]').val("admin"); form.submit(); } + +function contactForm(){ + var pnl = $(ID); + $.post('CNFServices.cgi', {service:'contacts', action:'form'}, + function(content){ + pnl.html(content); + pnl.css('visibility','visible'); + pnl.show(); + }).fail( + function(response) { + pnl.html(response.responseText); + pnl.fadeOut(30000); + } + ); +} +function contact(contact,echsh){ + $("#frm_contact input[name=poster_contacts]").val(contact); + $("#frm_contact input[name=echsh]").val(echsh); + var pnl = $('#div_contact'); + pnl.show(); + pnl.css('visibility','visible'); + return false; +} \ No newline at end of file diff --git a/htdocs/cgi-bin/wsrc/main.css b/htdocs/cgi-bin/wsrc/main.css index d87efa8..c371ba1 100644 --- a/htdocs/cgi-bin/wsrc/main.css +++ b/htdocs/cgi-bin/wsrc/main.css @@ -13,9 +13,8 @@ body{ padding:0; } p { - font-family: Bookman; - margin-left: 70px; - font-weight: normal; + margin-left: 70px; + font-weight: bold; } pre{ color: #070707; @@ -79,7 +78,7 @@ th, background: #ccffff; margin-top: 15px; margin-left: 200px; - width: 400px; + width: 280px; text-decoration-style: wavy; } @@ -168,6 +167,8 @@ div#rz { border: 1px solid black; border-right: 1px solid black; text-align: center; + margin:0; + padding: 3px; } .edit { @@ -235,18 +236,52 @@ img { margin-left: 91%; } +#menu_page { + border: 2px solid #10c69b72; +} +.marg-top-2{ + margin-top: 5px; +} + #frm_login { vertical-align: middle; margin: 0; } +.ui-icon,.menu_title { + background-color: transparent; + font-weight: bolder; +} +.ui-button { + font-size: 12px !important; + outline-color: transparent; +} +.ui-button:hover { + background: #00ddfa79; + background-image: none; + color: #000000 !important; +} +.ui-selectmenu-button:{ + background-image: none; +} +.ui-selectmenu-button:hover{ + background-image: none; + background: #00ddfa; +} + -.ui-button, -.ui-button-text .ui-button { - font-size: 12px !important; -} + +.ui-widget.ui-widget-content { + border: 1px solid #131311; + color: #362b36; + font-weight: bold; +} +.ui-widget-content { + background: #183c76; + color: #362b36; +} .ui-menu { list-style: none; padding: 10px;