From a1363ee4136a094388238f6f39a16aac4b3c78b5 Mon Sep 17 00:00:00 2001 From: Will Budic Date: Sat, 6 Jul 2024 09:40:52 +1000 Subject: [PATCH] sub. 3.3.1 Simple table relations implemented. --- system/modules/CNFMeta.pm | 52 ++- system/modules/CNFNode.pm | 2 +- system/modules/CNFParser.pm | 14 +- system/modules/CNFSQL.pm | 4 + system/modules/DataProcessorPlugin.pm | 2 +- .../modules/DataProcessorWorldCitiesPlugin.pm | 4 +- system/modules/DatabaseCentralPlugin.pm | 438 +++++++++++++----- system/modules/RSSFeedsPlugin.pm | 4 +- tests/dbSQLSetup.cnf | 2 +- tests/testExperimental.pl | 27 +- tests/testSQL.pl | 5 +- 11 files changed, 386 insertions(+), 168 deletions(-) diff --git a/system/modules/CNFMeta.pm b/system/modules/CNFMeta.pm index 57004f3..fb5722a 100644 --- a/system/modules/CNFMeta.pm +++ b/system/modules/CNFMeta.pm @@ -31,19 +31,18 @@ use constant PRIORITY => qr/(\s*\_+PRIORITY\_(\d+)\_+\s*)/o; ### # Globals, there is possible only four CNF data types. our %CNF_DATA_TYPES;# ^ # % @ $ (default) -our %TABLE_HEADER;#Array of six including sql insert I_BODY and I_val for updates. +our %TABLE_HEADER; +our %REL_IDX; BEGIN { my $cnt =0; foreach(qw{BOOL INT NUMBER DATE TEXT}){$CNF_DATA_TYPES{$_}=++$cnt} - $cnt =0; foreach(qw{COL_NAMES COL_TYPES ID_PRIMARY ID_TYPE T_BODY I_BODY I_VAL S_BODY}){$TABLE_HEADER{$_}=$cnt++} + $cnt =0; foreach(qw{COL_NAMES COL_TYPES RELATIONS ID_PRIMARY ID_TYPE T_BODY I_BODY I_VAL S_BODY DB }) + {$TABLE_HEADER{$_}=$cnt++} + $cnt =0; foreach(qw{IDX TABLE COLNAME}) {$REL_IDX{$_}=$cnt++}; } ### # Global setting for SQL TEXT to CNF _TEXT_ specified data type range. Programatically changable. our $SQL_CNF_VAR_LENGTH = 2024; -sub TABLE_HEADER { - return %TABLE_HEADER; -} - sub import { my $caller = caller; no strict "refs"; { @@ -70,6 +69,11 @@ sub import { } + our ($INT,$NUM,$BOOL,$TEXT,$DATE,$ID, $CNFID, $INDEX, $AUTO, $REL) = ( + _meta('INT'),_meta('NUM'),_meta('BOOL'),_meta('TEXT'),_meta('DATE'), + _meta('ID'),_meta('CNF_ID'),_meta('CNF_INDEX'),_meta('AUTO'),_meta('REL') + ); + ### # 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 provided. @@ -81,12 +85,8 @@ sub import { ### sub _metaTranslateDataHeader { my $isPostgreSQL = shift; - my @header; my @array = @_; my @spec; + my @header; my @array = @_; my @spec; my @rel; my ($idType,$body,$tins,$vins,$sels,$primary_set,$primary)=('NONE'); - my ($INT,$BOOL,$TEXT,$DATE,$ID, $CNFID, $INDEX, $AUTO) = ( - _meta('INT'),_meta('BOOL'),_meta('TEXT'),_meta('DATE'), - _meta('ID'),_meta('CNF_ID'),_meta('CNF_INDEX'),_meta('AUTO') - ); for my $i (0..$#array){ my $hdr = $array[$i]; if(not $primary_set and $hdr eq "ID" or $hdr =~ s/$AUTO/""/ei){ @@ -112,7 +112,7 @@ sub _metaTranslateDataHeader { $body .= "\"$hdr\" INTEGER CHECK (\"$hdr\">0),\n"; $tins .= $hdr . ',';$vins .= "?,"; $spec[$i] = $CNF_DATA_TYPES{INT}; - $idType = 'ID' + $primary = $idType = 'ID' }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. @@ -121,9 +121,24 @@ sub _metaTranslateDataHeader { $spec[$i] = $CNF_DATA_TYPES{TEXT}; $idType = 'CNF_INDEX' }elsif($hdr =~ s/$INT/""/ei){ + if($hdr =~ s/$REL/" "/ei){ + if($hdr =~ m/^(\w*)\s+\_*([0-9 a-z ]*)\_*(\w*?)\_*\s*$/ig){ + my $idName = $1; $hdr = $1 if $1; + my $relName = $2; + my $colName = $3; $colName = $idName if ! $colName; + $rel[@rel] = \[$i,$relName,$colName] if $relName + } + } + $spec[$i] = $CNF_DATA_TYPES{INT}; $body .= "\"$hdr\" INTEGER NOT NULL,\n"; $tins .= $hdr . ','; $vins .= "?,"; - $spec[$i] = $CNF_DATA_TYPES{INT}; + # if($hdr eq "ID" and not $primary_set and $i==0){ + # $primary = $idType = 'ID' + # } + }elsif($hdr =~ s/$NUM/""/ei){ + $body .= "\"$hdr\" NOT NULL,\n"; + $tins .= $hdr . ','; $vins .= "?,"; + $spec[$i] = $CNF_DATA_TYPES{NUM}; }elsif($hdr =~ s/$BOOL/''/ei){ if($isPostgreSQL){ $body .= "\"$hdr\" BOOLEAN NOT NULL,\n"; @@ -155,7 +170,8 @@ sub _metaTranslateDataHeader { $header[$TABLE_HEADER{I_BODY}] = \$tins; $header[$TABLE_HEADER{I_VAL}] = \$vins; $header[$TABLE_HEADER{S_BODY}] = \$sels; -return _MakeTableHeader(\@header,\@array,\@spec); + $header[$TABLE_HEADER{DB}] = $isPostgreSQL ? 'DB_POSTGRESQL' : 'DB_SQLITE'; +return _MakeTableHeader(\@header,\@array,\@spec,\@rel); } ### # Table Header builder routine required to be called when header is made or recreated. @@ -163,17 +179,19 @@ return _MakeTableHeader(\@header,\@array,\@spec); # It is drirect strict ordinal order referenced header array access. So before use this ubroutine must be called. # And when header is modified this subrotine also must be modified, otherwise fatal errors, which is good. # -sub _MakeTableHeader{ my ($header,$lbls,$spec) = @_; +sub _MakeTableHeader{ my ($header,$lbls,$spec,$rel) = @_; my @hdr = @$header; return \[ $lbls, $spec, + $rel, $hdr[$TABLE_HEADER{ID_PRIMARY}], $hdr[$TABLE_HEADER{ID_TYPE}], $hdr[$TABLE_HEADER{T_BODY}], $hdr[$TABLE_HEADER{I_BODY}], $hdr[$TABLE_HEADER{I_VAL}], - $hdr[$TABLE_HEADER{S_BODY}] + $hdr[$TABLE_HEADER{S_BODY}], + $hdr[$TABLE_HEADER{DB}], ]; } ### @@ -201,7 +219,7 @@ sub _deRefArray { sub _obtainColumnMap { my $table = shift; - my @header = CNFMeta::_deRefArray($$table->{header}); + my @header = CNFMeta::_deRefArray($$table->{header}); my @names = CNFMeta::_deRefArray($header[$TABLE_HEADER{COL_NAMES}]); my %ret; foreach my $i(0..$#names){ $ret{$names[$i]}=$i } diff --git a/system/modules/CNFNode.pm b/system/modules/CNFNode.pm index 1a87387..fa1f821 100644 --- a/system/modules/CNFNode.pm +++ b/system/modules/CNFNode.pm @@ -849,7 +849,7 @@ sub toScript { my $list = $self->{'@@'}; if($list){ foreach(@$list) { - $script .= "$tab <@@<$_>@@>\n" + $script .= toScript($_,$nested+2)."\n" } } my $nodes = $self->{'@$'}; diff --git a/system/modules/CNFParser.pm b/system/modules/CNFParser.pm index f3b6785..abfd833 100644 --- a/system/modules/CNFParser.pm +++ b/system/modules/CNFParser.pm @@ -3,7 +3,7 @@ ## package CNFParser; -use strict;use warnings;#use warnings::unused; +use strict;use warnings; no warnings 'once';#use warnings::unused; use Exception::Class ('CNFParserException'); use Syntax::Keyword::Try; use Hash::Util qw(lock_hash unlock_hash); @@ -699,15 +699,21 @@ sub doDATAInstructions_{ my ($self,$e,$v,$t,$d)=@_; } # By CNF convention ID is assumed to be a header if [0][0] contains it use _HAS_HEADER_ meta to demand that it is from the sccript. if(!@hdr && $isHeader || $a[0] eq 'ID'){#<--/ + my %MHDR = %CNFMeta::TABLE_HEADER; my $ptr = CNFMeta::_metaTranslateDataHeader($isPostgreSQL,@a); @hdr = @{$$ptr}; $isHeader = 0; if ($add_as_SQLTable) { - my %mh = &CNFMeta::TABLE_HEADER; - my $idtyp = $hdr[ $mh{ID_TYPE} ]; - my $tbody = $hdr[ $mh{T_BODY} ]; + my $idtyp = $hdr[ $MHDR{ID_TYPE} ]; + my $tbody = $hdr[ $MHDR{T_BODY} ]; $self->SQL()->createTable( $e, $tbody, $idtyp ) } + my @rel = CNFMeta::_deRefArray($hdr[$MHDR{RELATIONS}]); + if(@rel){ + foreach(@rel){ + $self->SQL()->addRelationships($e, $_); + } + } }elsif(scalar @a > 0){ $isHeader = 0; #autocorrect if _HAS_HEEADER_ header was accidently set. push @rows, [@a] diff --git a/system/modules/CNFSQL.pm b/system/modules/CNFSQL.pm index ed3fc01..9d96cd5 100644 --- a/system/modules/CNFSQL.pm +++ b/system/modules/CNFSQL.pm @@ -23,6 +23,7 @@ our %schema_tables; my $isPostgreSQL = 0; my $hasRecords = 0; my $TZ; +my %relationships; sub new { @@ -403,6 +404,9 @@ sub hasEntry{ my ($sel, $uid) = @_; return scalar(@r); } +sub addRelationships{my ($self,$table_name,$column_spec) = @_; $relationships{$table_name} = $column_spec} +sub getRelationships{return %relationships} + sub getPrimaryKeyColumnNameWherePart { my ($db,$tbl_stm) = @_; $tbl_stm = lc $tbl_stm; my $sql = $isPostgreSQL ? qq(SELECT a.attname, format_type(a.atttypid, a.atttypmod) AS data_type diff --git a/system/modules/DataProcessorPlugin.pm b/system/modules/DataProcessorPlugin.pm index 36efc4c..ac6a67a 100644 --- a/system/modules/DataProcessorPlugin.pm +++ b/system/modules/DataProcessorPlugin.pm @@ -45,7 +45,7 @@ try{ my ($mod,$warnc,$knock_out); my @header = CNFMeta::_deRefArray($$table->{header}); my @data = @{$$table->{data}}; - my %mhdr = CNFMeta::TABLE_HEADER(); + my %mhdr = %CNFMeta::TABLE_HEADER; my @hdr = CNFMeta::_deRefArray($header[$mhdr{COL_NAMES}]); my @spec = CNFMeta::_deRefArray($header[$mhdr{COL_TYPES}]); ### diff --git a/system/modules/DataProcessorWorldCitiesPlugin.pm b/system/modules/DataProcessorWorldCitiesPlugin.pm index e425a21..d644b57 100644 --- a/system/modules/DataProcessorWorldCitiesPlugin.pm +++ b/system/modules/DataProcessorWorldCitiesPlugin.pm @@ -1,7 +1,7 @@ package DataProcessorWorldCitiesPlugin; use strict; -use warnings; +use warnings; no warnings "once"; use feature qw(signatures); use Scalar::Util qw(looks_like_number); @@ -22,7 +22,7 @@ sub process ($self, $parser, $property) { my $table = $parser->data()->{$property}; my @header = @{$$table->{header}}; my @data = @{$$table->{data}}; - my %mhdr = CNFMeta::TABLE_HEADER(); + my %mhdr = %CNFMeta::TABLE_HEADER; my @hdr = CNFMeta::_deRefArray($header[$mhdr{COL_NAMES}]); my @spec = CNFMeta::_deRefArray($header[$mhdr{COL_TYPES}]); $parser->data()->{$property} = \{ diff --git a/system/modules/DatabaseCentralPlugin.pm b/system/modules/DatabaseCentralPlugin.pm index 96ad48e..9da079f 100644 --- a/system/modules/DatabaseCentralPlugin.pm +++ b/system/modules/DatabaseCentralPlugin.pm @@ -8,22 +8,30 @@ package DatabaseCentralPlugin; use strict; -use warnings; no warnings qw(experimental::signatures); +use warnings; no warnings qw(experimental::signatures); no warnings 'once'; use feature qw(signatures); use Time::Piece; use DBI; -use Exception::Class ('PluginException'); use Syntax::Keyword::Try; +use Exception::Class ('DBCentralPluginException'); use Clone qw(clone); use Date::Manip; +use Scalar::Util qw(looks_like_number); require CNFDateTime; -use constant VERSION => '1.0'; +use constant VERSION => '1.1'; my ($isSQLite,$dsn)=(0,()); -our %MHDR = CNFMeta::TABLE_HEADER(); +# Error brace strategy is needed for large systems to throw easy to debug possible exceptions. +# I know comes from brace for it not to get it, lol. Things I only come up with... +my %BRACE_FOR_ERRORS_CANDIDATE; +my $CURRENT_BRACE; +sub brace{ $CURRENT_BRACE? $BRACE_FOR_ERRORS_CANDIDATE{$CURRENT_BRACE} :""} +# This the meta static CNF DATA table header definittion. +our %MHDR = %CNFMeta::TABLE_HEADER; +# This is the unique TZ constance the parser (your script) can change at anytime. our $TZ = CNFDateTime::DEFAULT_TIME_ZONE(); sub new ($class, $plugin){ @@ -34,8 +42,8 @@ sub new ($class, $plugin){ return bless $settings, $class } -sub centralDBConnect($self,$user,$passw){ - my $datasource = $self->{DBI_SQL_SOURCE}; +sub centralDBConnect($self, $user, $passw){ + my $datasource = $self->{DBI_SQL_SOURCE}; die "DBI_SQL_SOURCE not set!" if !$datasource; my $dbname = $self->{DB}; die "DB not set!" if !$dbname; @@ -47,8 +55,8 @@ sub centralDBConnect($self,$user,$passw){ $dsn = $datasource .'dbname='.$dbname.($isSQLite?".db":""); return DBI->connect($dsn, $user, $passw, {AutoCommit => 1, RaiseError => 1, PrintError => 0, show_trace=>1}); } -sub executeStatements($self,$parser,$property){ +sub executeStatements($self,$parser,$property){ if($property eq '*'){ my $db; foreach my $key(%{$parser->SQL()}){ @@ -65,28 +73,28 @@ sub executePropertyStatement($self,$parser,$db,$key,$sql){ $db = centralDBConnect($self,undef,undef) if !$db; my $pst = $parser->SQL()->selectRecords($db,$sql); if(not $pst){ - $parser->error("Failed to prepare statment \$sql->".($sql?$sql:"undef")) + $parser->error("Failed to prepare statment \$sql->".($sql?$sql:"undef")) }else{ - my (@row,@data); - while(my @row = $pst->fetchrow_array()){ + my (@row,@data); + while(my @row = $pst->fetchrow_array()){ $data[@data] = \@row; - } - my @spec; - my @header =[]; - my $spec = $CNFSQL::tables_data_map{$key}; - if($spec){ + } + my @spec; + my @header =[]; + my $spec = $CNFSQL::tables_data_map{$key}; + if($spec){ my @cols = $spec =~ m/\s*([^`~]*)[`~]{0,1}\s*/gm;pop @cols;#<-regexp is special must pop last empty element. @header = CNFMeta::_metaTranslateDataHeader($isSQLite,@cols); - } - my $table = { - name=>$key, - header=>\@header, - auto=>0, - data=>\@data, - provider=> 'DatabaseCentralPlugin' + } + my $table = { + name=>$key, + header=>\@header, + auto=>0, + data=>\@data, + provider=> 'DatabaseCentralPlugin' - }; - $parser -> data() ->{$key} = \$table if @data; + }; + $parser -> data() ->{$key} = \$table if @data; } } @@ -97,7 +105,7 @@ try{ $pst->execute(); return $pst }catch{ - PluginException->throw(error=>"

Error->$@


DSN: $dsn sql:$sql
", show_trace=>1); + DBCentralPluginException->throw(error=>"

Error->$@


DSN: $dsn sql:$sql
"); } } ### @@ -107,26 +115,26 @@ sub main ($self, $parser, $property) { try{ $TZ = $parser->{TZ}; $db = centralDBConnect($self,undef,undef); - $DT_db_access_date = CNFDateTime->now($TZ); + $DT_db_access_date = CNFDateTime->now($TZ)->stamp(); if(not exists $parser -> {DB_CREATE_DATE} ){ $parser -> {DB_CREATE_DATE} = $DT_db_access_date; $parser -> {DB_SYNCH_DATE} = $DT_db_access_date; $parser -> {DB_UPDATE_DATE} = $DT_db_access_date; } my @update = ('DB_SYNCH_DATE'); - $schema = $parser -> SQL() -> initDatabase($db,1, {central_schema=>$property},@update); + $schema = $parser -> SQL() -> initDatabase($db,1, {central_schema=>$property},@update); %CNFConfig = %{$parser -> SQL() -> selectCNFConfigRecords($db)}; }catch{ - PluginException->throw(error=>"Error->$@ \nDSN: $dsn", show_trace=>1); + DBCentralPluginException->throw(error=>"Error->$@ \nDSN: $dsn"); } my $DT_db_synch_date = $CNFConfig{DB_SYNCH_DATE}; #This date can by synch run updates that are to the db a change. - $DT_db_synch_date = CNFDateTime::_toCNFDate (@$$DT_db_synch_date[0], $TZ) if($DT_db_synch_date); - my $DT_db_update_date = $CNFConfig{DB_UPDATE_DATE}; #This date is by inserts or updates last is been change. - $DT_db_update_date = CNFDateTime::_toCNFDate (@$$DT_db_update_date[0],$TZ) if($DT_db_update_date); + $DT_db_synch_date = CNFDateTime::_toCNFDate (@$$DT_db_synch_date[0], $TZ)->stamp() if($DT_db_synch_date); + my $DT_db_update_date = $CNFConfig{DB_UPDATE_DATE}; #This date is that inserts or updates lasthave been made. + $DT_db_update_date = CNFDateTime::_toCNFDate (@$$DT_db_update_date[0],$TZ)->stamp() if($DT_db_update_date); my $ref = ref($schema_node); - if($ref eq 'CNFNode'){ +if($ref eq 'CNFNode'){ my @NodesTable = @{$schema_node -> find('/table/*')}; warn "Not found any 'table/*' path elements for CNF property :". $schema_node->toPath() if not @NodesTable; ### @@ -139,14 +147,47 @@ sub main ($self, $parser, $property) { my $cnf_stat = $db_script_mod_date = $parser -> {CNF_STAT}; $db_script_mod_date = @$cnf_stat[9] if $cnf_stat } - $db_script_mod_date = CNFDateTime->now({epoch=>$db_script_mod_date, TZ=>$TZ}) if $db_script_mod_date; + $db_script_mod_date = CNFDateTime->now({epoch=>$db_script_mod_date, TZ=>$TZ})->stamp() if $db_script_mod_date; - foreach my $tbl(@NodesTable){ +# Sort creation of tables based on relationships. + my @NodesRel; + my %relationships = $parser->SQL()->getRelationships(); + foreach my $rel (keys %relationships){ + my $to = $relationships{$rel}; + if($to){ + my @r = @$$to; + $to = $r[$CNFMeta::REL_IDX{TABLE}]; + foreach my $tbl(@NodesTable){ + if($tbl->{property} eq $to){ + $NodesRel[@NodesRel] = $tbl; last; + } + } + } + foreach my $tbl(@NodesTable){ + if($tbl->{property} eq $rel){ + $NodesRel[@NodesRel] = $tbl; last; + } + } + foreach my $tbl(@NodesTable){ + if($tbl->{property} ne $rel && $tbl->{property} ne $to){ + $NodesRel[@NodesRel] = $tbl; + } + } + } + @NodesTable = @NodesRel if(@NodesRel); + foreach my $tbl(@NodesTable){ my $table = %$cnf_data{$tbl -> {property}}; # db_synch type return of 2 means table already exists and has data, if 1 than just was created and new, needs inserting. - if( $db_synch = _checkCreateTableSQLProcess($parser, \$schema, $db, $table_prefix, $db_synch, $tbl, $table) ){ - $db_synch = 3 if($db_script_mod_date && $db_synch == 2 && $db_script_mod_date->{epoch} > $DT_db_update_date->{epoch}); - if($tbl -> {property}){ + if( $db_synch = checkCreateTableSQLProcess($self, $parser, \$schema, $db, $table_prefix, $db_synch, $tbl, $table) ){ + $db_synch = 3 if($db_script_mod_date && $db_synch == 2 && $db_script_mod_date->{epoch} > $DT_db_update_date->{epoch}); + if($tbl -> {property}){ + # Find and update table name of any relationship using the actual sql table name. + foreach my $rel (values %relationships){ + my @r = @$$rel; + if($r[$CNFMeta::REL_IDX{TABLE}] eq $tbl -> {property}){ + @$$rel[$CNFMeta::REL_IDX{TABLE}] = $tbl -> {table_name}; + } + } # Has the check process resolved the header by any chance for us? my @header; if(my $ptr = $tbl -> {reset_header_issued}){ @@ -159,25 +200,31 @@ sub main ($self, $parser, $property) { die "Table data header not established for [".$tbl->toPath()."]->".$tbl -> {property}." length:".scalar @header . " CNF_CONTENT:" .$parser->{CNF_CONTENT}." has it been meta instructed or DataProcessorPlugin processed?"; } - my $dbsTblInsert = $db->prepare($tbl -> {sqlInsert}); - my $dbsTblSelect = $db->prepare($tbl -> {sqlSelect}); - my $dbsTblUpdate = $db->prepare($tbl -> {sqlUpdate}); - my $dbsSelectAnyOverID = $db->prepare($tbl -> {sqlSelectAnyOverID}); - my $dbsRecCount = $db->prepare($tbl -> {sqlRecCount}); + + my $dbsTblInsert = capturePrepare($self, $db, $tbl,'sqlInsert'); + my $dbsTblUpdate = capturePrepare($self, $db, $tbl,'sqlUpdate'); + my $dbsSelectAnyOverID = capturePrepare($self, $db, $tbl,'sqlSelectAnyOverID'); + my $dbsRecCount = capturePrepare($self, $db, $tbl,'sqlRecCount'); + my $dbsDeleteById = capturePrepare($self, $db, $tbl,'sqlDeleteById'); + my $dbsTblSelect = capturePrepare($self, $db, $tbl,'sqlSelect'); + my $sqlResetTableSeq = capturePrepare($self, $db, $tbl,'sqlResetTableSeq'); ### my @idx = (); + my $cols = $tbl->node('Cols'); my @map = CNFMeta::_deRefArray($tbl -> {_MAPPING_}); my @lbls = CNFMeta::_deRefArray($header[$MHDR{COL_NAMES}]); my @spec = CNFMeta::_deRefArray($header[$MHDR{COL_TYPES}]); + my @rel = CNFMeta::_deRefArray($header[$MHDR{RELATIONS}]); my $idT = CNFMeta::_deRefArray($header[$MHDR{ID_TYPE}]); + ### # Following is rare to see in code, my (wbudic) forward override conditional mapping algorithm, # as actual data @row length could be larger to the relative column map, of what we are inserting. # I know, it looks like a unlocking a magick riddle. It indexes based on the insert statment. # if(@lbls){ - MAP_INDEX: - for(my $i=0; $i<@lbls; $i++){ + MAP_INDEX: + for(my $i=0; $i<@lbls; $i++){ my $label = $lbls[$i]; my $JJJ=0; my $found =0; my @set; foreach (@map){ @@ -200,21 +247,22 @@ sub main ($self, $parser, $property) { if ($found==0 && $label ne 'ID'){ warn "[".$tbl -> toPath()."].[$label] for table -> ".$tbl->{name}." not found data header mapped label." } - } + } } ### - my @scrypt_synch_inserts; - my @data = @{$$table->{data}}; - $dbsRecCount->execute(); - if(!@data){ - $parser -> warn("Property \[".$tbl->toPath()."] linked data is empty, do you need that?") - }else{ - $db -> begin_work(); + my @scrypt_synch_inserts; + my @data = @{$$table->{data}}; $CURRENT_BRACE = 'sqlRecCount'; + $dbsRecCount->execute(); undef $CURRENT_BRACE; + if(!@data){ + $parser -> warn("Property \[".$tbl->toPath()."/property='".$tbl->{property}."'] linked data is empty, do you need that?") + }else{ + $db -> begin_work(); $CURRENT_BRACE = 'sqlRecCount'; try { - my $store_rec_cnt = $dbsRecCount->fetchrow_array(); + my $store_rec_cnt = $dbsRecCount->fetchrow_array(); undef $CURRENT_BRACE; for my $i (0 .. $#data){ - my @row = CNFMeta::_deRefArray($data[$i]); + my @row = CNFMeta::_deRefArray($data[$i]); @row = @{_CNFValTypeTypeRow(\@idx,\@spec,\@row)}; + @row = @{_resolveRelationships($db,$tbl,\@rel,\@row,\@idx,\@spec)} if CNFMeta::_deRefArray(@rel); $data[$i]=\@row; if($db_synch > 1){ # Now we need to synch from db to parsers data if anything was stored, @@ -224,7 +272,9 @@ sub main ($self, $parser, $property) { #$db->trace($db->parse_trace_flags("SQL|2")); my $synch_field_idx = grep { $db_synch_field eq $lbls[$_] } 0..$#lbls if($db_synch_field); - $dbsTblSelect->execute($row[0]) or die $db->errstr; + #@TODO colomn $row{0} is not guaranteed the primary id for the table, we just make it to be. + $CURRENT_BRACE ='sqlSelect'; + $dbsTblSelect->execute($row[0]) or die $db->errstr; undef $CURRENT_BRACE; if(my @sel = $dbsTblSelect->fetchrow_array()){ @sel = @{_CNFValTypeTypeRow(\@idx,\@spec,\@sel)}; DB_SYNCH: @@ -252,15 +302,15 @@ sub main ($self, $parser, $property) { } }else{ if($store_rec_cnt<$#data){ - my @insert = @{_CNFDataToSQLValues(\@idx,\@spec,\@row)}; - $dbsTblInsert->execute(@insert); + my @insert = @{_CNFDataToSQLValues(\@idx,\@spec,\@row)}; $CURRENT_BRACE ='sqlInsert'; + $dbsTblInsert->execute(@insert); undef $CURRENT_BRACE; } } next } }else{ - my @insert = @{_CNFDataToSQLValues(\@idx,\@spec,\@row)}; - $dbsTblInsert->execute(@insert); + my @insert = @{_CNFDataToSQLValues(\@idx,\@spec,\@row)};$CURRENT_BRACE ='sqlInsert'; + $dbsTblInsert->execute(@insert);undef $CURRENT_BRACE; } }#rof @data if($db_synch > 1){ @@ -268,50 +318,87 @@ sub main ($self, $parser, $property) { if($mod){ foreach (@scrypt_synch_inserts){ my @record = @{$_}; - my @reposition = findByIDInData($record[0],\@data); + my @reposition = _findByIDInData($record[0],\@data); $data[@data] = \@record; - my @insert = @{_CNFDataToSQLValues(\@idx,\@spec,\@reposition)}; - $dbsTblInsert->execute(@insert); + my @insert = @{_CNFDataToSQLValues(\@idx,\@spec,\@reposition)}; $CURRENT_BRACE ='sqlInsert'; + $dbsTblInsert->execute(@insert);undef $CURRENT_BRACE; } - }else{ - $dbsSelectAnyOverID->execute(scalar(@data)) or die $db->errstr; - while(my @sel = $dbsSelectAnyOverID->fetchrow_array()){ - @sel = @{_CNFValTypeTypeRow(\@idx,\@spec,\@sel)}; - $data[@data] = \@sel; - } } + # else{ + # @TODO This loads from store what is missing in scrypt of current @data, for now disabled, as we synch script with store. + # $dbsSelectAnyOverID->execute(scalar(@data)) or die $db->errstr; + # while(my @sel = $dbsSelectAnyOverID->fetchrow_array()){ + # @sel = @{_CNFValTypeTypeRow(\@idx,\@spec,\@sel)}; + # $data[@data] = \@sel; + # } + # } for my $i(0..$#data){ my @row = @{$data[$i]}; @row = @{_CNFDataToSQLValues(\@idx,\@spec,\@row)}; - push @row, $i+1; - $dbsTblUpdate->execute(@row); + push @row, $i+1; $CURRENT_BRACE ='sqlUpdate'; + $dbsTblUpdate->execute(@row);undef $CURRENT_BRACE; } $parser -> SQL() -> updateCNFConfigRecord($db,'DB_UPDATE_DATE',$db_script_mod_date->toDateTimeFormat()); } + $db->commit(); + if($db_synch == 3){ + $db -> begin_work(); + if($store_rec_cnt > @data){ + my $last = @{$data[@data-1]}[0]; my @sel; $CURRENT_BRACE ='sqlSelectAnyOverID'; + $dbsSelectAnyOverID->execute($last) or die $db->errstr;undef $CURRENT_BRACE; + while(@sel = $dbsSelectAnyOverID->fetchrow_array()){ + my $id = $sel[0]; $dbsDeleteById -> execute($id); + $parser -> log("DBCentralPlugin issued db_synch delete in [".$tbl->{table_name}."] for id($id)") + } + } + $sqlResetTableSeq->execute(); $parser -> SQL() -> updateCNFConfigRecord($db,'DB_SYNCH_DATE',$DT_db_synch_date->toDateTimeFormat()); + $db->commit(); } - $db->commit(); + $$table->{data} = \@data - }catch{ - $db->rollback(); - PluginException->throw( - error=>"DatabaseCentralPlugin\@Error->$@ (Property \[". - $tbl->toPath()."/name='".$tbl->{name}."']", show_trace=>0); - } + + }catch($e){ + $db->rollback(); + my $brace = brace(); my $tbln = $tbl->{name}; $brace = "braced for ($brace)" if $brace; + DBCentralPluginException->throw( + error=>"Error: $e (Property \[". + $tbl->toPath()."/name='$tbln'] $brace"); } } - } - }#rof } + } + }#rof +} $db->disconnect(); $parser->data()->{$property} = [$self]; } -sub findByIDInData($id, $data){ - foreach(@$data){ - my @row = CNFMeta::_deRefArray($_); - return @row if $row[0] == $id; - } + + +sub capturePrepare($self, $db, $tbl, $query){ +try{ + my $sql = $tbl -> {$query}; + my $st = $db->prepare($sql); + $BRACE_FOR_ERRORS_CANDIDATE{$query} = $sql; + return $st + +}catch($e){ + my $error = "Error with statment in ".$tbl->toPath()."/\@name=[".$tbl->{name}."]->{$query} == \'".$tbl -> {$query}."\' Error -> $e"; + DBCentralPluginException->throw(error=>$error) +} +} + +sub _findByIDInData($id, $data){ + foreach(@$data){ + my @row = CNFMeta::_deRefArray($_); + return @row if $row[0] == $id; + } +} + +sub _to_log_dump($parser, $table, @record){ + my $out = join "],[", @record; + $parser -> log("$table -> [$out]") } sub _CNFValTypeTypeRow($idx,$spec,$row) { @@ -325,13 +412,14 @@ sub _CNFValTypeTypeRow($idx,$spec,$row) { } elsif($spec_type==$CNFMeta::CNF_DATA_TYPES{DATE}){ my $dt; + next if ref($row_value) eq 'CNFDateTime'; if(lc($row_value) eq 'null' or !$row_value){ @$row[$c] = CNFDateTime::NULL(); next }else{ - $dt = UnixDate(ParseDateString($row_value), "%Y-%m-%d %T") + $dt = UnixDate(ParseDateString($row_value), "%Y-%m-%d %T") } if($dt){ - @$row[$c] = CNFDateTime::_toCNFDate ($dt, $TZ) + @$row[$c] = CNFDateTime::_toCNFDate ($dt, $TZ) }else{ warn "Row in row[$c]='$row_value' has imporper date format, contents: @$row"; } @@ -341,13 +429,34 @@ sub _CNFValTypeTypeRow($idx,$spec,$row) { $row_value = CNFParser::_isTrue($row_value); } elsif($spec_type==$CNFMeta::CNF_DATA_TYPES{INT}){ - $row_value = int($row_value) + $row_value = int($row_value) if looks_like_number($row_value) } @$row[$c] = $row_value; } } return \@$row; } +### +sub _resolveRelationships($db,$tbl,$rel,$row,$idx,$spec){ + foreach (@$rel){ + my @r = @$$_; + for(my $i=0; $i<@$idx; $i++){ + my $c = @$idx[$i]; + my $spec_type = @$spec[$c]; + my $row_value = @$row [$c]; + if($c == $r[0]){ + my $resolve = $r[1]; + my $field = $r[2]; + my $id = $r[3]; $id = "ID" if !$id; + my $sql = "SELECT $field FROM $resolve WHERE $id == $row_value;"; + my $dbs = $db -> prepare($sql); $dbs->execute(); + my @res = $dbs->fetchrow_array(); + @$row[$c] = $res[0] if @res; + } + } + } + return \@$row; +} sub _CNFDataToSQLValues($idx,$spec,$row) { my @insert; for(my $i=0; $i<@$idx; $i++){ @@ -362,8 +471,8 @@ sub _CNFDataToSQLValues($idx,$spec,$row) { } return \@insert; } - -sub _checkCreateTableSQLProcess ($parser, $schema, $db, $table_prefix, $db_synch, $node, $table_data) { +### +sub checkCreateTableSQLProcess ($self, $parser, $schema, $db, $table_prefix, $db_synch, $node, $table_data) { my ($name,$property,$cnf_property)=("","",""); $name = $node->{name} if $node->{name}; $property = $node->{property}; @@ -375,7 +484,8 @@ sub _checkCreateTableSQLProcess ($parser, $schema, $db, $table_prefix, $db_synch my $automap = CNFParser::_isTrue($node->{automap}); my $table_name = $table_prefix."__".$name; - if(_createSQLStatements($parser, $schema, $table_name, $table_data, $node)){ + if(createSQLStatements($self, $parser, $schema, $table_name, $table_data, $node)){ + try{ unless (exists $$schema->{$table_name}) { $db->do($node->{sqlCreateTable}); $parser->log("DB Issued: Created [$table_name] with -> $node->{sqlCreateTable}"); @@ -383,11 +493,15 @@ sub _checkCreateTableSQLProcess ($parser, $schema, $db, $table_prefix, $db_synch }elsif($db_synch){ return 2; } + }catch($e){ + DBCentralPluginException->throw(error=>"Error->$e ". + "Property -> ".$node->toPath()."/\@name=[".$node->{name}."]-> sqlCreateTable -> ".$node->{sqlCreateTable}."\n".$node->toScript()); + } } return 0; } - -sub _createSQLStatements($parser, $schema,$table_name, $table_data, $node){ +### +sub createSQLStatements($self, $parser, $schema,$table_name, $table_data, $node){ my $property = $node->{property}; my $cnf_property = $node->toPath(); @@ -396,6 +510,11 @@ sub _createSQLStatements($parser, $schema,$table_name, $table_data, $node){ my $sqlInsert = "INSERT INTO $table_name ("; my $sqlUpdate = "UPDATE $table_name "; my $sqlSelect = "SELECT "; + my %DATA_TYPE = %CNFMeta::CNF_DATA_TYPES; + + my $disable_sql_creation = $node->{disable_sql_creation}; + my $create_table = $node->{create_table}; + my $primary_key = ""; my @header = CNFMeta::_deRefArray($$table_data -> {header}); #CNFParser resolves and sets this initially @@ -419,37 +538,93 @@ sub _createSQLStatements($parser, $schema,$table_name, $table_data, $node){ } $node -> {reset_header_issued} = \@header; } - my @lbls = CNFMeta::_deRefArray($header[$MHDR{COL_NAMES}]); - my @spec = CNFMeta::_deRefArray($header[$MHDR{COL_TYPES}]); - my $IDName = ${$header[$MHDR{ID_PRIMARY}]}; - my $tbody = ${$header[$MHDR{T_BODY}]}; - my $tins = ${$header[$MHDR{I_BODY}]}; - my $vins = ${$header[$MHDR{I_VAL }]}; - my $sels = ${$header[$MHDR{S_BODY}]}; - my $upds = ""; - my @uflds = split(',',$tins); - foreach(@uflds){$upds .= "$_ = ?,"};$upds =~ s/,$//; - - #@TODO Maping could be some other column name than the first expected one beside of primary key type. + my $cols = $node->node('cols'); + my @lbls = CNFMeta::_deRefArray($header[$MHDR{COL_NAMES}]); + my @spec = CNFMeta::_deRefArray($header[$MHDR{COL_TYPES}]); + my $IDName = ${$header[$MHDR{ID_PRIMARY}]}; + my $tbody = ${$header[$MHDR{T_BODY}]}; + my $tins = ${$header[$MHDR{I_BODY}]}; + my $vins = ${$header[$MHDR{I_VAL }]}; + my $sels = ${$header[$MHDR{S_BODY}]}; + my $db = $header[$MHDR{DB}]; + my $isPostgresSQL = $db eq 'DB_POSTGRESQL' ? 1:0; + my $upds = ""; + my @uflds = split(',',$tins); + foreach(@uflds){$upds .= "$_ = ?,"}; + if($isSQLite && $isPostgresSQL){ # This is tricky logic as both can be false. + $parser->error(qq/Current DBI DataSource doesn't match scripted table instruction of $db + will revert to set driver [$self->{DBI_SQL_SOURCE} using SQLLite specs./); + $isPostgresSQL = 0; + } + # Do we keep the original CNF Data Header specs, + # or shall we become the creator with this scissors algorithm? + if($cols && CNFParser::_isTrue($create_table)){ my $body; my @fields; + # we have to redo them all as the mapping might not be to all actual fields going to the store. + # I know, crazy flexibility stuff, script can contain any number of columns but stired are only for this actual table. + # nother table then again can contain other columns from the same scripted data. + $tins = ""; $vins = ""; $upds = ""; $sels = ""; + + foreach (@{$cols->list()}){ + my($n,$v) = ($_->val() =~ m/\s*(.*?)\s+(.*?)\s*$/); + $fields[@fields] = $n; + if($v =~ /^auto/){ + if($isPostgresSQL){ + $v = "INT UNIQUE PRIMARY KEY GENERATED ALWAYS AS IDENTITY"; + $primary_key = $n; + }else{ + $v = "INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT"; + } + $IDName = $n; + $sels .= "$n,"; + $body .= "$n $v,\n"; + next; + + }elsif($v =~ s/^datetime//i){ + if( $isSQLite ){ + $v = "TEXT $v" + }else{ + $v = "TIMESTAMP $v"; + } + }elsif($v =~ s/^int\s//i){ + $v = "INTEGER $v"; + }elsif($v =~ s/^bool\s//i){ + $v = "BOOLEAN $v"; + } + $body .= "$n $v,\n"; + $sqlInsert .= "$n,"; + $sels .= "$n,"; + $vins .= "?,"; + $upds .= "$n = ?,"; + } + $sqlInsert =~ s/,$//; $body =~ s/,$//; $tbody = $body; + } + + #@TODO Mapping could be some other column name than the first expected one beside of primary key type. my $IDType = ${$header[$MHDR{ID_TYPE}]}; + if($IDType eq 'NONE' && !$IDName){ + foreach my$i(0..$#spec){ + if($spec[$i] == $DATA_TYPE{INT} || $spec[$i] == $DATA_TYPE{NUM}){ + $IDName = $lbls[$i]; last + } + } + $node->{sqlResetTableSeq} = "SELECT MAX($IDName)+1 FROM \"$table_name\"" + } if(!$tbody){ $parser->error("Error node property data link [$cnf_property]-> [$property] tbody not set."); return 0 }else{ - $sqlCreateTable ="$sqlCreateTable $tbody );"; - $node->{sqlCreateTable} = $sqlCreateTable; - $node->{sqlInsert} = "$sqlInsert $tins ) VALUES ( $vins );"; - $node->{sqlUpdate} = "$sqlUpdate SET $upds WHERE \"$IDName\" == ?;"; - $node->{sqlSelect} = "$sqlSelect $sels FROM $table_name WHERE \"$IDName\" == ?;"; - $node->{sqlSelectAnyOverID} = "$sqlSelect $sels FROM $table_name WHERE \"$IDName\" > ?;"; - $node->{sqlRecCount} = "SELECT count(*) FROM $table_name;"; - $node->{_MAPPING_} = \@lbls; + if(not CNFParser::_isTrue($disable_sql_creation)){ + $sqlCreateTable ="$sqlCreateTable $tbody );"; + $sqlCreateTable .= "PRIMARY KEY($primary_key)" if $primary_key; + generateAndSetSQLForNode($node,$table_name,$IDName,$sqlCreateTable,$sqlInsert,$sqlUpdate,$sqlSelect,$tins,$vins,$upds,$sels); + $node->{_MAPPING_} = \@lbls; + } return 1 } }else{ # Automation create sql from the schema node tree mapping not actual data header scripted. Not recomended approcah but here we go! my @columns = @{$node->find('cols/@@')}; die "[$cnf_property] -> $table_name Not found any 'cols/@@' path elements for CNF node script ->".$node->toScript if not @columns; - my($vins,$upds,$sels,$IDName); + my($tins,$vins,$upds,$sels,$IDName); if(!@header){ my @data = CNFMeta::_deRefArray($$table_data -> {data}); my $ptr = $data[0]; @@ -458,19 +633,18 @@ sub _createSQLStatements($parser, $schema,$table_name, $table_data, $node){ $node -> {reset_header_issued} = \@header; $parser->log("[$cnf_property] Processed Data Property.") } - my $primary_key; for(my $i=0;$i<@columns;$i++){ my $col = $columns[$i]; - my ($n,$v) = ($col->val() =~ /\s*(.*?)\s+(.*)/); + my ($n,$v) = ($col->val() =~ m/\s*(.*?)\s+(.*)\s*/); $sels .= "$n,"; if($v =~ /^auto/){ if( $isSQLite ){ - $v = "integer primary key autoincrement" + $v = "integer not null primary key autoincrement" }else{ $v = "INT UNIQUE GENERATED ALWAYS AS IDENTITY"; $primary_key = $n; } - $IDName =$n; + $IDName = $n; splice(@columns,$i--,1); }else{ if($v =~ /^datetime/){ @@ -482,26 +656,36 @@ sub _createSQLStatements($parser, $schema,$table_name, $table_data, $node){ }else{ $v =~ s/\s*$//; } - $sqlInsert .= "\"$n\","; $vins .= "?,"; - $upds .= "$n = \"?\","; + $tins .= "$n,"; $vins .= "?,"; + $upds .= "$n = ?,"; $columns[$i] = [$n,$v]; } $sqlCreateTable .= "$n $v,\n"; } $sqlCreateTable .= "PRIMARY KEY($primary_key)" if $primary_key; - $sqlCreateTable =~ s/,$//; $sqlInsert =~ s/,$//; $vins =~ s/,$//; $sels =~ s/,$//; $upds =~ s/,$//; - $node->{sqlCreateTable} = "$sqlCreateTable);"; - $node->{sqlInsert} = "$sqlInsert ) VALUES ($vins);"; - $node->{sqlUpdate} = "$sqlUpdate SET $upds WHERE \"$IDName\" == ?;"; - $node->{sqlSelect} = "$sqlSelect $sels FROM $table_name WHERE \"$IDName\" == ?;"; - $node->{sqlSelectAnyOverID} = "$sqlSelect $sels FROM $table_name WHERE \"$IDName\" > ?;"; - $node->{sqlRecCount} = "SELECT count(*) FROM $table_name;"; + $sqlCreateTable =~ s/,$/);/; $tins =~ s/,$//; + generateAndSetSQLForNode($node,$table_name,$IDName,$sqlCreateTable,$sqlInsert,$sqlUpdate,$sqlSelect,$tins,$vins,$upds,$sels); $node->{_MAPPING_} = \@columns; return 1; } return 0; } +sub generateAndSetSQLForNode($node,$table_name,$IDName,$sqlCreateTable,$sqlInsert,$sqlUpdate,$sqlSelect,$tins,$vins,$upds,$sels){ + $vins =~ s/,$//; $sels =~ s/,$//; $upds =~ s/,$//; + $node->{table_name} = $table_name; + $node->{sqlCreateTable} = $sqlCreateTable; + $node->{sqlInsert} = "$sqlInsert $tins ) VALUES ( $vins );"; + $node->{sqlRecCount} = "SELECT count(*) FROM $table_name;"; + if($IDName){ + $node->{sqlUpdate} = "$sqlUpdate SET $upds WHERE \"$IDName\" == ?;"; + $node->{sqlSelect} = "$sqlSelect $sels FROM $table_name WHERE \"$IDName\" == ?;"; + $node->{sqlSelectAnyOverID} = "$sqlSelect * FROM $table_name WHERE \"$IDName\" > ?;"; + $node->{sqlDeleteById} = "DELETE FROM $table_name WHERE \"$IDName\" == ?;"; + $node->{sqlResetTableSeq} = "UPDATE sqlite_sequence SET seq = (SELECT MAX($IDName) FROM $table_name) WHERE name=\"$table_name\"" if not exists $node->{sqlResetTableSeq} + } +} + sub getConfigFiles($self, $parser, $property){ my @dirs = $parser->property($property); my @lbls = ['ID','path','size','lines','modified']; my $cnt=0; #We have to mimic CNF type header entries. @@ -538,7 +722,7 @@ sub getConfigFiles($self, $parser, $property){ # And boom we have an dynamic and valid CNF data table. And with it you can be used to store and synch with now. $parser-> data() -> {$self->{element}} = \{ name=>$property, - header=>CNFMeta::_MakeTableHeader(\@header,\@lbls,\@spec), + header=>CNFMeta::_MakeTableHeader(\@header,\@lbls,\@spec,undef), auto=>0, data=>\@files } diff --git a/system/modules/RSSFeedsPlugin.pm b/system/modules/RSSFeedsPlugin.pm index 504bdaa..4684954 100644 --- a/system/modules/RSSFeedsPlugin.pm +++ b/system/modules/RSSFeedsPlugin.pm @@ -24,7 +24,7 @@ use constant VERSION => '1.1'; # require CNFDateTime; CNFParser::import(); -our %MHDR = CNFMeta::TABLE_HEADER(); +our %MHDR = %CNFMeta::TABLE_HEADER; our $TZ; sub new ($class, $plugin){ @@ -49,7 +49,7 @@ sub process ($self, $parser, $property) { my $cgi = $parser->const('CGI'); my @header = @{$$table->{header}}; my @data = @{$$table->{data}}; - my %mhdr = CNFMeta::TABLE_HEADER(); + my %mhdr = %CNFMeta::TABLE_HEADER; my @lbls = CNFMeta::_deRefArray($header[$mhdr{COL_NAMES}]); my @spec = CNFMeta::_deRefArray($header[$mhdr{COL_TYPES}]); diff --git a/tests/dbSQLSetup.cnf b/tests/dbSQLSetup.cnf index 1719f76..125cd22 100644 --- a/tests/dbSQLSetup.cnf +++ b/tests/dbSQLSetup.cnf @@ -109,7 +109,7 @@ ID`address`state`city`postcode`country~ ## # We shamelessly reuse same plugin package to nest another subrotine. -# With perl you use actually the same plugin code. Rewired into a new object, all this for you by PerlCNF. +# With perl you use actually the same plugin code. Rewired into a new object, all this enabled for you by PerlCNF. # Here we meta mark it HAS_PROCESSING_PRIORITY, as it builds data entries for new table being created. # For the DB_SCHEMA property plugin instruction above, that creates tables and populates them if missing in the database. ## diff --git a/tests/testExperimental.pl b/tests/testExperimental.pl index 0bfa2d8..d2ef227 100644 --- a/tests/testExperimental.pl +++ b/tests/testExperimental.pl @@ -42,15 +42,18 @@ try{ # $test -> nextCase(); # #### +my $fstat = CNFParser::_fetchScriptStat($0); + my $CNF_SCRIPT = qq{ < __SQL_TABLE__ _AUTONUMBER_ -ID _AUTO_`Name`Surname`MN`Address`City _INT_`Country _INT_`State _INT_~ +ID _AUTO_`Name`Surname`MN`Address`City _INT_ _REL__Cities_Name_`Country _INT_`State _INT_~ #`Mike`Hamiltion`` -Unit 1, 3 Dunlop st.`Sydney`1`1`1~ +Unit 1, 3 Dunlop st.`1`1`1`1~ >> < __SQL_TABLE__ _AUTONUMBER_ ID _INT_`Name _TEXT_~ +#`Sydney~ >> < ID _INT_`Name _TEXT_~ @@ -59,13 +62,13 @@ ID _INT_`Name _TEXT_~ //No it is not an joke, some SQL data require this as an table. Otherwise you hardcode views and joins. < __SQL_TABLE__ _AUTO_NUMBERED_ ID _INT_`Name _TEXT_~ -#`NSW~ -#`QLD~ -#`VIC~ -#`SA~ -#`TAS~ -#`WA~ -#`NT~ +# `NSW~ +# `QLD~ +# `VIC~ +# `SA~ +#` TAS~ +#` WA~ +# `NT~ >> < __SQL_TABLE__ _AUTONUMBER_ @@ -116,15 +119,19 @@ Hello World!`~ # So no commenting out of code in CNF, you just untag. < table_prefix: Test_Experimental + + [table[ property: Users automap: yes script_synch: true ]table] + [table[ property: Cities automap: true ]table] + [table[ property: Countries automap: on @@ -155,7 +162,7 @@ Hello World!`~ $test->case("Passed new instance CNFParser."); die $test->failed() - if not $cnf = CNFParser -> new(undef,{DO_ENABLED=>1,DEBUG=>1,'%LOG'=>{console=>1}}) -> + if not $cnf = CNFParser -> new(undef,{CNF_STAT => $fstat,DO_ENABLED=>1,DEBUG=>1,'%LOG'=>{console=>1}}) -> parse(undef,$CNF_SCRIPT); $test->case('Do we have have DB_SYNCH_DATE?'); diff --git a/tests/testSQL.pl b/tests/testSQL.pl index bb14562..407b80c 100644 --- a/tests/testSQL.pl +++ b/tests/testSQL.pl @@ -2,10 +2,11 @@ use warnings; use strict; use Syntax::Keyword::Try; use Benchmark; + use lib "tests"; use lib "system/modules"; - require TestManager; +require TestManager; require CNFParser; require CNFSQL; @@ -121,8 +122,6 @@ ID _INT_`NAME _TEXT_~ # $test->done(); # - - } catch{ $test -> dumpTermination($@); -- 2.34.1