###
# 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";
{
}
+ 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.
###
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){
$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.
$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";
$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.
# 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}],
];
}
###
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 }
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){
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;
$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()}){
$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;
}
}
$pst->execute();
return $pst
}catch{
- PluginException->throw(error=>"<p>Error->$@</p><br><pre>DSN: $dsn sql:$sql</pre>", show_trace=>1);
+ DBCentralPluginException->throw(error=>"<p>Error->$@</p><br><pre>DSN: $dsn sql:$sql</pre>");
}
}
###
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;
###
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}){
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){
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,
#$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:
}
}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){
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) {
}
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";
}
$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++){
}
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};
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}");
}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();
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
}
$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];
$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/){
}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<DATA> type header entries.
# 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
}
lifelog.hopto.org / PerlCNF.git / commitdiff