From: Will Budic Date: Mon, 17 Feb 2020 19:13:36 +0000 (+1100) Subject: New CNF Development. X-Git-Url: https://lifelog.hopto.org/gitweb/?a=commitdiff_plain;h=65634811c777682b1363ff6358a50dcb02a6231a;p=LifeLog.git New CNF Development. --- diff --git a/htdocs/cgi-bin/CNF_DBDev.pl b/htdocs/cgi-bin/CNF_DBDev.pl new file mode 100755 index 0000000..986c45d --- /dev/null +++ b/htdocs/cgi-bin/CNF_DBDev.pl @@ -0,0 +1,216 @@ +#!/usr/bin/perl -w +# +# Programed by: Will Budic +# Open Source License -> https://choosealicense.com/licenses/isc/ +# +use strict; +use warnings; +use Try::Tiny; + +use DateTime; +use DateTime::Format::SQLite; +use DateTime::Duration; +use DBI; + +#DEFAULT SETTINGS HERE! +use lib "system/modules"; +use lib $ENV{'PWD'}.'/htdocs/cgi-bin/system/modules'; +require CNFParser; +require Settings; + + +my ($dsn, $db,$res,$stm,$dbver,$st,$cnf); +my $today = DateTime->now; + $today->set_time_zone( &Settings::timezone ); + + +&testSettingsForStatementsInLifeLogDB; + + +sub testSettingsForStatementsInLifeLogDB { + + $cnf = CNFParser->new(); + $dsn= "DBI:SQLite:dbname=".$ENV{'PWD'}.'/dbLifeLog/data_admin_log.db'; + $db = DBI->connect($dsn, 'admin', 'admin', { RaiseError => 1 }) or die "Error->". &DBI::errstri; + + + print "Log records count:",Settings::selectRecords($db, 'select count(*)from LOG;')->fetchrow_array(),"\n"; + print "--Sample--\n", + + my $pst1 = Settings::selectRecords($db, 'select rowid, date, log from LOG order by date desc limit 10;'); + my $st = $db->prepare('select rowid, date, log from LOG order by date desc;'); + $st->execute() or die "

ERROR with->$_

"; + + + foreach (my @r = $pst1->fetchrow_array()) { + my $lid = $r[0]; + my $dat = $r[1]; + my $log = $r[2]; + if(length($log)>60){ + print sprintf("%4d %s %.60s...\n", $lid, $dat, $log); + }else{ + print sprintf("%4d %s %0s\n", $lid, $dat, $log); + } + + } + + my $pst = Settings::selectRecords($db,"SELECT name FROM sqlite_master WHERE type='table';"); + my %curr_tables = (); + while(my @r = $pst->fetchrow_array()){ + $curr_tables{$r[0]} = 1; + } + my $check; if ($curr_tables{"LOG"}){$check = 'yes'} else{ $check = 'no'}; + print "Has Log table? ->", $check, "\n"; + if ($curr_tables{"DOODLE"}){$check = 'yes'} else{ $check = 'no'}; + print "DOODLE table? ->", $check, "\n"; + + $check = Settings::selectRecords($db,"SELECT ID FROM CAT WHERE name == 'System Log';")->fetchrow_array(); + $check = 0 if not $check; + print "0==$check\n"; + $db->disconnect(); + +exit; +} + +$cnf = CNFParser->new(); + +$cnf->parse($ENV{'PWD'}."/dbLifeLog/databaseInventory.cnf"); + + + +$dsn = "DBI:SQLite:dbname=".$ENV{'PWD'}.'/dbLifeLog/'.$cnf->constant('$DATABASE'); + + $db = DBI->connect($dsn, $cnf->constant('$LOGIN_USER'), $cnf->constant('$LOGIN_PASS'), { RaiseError => 1 }) + or die "Error->". &DBI::errstri ; +$dbver = $cnf->initiDatabase($db); + + +$dsn= "DBI:SQLite:dbname=".$ENV{'PWD'}.'/dbLifeLog/'.$cnf->constant('$DATABASE'); + +print "Acessing: $dsn\n"; + +## We have all the table statments, so let's check issue them first. +foreach my $tbl ($cnf->tables()){ + + if($cnf->tableExists($db, $tbl)){ + print "Table -> $tbl found existing.\n"; + } + else{ + $stm = $cnf->tableSQL($tbl); + + if($db->do($stm)){ + print "Created table: $tbl \n"; + } + else{ + print "Failed -> \n$stm \n"; + } + } + +} + + + +foreach my $tbl ($cnf->dataKeys()){ + my ($sel,$ins, $seu, $upd, @prm, @arr);#locals + try{ + print "Processing table data for ->", $tbl , "\n"; + $stm = $cnf->tableSQL($tbl); + + if(!$stm){ + print "Failed to obtain table statment for table data -> $tbl\n"; + }else{ + @arr = getStatements($tbl, $stm); + $sel = $db->prepare($arr[0]); + $ins = $db->prepare($arr[1]); + $seu = $db->prepare($arr[2]); + $upd = $db->prepare($arr[3]); + foreach my $ln ($cnf->data($tbl)){ + #print "dataln-> $ln\n"; + @prm = (); + foreach my $p (split(/','/,$ln)){ + $p =~ s/^'|'$//g; + push @prm, $p; + } + $sel->execute(@prm); + my @ret = $sel -> fetchrow_array(); + if(@ret){ + print "Exists -> ".delim(@prm)," <- UID: $ret[0]", "\n"; + } + else{ + my $uid = shift @prm; + $seu->execute($uid); + @ret = $seu -> fetchrow_array(); + if(@ret){ + push @prm, $uid; + @ret = $upd->execute(@prm); + print "Updated -> ".delim(@prm), "\n"; + }else{ + unshift @prm, $uid; + $ins->execute(@prm); + print "Added -> ".delim(@prm), "\n"; + } + } + } + } + + }catch{ + print "Error:$_\n"; + print "Error on->$tbl exeprms[",delim(@prm),"]\n"; + foreach my $ln ($cnf->data($tbl)){ + print "dataln-> $ln\n"; + } + } + +} + +sub delim { + my $r; + foreach(@_){$r.=$_.'`'} + $r=~s/`$//; + return $r; +} + +sub getStatements { + + my ($tbl, $stm) = @_; + my @ret = (); + my ($sel,$ins, $seu, $upd, $upe); + + $sel = "SELECT * FROM $tbl WHERE "; + $ins = "INSERT INTO $tbl VALUES("; + $upd = "UPDATE $tbl SET "; + + $stm =~ s/^.*\(\s+//g; + $stm =~ s/\n\s*|\n\);/\n/g; + $stm =~ s/\);//g; + + # print "<<$stm>>\n"; + + foreach my $n (split(/,\s*/,$stm)){ + $n =~ /(^\w+)/; + #print $1, "\n"; + $sel .= "$1=? AND "; + $seu .= "SELECT * FROM $tbl WHERE $1=?;" if !$seu; + $ins .= "?,"; + if (!$upe){ + $upe = " WHERE $1=?"; + }else{ + $upd .= "$1=?,"; + } + } + $sel =~ s/\sAND\s$/;/g; + $ins =~ s/,$/);/g; + $upd =~ s/,$/$upe/g; + + push @ret, $sel; + push @ret, $ins; + push @ret, $seu; + push @ret, $upd; + + # print delim(@ret)."\n"; + + return @ret; +} + + +1; diff --git a/htdocs/cgi-bin/CNF_SnippetsTesting.pl b/htdocs/cgi-bin/CNF_SnippetsTesting.pl new file mode 100755 index 0000000..766bbdb --- /dev/null +++ b/htdocs/cgi-bin/CNF_SnippetsTesting.pl @@ -0,0 +1,22 @@ +#!/usr/bin/perl -w +# +# Programed by: Will Budic +# Open Source License -> https://choosealicense.com/licenses/isc/ +# +use strict; +use warnings; +use Try::Tiny; + +my $s1 ="`1`2`3`te\\`s\\`t`the best`"; + + $s1 =~ s/\\`/\\f/g; + #print $s1,"\n"; +foreach ( split ( /`/, $s1) ){ + $_ =~ s/\\f/`/g; + print $_,"\n"; +} +print "Home:".$ENV{'PWD'}.$ENV{'NL'}; + + + +1; diff --git a/htdocs/cgi-bin/CNF_test_anons.pl b/htdocs/cgi-bin/CNF_test_anons.pl new file mode 100755 index 0000000..9f229ff --- /dev/null +++ b/htdocs/cgi-bin/CNF_test_anons.pl @@ -0,0 +1,63 @@ +#!/usr/bin/perl -w +# +# Programed by: Will Budic +# Open Source License -> https://choosealicense.com/licenses/isc/ +# +use strict; +use warnings; +use Try::Tiny; + +use DateTime; +use DateTime::Format::SQLite; +use DateTime::Duration; + + +#DEFAULT SETTINGS HERE! +use lib "system/modules"; + +use lib $ENV{'PWD'}.'/htdocs/cgi-bin/system/modules'; +require CNFParser; + +testSettingsForStatments(); + + + +sub testAnons { + +my $cnf = CNFParser->new($ENV{'PWD'}."/dbLifeLog/databaseAnonsTest.cnf"); + +my $exe = $cnf->anons('list_cmd', $ENV{'PWD'}); +print "Exe is:$exe\n"; +$exe = `$exe`; +print "Error failed system command!" if !$exe; +#print "Listing:\n$exe\n"; + +print "--LIST OF ALL ANONS ENCOUNTERED---\n"; +my %anons = $cnf->anons(); +foreach my $k (keys %anons){ + print "Key->$k=", $anons{$k},"]\n"; +} +eval((keys %anons) == 7) or die "Error annons count mismatch!"; + +eval(length($cnf->constant('$HELP'))>0) or die 'Error missing multi-line valued constant property $HELP'; + +my $template = $cnf -> template( 'MyTemplate', ( + 'SALUTATION'=>'Mr', + 'NAME'=>'Prince Clington', + 'AMOUNT'=>"1,000,000\$", + 'CRITERIA'=>"Section 2.2 (Eligibility Chapter)" + ) + ); + +print "\n--- TEMPLATE ---\n".$template; + +### From the specs. +my $url = $cnf->anons('GET_SUB_URL',('tech','main.cgi')); +# $url now should be: https://www.tech.acme.com/main.cgi +eval ($url =~ m/https:\.*/) +or warn "Failed to obtain expected URL when querying anon -> GET_SUB_URL"; +eval ($url eq 'https://www.tech.acme.com/main.cgi') or die "Error with: $url"; +} + + +1; diff --git a/htdocs/cgi-bin/CNF_tester.pl b/htdocs/cgi-bin/CNF_tester.pl new file mode 100755 index 0000000..1572edd --- /dev/null +++ b/htdocs/cgi-bin/CNF_tester.pl @@ -0,0 +1,41 @@ +#!/usr/bin/perl -w +# +# Programed by: Will Budic +# Open Source License -> https://choosealicense.com/licenses/isc/ +# +use strict; +use warnings; +use Try::Tiny; + +use DateTime; +use DateTime::Format::SQLite; +use DateTime::Duration; +use Text::CSV; + +#DEFAULT SETTINGS HERE! +use lib "system/modules"; + +use lib $ENV{'PWD'}.'/htdocs/cgi-bin/system/modules'; +require CNFParser; + +my $cnf = CNFParser->new(); +$cnf->parse($ENV{'PWD'}."/dbLifeLog/database.cnf"); + +foreach ($cnf->SQLStatments()){ + print "$_\n"; +} +foreach my $p ($cnf->constants()){ + + print "$p=", $cnf->constant($p),"\n"; +} +print "\n---ANNONS---\n"; +my %anons = $cnf->anons(); +foreach my $k (%anons){ + print "$k=", $anons{$k},"\n" if $k; +} +# foreach (sort keys %ENV) { +# print "$_= $ENV{$_}\n"; +# } + +### CGI END +1; diff --git a/htdocs/cgi-bin/system/modules/CNFParser.pm b/htdocs/cgi-bin/system/modules/CNFParser.pm index 707c4a9..794592c 100755 --- a/htdocs/cgi-bin/system/modules/CNFParser.pm +++ b/htdocs/cgi-bin/system/modules/CNFParser.pm @@ -7,44 +7,120 @@ package CNFParser; use strict; use warnings; +use Exception::Class ('CNFParserException'); use Try::Tiny; +use Switch; + our %anons = (); our %consts = (); +our %mig = (); our @sql = (); +our @files = (); +our %tables = (); +our %data = (); sub new { my $class = shift; + my $path = shift; my $self = {}; bless $self, $class; + $self->parse($path) if($path); return $self; } -sub anons {return %anons} +sub anons { + my ($self, $n, @arg)=@_; + if($n){ + my $ret = $anons{$n}; + return undef if !$ret; + if(@arg){ + my $cnt = 1; + foreach(@arg){ + $ret =~ s/\$\$\$$cnt\$\$\$/$_/g; + $cnt++; + } + } + return $ret; + } + return %anons; +} sub constant {my $s=shift;if(@_ > 0){$s=shift;} return $consts{$s}} -sub constants {return keys %consts} +sub constants {return sort keys %consts} sub SQLStatments {return @sql} -sub anonsToENV { - # foreach my $prp (keys %anons){ - # print "{{",$prp, '=' , $anons{$prp}, "}}\n"; - # } +sub dataFiles {return @files} +sub tables {return keys %tables} +sub tableSQL {my $t=shift;if(@_ > 0){$t=shift;} return $tables{$t}} +sub dataKeys {return keys %data} +sub data {my $t=shift;if(@_ > 0){$t=shift;} return @{$data{$t}}} +sub migrations {return %mig;} + +# Adds a list of environment expected list of variables. +# This is optional and ideally to be called before parse. +# Requires and array of variables to be passed. +sub addENVList { + my ($self, @vars) = @_; + if(@vars){ + foreach my $var(@vars){ + next if $consts{$var};##exists already. + if((index $var,0)=='$'){#then constant otherwise anon + $consts{$var} = $ENV{$var}; + } + else{ + $anons{$var} = $ENV{$var}; + } + } + } +} + + +sub template { + my ($self, $property, %macros) = @_; + my $val = anons($self, $property); + if($val){ + my $m; + foreach $m(keys %macros){ + my $v = $macros{$m}; + $m ="\\\$\\\$\\\$".$m."\\\$\\\$\\\$"; + $val =~ s/$m/$v/gs; + # print $val; + } + my $prev; + foreach $m(split(/\$\$\$/,$val)){ + if(!$prev){ + $prev = $m; + next; + } + undef $prev; + my $pv = anons($self, $m); + if(!$pv){ + $pv = constant($self, '$'.$m); + } + if($pv){ + $m = "\\\$\\\$\\\$".$m."\\\$\\\$\\\$"; + $val =~ s/$m/$pv/gs; + } + } + return $val; + } + return undef; } sub parse { my ($self, $cnf, $content) = @_; - open(my $fh, "<:perlio", $cnf ) or die "Can't open $cnf -> $!"; + open(my $fh, "<:perlio", $cnf ) or CNFParserException->throw("Can't open $cnf -> $!"); read $fh, $content, -s $fh; close $fh; try{ - my @tags = ($content =~ m/<<(\w*<(.*?).*?>>)/gs); + my @tags = ($content =~ m/<<(\$*\w*<(.*?).*?>>)/gs); foreach my $tag (@tags){ next if not $tag; - if(index($tag,'>")-$i; - $consts{$k} = $v; + $consts{$k} = $v if not $consts{$k}; } else{ @@ -83,48 +159,166 @@ try{ my $e = $kv[0]; my $t = $kv[1]; my $i = index $t, "\n"; + #trim accidental spacing in property value or instruction tag + $t =~ s/^\s+//g; + if($i==-1){ - $t = $v = substr $t, 0, (rindex $t, ">>"); + my $te = index $t, " "; + if($te>0){ + $v = substr($t, $te+1, (rindex $t, ">>")-($te+1)); + if(isReservedWord($v)){ + $t = substr($t, 0, $te); + # print "[FAIL[[[$t]]]]]]\n"; + } + else{ + $v = $t =substr $t, 0, (rindex $t, ">>");#single line declared anon most likely. + #print "[[<<[$t]>>]]\n"; + } + #print "Ins($i): with $e val-> $v|\n"; + } + else{ + $t = $v = substr $t, 0, (rindex $t, ">>"); + # print "[FAIL2[[[$t]]]]]]\n"; + } } else{ - $v = substr $t, $i, (rindex $t, ">>")-$i; - $t = substr $t, 0, $i; + my $ri = (rindex $t, ">>"); + #print "[[1[$t]]]\n"; + if($ri>$i){ + $v = substr $t, $i; + #opting to trim on multilines, just in case number of ending "<<" count is scripted in a mismatch! + $v =~ s/\s>+$//g; + # print "[[2[$e->$v]]\n"; + } + else{ + $v = substr $t, $i+1, $ri - ($i+2); + } + $t = substr $t, 0, $i; } - # print "Ins($i): with $e do $t\n"; - if($t eq 'DATA'){ + # print "Ins($i): with $e do $t|\n"; + if($t eq 'CONST'){#Single constant with mulit-line value; + $v =~ s/^\s//; + $consts{$e} = $v if not $consts{$e}; + next; + } + elsif($t eq 'DATA'){ $st =""; - foreach(split /\n/,$v){ + my @tad = (); + foreach(split /~\n/,$v){ my $d = $i = ""; - foreach $d (split /\`/, $_){ - $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 = $consts{$d} - } - else{ - $v = $d; - } - $i .= "'$v',"; - } - else{ - #First is always ID a number and '#' signifies number. - if(!$i || $t eq "\#") { - $i .= "$d,"; - } - else{ - $i .= "'$d',"; - } - } + $_ =~ s/\\`/\\f/g;#We escape to form feed the escaped in file backtick. + foreach $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 = $consts{$d} + } + else{ + $v = $d; + } + $i .= "'$v',"; + } + else{ + #First is always ID a number and '#' signifies number. + if($t eq "\#") { + $i .= "$d," if $d; + } + else{ + $i .= "'$d',"; + } + } } $i =~ s/,$//; - $st .="INSERT INTO $e VALUES($i);\n" if $i; + push @tad, $i if $i; } + my @existing = $data{$e}; + if(scalar(@existing)>1){ + @existing = @{$data{$e}}; + foreach $i(@existing){ + push @tad, $i if $i; + } + } + $data{$e} = [@tad] if scalar(@tad)>0; + next; + } + elsif($t eq 'FILE'){ + + my $path = $cnf; + $v=~s/\s+//g; + $path = substr($path, 0, rindex($cnf,'/')) .'/'.$v; + push @files, $path; + next if(!$consts{'$AUTOLOAD_DATA_FILES'}); + open(my $fh, "<:perlio", $path ) or CNFParserException->throw("Can't open $path -> $!"); + read $fh, $content, -s $fh; + close $fh; + my @tags = ($content =~ m/<<(\w*<(.*?).*?>>)/gs); + foreach my $tag (@tags){ + next if not $tag; + @kv = split />"); + } + else{ + $v = substr $t, $i+1, (rindex $t, ">>")-($i+1); + $t = substr $t, 0, $i; + } + + if($t eq 'DATA'){ + $st =""; + my @tad = (); + foreach(split /~\n/,$v){ + my $d = $i = ""; + $_ =~ s/\\`/\\f/g;#We escape to form feed the escaped in file backtick. + foreach $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 = $consts{$d} + } + else{ + $v = $d; + } + $i .= "'$v',"; + } + else{ + #First is always ID a number and '#' signifies number. + if($t eq "\#") { + $i .= "$d," if $d; + } + else{ + $i .= "'$d',"; + } + } + } + $i =~ s/,$//; + push @tad, $i if $i; + } + my @existing = $data{$e}; + if(scalar(@existing)>1){ + @existing = @{$data{$e}}; + foreach $i(@existing){ + push @tad, $i if $i; + } + } + $data{$e} = [@tad] if scalar(@tad)>0; + } + } + next; } elsif($t eq 'TABLE'){ $st = "CREATE TABLE $e(\n$v\n);"; + $tables{$e} = $st; + next; } elsif($t eq 'INDEX'){ $st = "CREATE INDEX $v;"; @@ -132,29 +326,135 @@ try{ elsif($t eq 'VIEW'){ $st = "CREATE VIEW $v;"; } + elsif($t eq 'SQL'){ + $st = $v; + } + elsif($t eq 'MIGRATE'){ + my @m = $mig{$e}; + @m = () if(!@m); + push @m, $v; + $mig{$e} = [@m]; + } else{ #Register application statement as an anonymouse one. $anons{$e} = $v; next; } - push @sql, $st;#push application statement as SQL one. + push @sql, $st;#push as application statement. } } - # foreach my $prp (keys %consts){ - # print "[[",$prp, '=' , constant($prp), "]]\n"; - # } - # foreach my $prp (keys %anons){ - # print "{{",$prp, '=' , $anons{$prp}, "}}\n"; - # } - # foreach (@sql){ - # print "$_\n"; - # } - -} catch{ - die $_; +}catch{ + CNFParserException->throw(error=>$_, show_trace=>1); +}; +} + +sub isReservedWord { + my $word = shift; + switch($word){ + case "DATA" { return 1; } case "FILE" { return 1; } case "TABLE" { return 1; } case "INDEX" { return 1; } + case "VIEW" { return 1; } case "SQL" { return 1; } case "MIGRATE" { return 1; } + } + return 0; +} + +## +# Required to be called when using CNF with an database based storage. +# +sub initiDatabase { + my($self,$db,$st,$dbver)=@_; +#Check and set SYS_CNF_CONFIG +try{ + $st=$db->do("select count(*) from SYS_CNF_CONFIG;"); + $st = $db->prepare('SELECT VALUE FROM SYS_CNF_CONFIG WHERE NAME LIKE "$RELEASE_VER";'); + $st->execute(); + my @r = $st->fetchrow_array(); + $dbver = $r[0]; +} +catch{ + # $st = $db->prepare('SELECT VALUE FROM SYS_CNF_CONFIG WHERE NAME LIKE "$RELEASE_VER";'); + # $st->execute() or warn "Missing!"; + # my @r = $st->fetchrow_array(); + # return $r[0] if(@r); + + print "Missing SYS_CNF_CONFIG table, trying next to create it.\n"; + my $stmt = qq( + CREATE TABLE SYS_CNF_CONFIG ( + NAME VCHAR(16) NOT NULL, + VALUE VCHAR(28) NOT NULL, + DESCRIPTION VCHAR(128) + ); + ); + $db->do($stmt); + print "Created table: SYS_CNF_CONFIG \n"; + $st = $db->prepare('INSERT INTO SYS_CNF_CONFIG VALUES(?,?,?);'); + $db->begin_work(); + foreach my $key($self->constants()){ + my ($dsc,$val); + $val = $self->constant($key); + my @sp = split '`', $val; + if(scalar @sp>1){$val=$sp[0];$dsc=$sp[1];}else{$dsc=""} + $st->execute($key,$val,$dsc); + } + $db->commit(); + $dbver = $self -> constant('$RELEASE_VER'); +}; + +return $dbver; + } + +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; +} + +### +# Closes any buffered files and clears all data for the parser. +# TODO 2020-02-13 Under development. +# +sub END { + +undef %anons; +undef %consts; +undef %mig; +undef @sql; +undef @files; +undef %tables; +undef %data; + +} + ### CGI END 1;