From 609db079a4d3bde981e76f2c4259400220ccc974 Mon Sep 17 00:00:00 2001 From: Will Budic Date: Fri, 31 Oct 2025 10:06:29 +1100 Subject: [PATCH] Arguments instruction full imp. --- system/modules/CNFMeta.pm | 16 ++++-- system/modules/CNFParser.pm | 107 +++++++++++++++++++++++------------- system/modules/CNFSQL.pm | 33 +++++++---- 3 files changed, 101 insertions(+), 55 deletions(-) diff --git a/system/modules/CNFMeta.pm b/system/modules/CNFMeta.pm index 7c11d6f..1b699d8 100644 --- a/system/modules/CNFMeta.pm +++ b/system/modules/CNFMeta.pm @@ -19,7 +19,7 @@ use constant VERSION => "2.0"; sub _meta { my $constance = shift; if($constance){ - return qr/\s*\_+$constance\_+\s*/ + return qr/\s*\_+$constance\_+/ } $constance; } @@ -36,9 +36,9 @@ use constant ANN => '__ANN__'; # Will rise exceptions in outside older code not being updated to use new keys, or trying to modify them. use Hash::Util qw(lock_hash); ### -# Globals, there is possible only four CNF data types. +# Globals our %CNF_DATA_TYPES;# ^ # % @ $ (default) -# Mapping names of possible information in a CNF table header we avoid use to hardcode header by array index in vode! +# Mapping names of possible information in a CNF table header we avoid use to hardcode header by array index in code! our %TABLE_HEADER; # Relationship index mapping between tables. our %REL_IDX; @@ -162,8 +162,8 @@ sub _metaTranslateDataHeader { # $primary = $idType = 'ID' # } }elsif($hdr =~ s/$NUM/""/ei){ - $body .= "\"$hdr\" NOT NULL,\n"; - $spec[$i] = $CNF_DATA_TYPES{NUM}; + $body .= "\"$hdr\" numeric(6,2) NOT NULL,\n"; + $spec[$i] = $CNF_DATA_TYPES{NUMBER}; }elsif($hdr =~ s/$BOOL/''/ei){ # if($isPostgreSQL){ # $body .= "\"$hdr\" BOOLEAN NOT NULL CHECK (\"$hdr\" IN (0, 1)),\n"; @@ -176,7 +176,11 @@ sub _metaTranslateDataHeader { $body .= "\"$hdr\" TEXT NOT NULL CHECK (length(\"$hdr\")<=$SQL_CNF_VAR_LENGTH),\n"; $spec[$i] = $CNF_DATA_TYPES{TEXT}; }elsif($hdr =~ s/$DATE/""/ei){ - $body .= "\"$hdr\" TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP,\n"; + if($isSQLite){ + $body .= "\"$hdr\" TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP,\n"; + }else{ + $body .= "\"$hdr\" TIMESTAMP with time zone NOT NULL,\n"; + } $spec[$i] = $CNF_DATA_TYPES{DATE}; }else{ $body .= "\"$hdr\" TEXT NOT NULL,\n"; diff --git a/system/modules/CNFParser.pm b/system/modules/CNFParser.pm index fbb51dd..7bf5892 100644 --- a/system/modules/CNFParser.pm +++ b/system/modules/CNFParser.pm @@ -421,7 +421,7 @@ sub listProcessed { # 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. +# Requires an array of variables to be passed. sub addENVList { my ($self, @vars) = @_; if(@vars){ foreach my $var(@vars){ @@ -667,7 +667,7 @@ sub doInstruction { my ($self,$e,$t,$v,$is_tagged) = @_; } } sub localProjectConfigFile{ - my $self = shift; + my $self = shift; my ($project,$name) = ($self->{PROJECT_NAME},$0); if ( !$project ) { my $git = `git config --get remote.origin.url`; @@ -679,12 +679,12 @@ sub localProjectConfigFile{ $project .= "/" if $project !~ /\/$/ } $name =~ m/.*\/(.*)\..*$/ ; $self->{CNF_SCRIPT_NAME} = $1; #<- protected access. - $name = "$1.cnf"; + $name = "$1.cnf"; return $ENV{HOME}."/.config/$project$name" } sub doLoadDataFile { my ($self,$e,$v)=@_; my ($path,$cnf_file) = ("",$self->{CNF_CONTENT}); - $v=~s/\s+//g; + $v=~s/\s+//g; if($v=~m/^\*(.*)\*\/(.*)/){ my $link = $1; $v = $2; my $translation=""; @@ -697,7 +697,7 @@ sub doLoadDataFile { my ($self,$e,$v)=@_; $translation = $translation -> {$_}; } } - if ($v eq '$0'){ + if ($v eq '$0'){ $path = $self->localProjectConfigFile; if($translation){ $path = $translation .'/'.$self->{CNF_SCRIPT_NAME}.'.cnf'; @@ -706,18 +706,18 @@ sub doLoadDataFile { my ($self,$e,$v)=@_; $path = $translation .'/'. $v; } if( -e $path ){ - $self ->parse($path) + $self ->parse($path) }else{ $self->warn("Skipping conventional local config file is missing: $path") } } - elsif ($v eq '$0'){ + elsif ($v eq '$0'){ $path = $self->localProjectConfigFile; if( -e $path ){ - $self ->parse($path) + $self ->parse($path) }else{ $self->warn("Skipping conventional local config file is missing: $path") - } + } } elsif(! -e $v){ $path = substr($path, 0, rindex($cnf_file,'/')) .'/'.$v; @@ -737,14 +737,14 @@ sub loadDataFile { my ($self,$path,$e,$v,$i)=@_; my ($fh,$content); if($self->{XZ_STORE} && -f "$path.xz"){ - $fh = IO::Uncompress::UnXz->new("$path.xz") + $fh = IO::Uncompress::UnXz->new("$path.xz") or CNFParserException->throw(error=>"IO::Uncompress::UnXz failed: $UnXzError",show_trace=>$self->{STACK_TRACE}); $fh -> read(\$content); }else{ - open($fh, "<:perlio", $path ) + open($fh, "<:perlio", $path ) or CNFParserException->throw(error=>"Can't open $path -> $!",show_trace=>$self->{STACK_TRACE}); read $fh, $content, -s $fh; - } + } close $fh; # push @files, $path; @@ -818,7 +818,7 @@ $header~ #private sub doDATAInstructions_{ my ($self,$e,$v,$t,$d)=@_; my $add_as_SQLTable = $v =~ s/${meta('SQL_TABLE')}/""/sexi; #Turn property into an SQL Table on server, using the header. - my $isPostgreSQL = $v =~ s/${meta('SQL_PostgreSQL')}/""/sexi; + my $isPostgreSQL = $v =~ s/${meta('SQL_POSTGRES')}/""/sexi; my $isAutonumber = $v =~ s/${meta('AUTO_NUMBERED')}|${meta('AUTONUMBER')}/""/sexi; my $isConstant = $v =~ s/$meta_const//s; my $isHeader = $v =~ s/${meta('HAS_HEADER')}/""/sexi; @@ -856,8 +856,8 @@ sub doDATAInstructions_{ my ($self,$e,$v,$t,$d)=@_; if($d =~ /^\#(.*)/) {#First is usually ID a number and also '#' signifies number. $d = $1; if(!$d){ - if($isAutonumber){ - $d= ++$autonumber + if($isAutonumber){ + $d= ++$autonumber } else{$d=0} } } @@ -881,9 +881,9 @@ sub doDATAInstructions_{ my ($self,$e,$v,$t,$d)=@_; my $tmeta = $hdr[$MHDR{TABLE_META}]; #Activate autonumbering to be done HERE, based on column name or type. if($tbl_id_spec eq 'ID' && $idtyp ne 'CNF_ID'){ - $idtyp = "AUTOINCREMENT"; $isAutonumber = 1 + $idtyp = "AUTOINCREMENT"; $isAutonumber = 1 }elsif($idtyp eq 'CNF_ID'){ - $isAutonumber = 1 + $isAutonumber = 1 } $self->SQL()->createTable( $e, $tbody, $idtyp, $tmeta ) } @@ -916,7 +916,7 @@ sub parse { my ($self, $cnf_file, $content, $del_keys) = @_; if( not $content ){ $cnf_file = $cnf_file -> {path} if ref($cnf_file) eq 'CNFGlobalFile'; - open(my $fh, "<:perlio", $cnf_file ) + open(my $fh, "<:perlio", $cnf_file ) or CNFParserException->throw(error=>"Can't open $cnf_file -> $!",show_trace=>$self->{STACK_TRACE}); read $fh, $content, -s $fh; close $fh; @@ -938,14 +938,14 @@ sub parse { my ($self, $cnf_file, $content, $del_keys) = @_; } } my @src_hdr_ver = ($content =~ m/^\!(CNF\s*((\d+\.*\d*)\.*\d*))/m); - if(@src_hdr_ver){ + if(@src_hdr_ver){ if(VERSION =~ m/^(\d+\.\d+)/ && $src_hdr_ver[2] > $1){ $self->{CNF_VERSION} = $src_hdr_ver[0]; $self->warn( qq(CNF Script version is newer, are you using the script possible required parser version $src_hdr_ver[0]?)) }else{ $self->{CNF_VERSION} = VERSION; - } + } } my $spc = $content =~ /\n/ ? '(<{2,3}?)(<*.*?>*)(>{2,3})' : '\s*(<{2,3}?)(<*.*?>*?)(>{2,3})\s*$'; my @tags = ($content =~ m/$spc/gms); @@ -1052,7 +1052,7 @@ sub parse { my ($self, $cnf_file, $content, $del_keys) = @_; }else{ doInstruction($self,$e,$t,$v) } - + }elsif ($e eq '@'){#collection processing. my $isArray = $t=~ m/^@/; # if(!$v && $t =~ m/(.*)>(\s*.*\s*)/gms){ @@ -1124,8 +1124,8 @@ sub parse { my ($self, $cnf_file, $content, $del_keys) = @_; $properties{$t}=\%hsh; } next; - }elsif(!$t && $e && $v){ - $anechoic->{$e} = $v; + }elsif(!$t && $e && $v){ + $anechoic->{$e} = $v; }else{ doInstruction($self,$e,$t,$v) } @@ -1229,8 +1229,8 @@ sub parse { my ($self, $cnf_file, $content, $del_keys) = @_; $anechoic->{$struct->name()} = $struct->process($self, $struct->script()); } $self->log("Processed -> ".$struct->name()) if $self->{DEBUG} - }elsif($type eq 'InstructedProcessItem'){ - instructPlugin($self, $struct); + }elsif($type eq 'InstructedProcessItem'){ + instructPlugin($self, $struct); }else{warn "What is -> $struct type:$type ?"} } undef %instructs; @@ -1447,34 +1447,43 @@ package _ENV{ foreach my$sn(@ARGV){ my @tr = ($sn =~ /([-+])+(\w*)|[=](.*)/g); if(@tr){ - my $tt = $tr[0]; + my $tt = $tr[0]; my $tn = $tr[1]; - my $tv = $tr[2]; + my $tv = $tr[2]; if($tv){ $CLI_ARGS[@CLI_ARGS] = [$tt.$tn,$tv]; $lag = 0 }else{ - $CLI_ARGS[@CLI_ARGS] = [$tt.$tn,1]; $lag = 1 - } + if($tr[5]){ + $CLI_ARGS[@CLI_ARGS] = [$tt.$tn,$tr[5]]; $lag = 0 + }else{ + $CLI_ARGS[@CLI_ARGS] = [$tt.$tn,1]; $lag = 1 + } + } }elsif($lag){ $CLI_ARGS[@CLI_ARGS - 1] = [$CLI_ARGS[@CLI_ARGS - 1][0],$sn]; $lag = 0; }else{ $CLI_ARGS[@CLI_ARGS] = [$sn]; } - } + } return bless {},$class; } sub merge_args {my ($self, $script) = @_; my @args = _toArgumentsArray($script); if(@CLI_ARGS){ - for my $i(0..$#args){ - my $name = $args[$i]; - foreach my $carr(@CLI_ARGS){ + # Add any additional CLI arguments if not set. + foreach my $carr(@CLI_ARGS){ my $cname = @$carr[0]; - my $val = @$carr[1]; - if($cname eq $name){ - $args[$i] = [$name, $val] + my $cval = @$carr[1]; + my $set = 0; + for my $i(0..$#args){ + my $arg_name = $args[$i][0]; + if($cname eq $arg_name){ + $set = 1; + $args[$i] = [$cname, $cval] + } } - } + next if($set); + $args[@args] = [$cname, $cval] } } $parser->anon()->{CNFParser::APP_ARGS()} = \@args; @@ -1539,6 +1548,30 @@ sub doPlugin { $plugin->{instructor} = $instructor; $plugin->{subroutine} = 'merge_args'; $plugin->setPlugin($env); + + my $args = $self->anon(CNFParser::APP_ARGS()); + if($args){ #convert to CNF current arguments. + my @arg = @$args; + foreach my $next(@arg){ + my @next = @$next; + my $ne = $next[0]; + $ne =~ s/^-//; + if($next[1] ne "1"){ + my $found = 0; + foreach my $option(keys %$plugin){ + if(lc $option eq $ne){ + $found = 1; + $plugin->{$option} = $next[1] + } + } + if(!$found){ + $plugin->{$ne} = $next[1] + } + }else{ + $plugin->{$ne} = $next[1] if not exists $plugin->{$ne} + } + } + } return $plugin; } elsif($pck && $prp && $sub){ diff --git a/system/modules/CNFSQL.pm b/system/modules/CNFSQL.pm index d3c9887..c5b2a2a 100644 --- a/system/modules/CNFSQL.pm +++ b/system/modules/CNFSQL.pm @@ -155,7 +155,7 @@ try{ if($map && ($_= %$map{central_schema})){ # Out of scope us at the moment multiple schema management requested init. # So return what is in the database detected only. - $self->{parser}->log("CNFParser-> SQL: Initiated database for central_schema: $_\n"); + $self->{parser}->log("CNFSQL-> SQL: Initiated database for central_schema: $_\n"); return \%schema_tables; } @@ -166,8 +166,10 @@ try{ $self->{parser}->log("CNFParser SQL -> $st\n") if not $suppress_data_log; try { $db->do($st); - $self->{parser}->log("CNFParser-> Created table: $tbl_stm_name"); + $self->{parser}->log("CNFSQL-> Created table: $tbl_stm_name"); $do_not_auto_synch = 0; + $schema_tables{$tbl_stm_name}=1; + }catch{ die "Failed to create:\n$st\nError:$@" } @@ -187,7 +189,7 @@ try{ if(isPostgreSQL()){ $st = lc $tbl_stm_name; #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") if not $suppress_data_log; + $self->{parser}->log("CNFSQL-> $st", "\n") if not $suppress_data_log; $st = $db->prepare($st); }else{ $st = $db->prepare("pragma table_info($tbl_stm_name)"); @@ -208,10 +210,10 @@ try{ $self->{parser}->log("SQL -> $st"); $sqlSEL = $db -> prepare($st); }else{ - $prime_key = getPrimaryKeyColumnNameWherePart($db, $tbl_stm_name); - # $st= "SELECT * FROM $tbl_stm_name WHERE $prime_key"; - # $self->{parser}->log("SQL -> $st"); - # $sqlSEL = $db -> prepare($st); + $prime_key = getPrimaryKeyColumnNameWherePart($db, $tbl_stm_name); + if(!$prime_key){ + $self->{parser}->warn("CNFSQL-> Table is missing or has no Primary Key -> $tbl_stm_name"); + } my @r = $self->selectRecords($db,"select count(*) from $tbl_stm_name;")->fetchrow_array(); $hasRecords = $r[0] } @@ -246,7 +248,12 @@ try{ $prime_key = ${$header[$MHDR{ID_PRIMARY}]}; $id_type = ${$header[$MHDR{ID_TYPE}]}; $auto_increment=0; #$auto_increment=1 if $prime_key eq 'ID'; - $prime_key = "\"$prime_key\"," if $prime_key; + if (!$prime_key){ + $prime_key = ""; + $fld_where = "\"$header_cols[0]\" like ?" + }else{ + $prime_key = "\"$prime_key\","; + } for my $i(0 .. $#header_cols){ my $h = $header_cols[$i]; $hdr[@hdr]={'_'=>$h,'i'=>$i, 't'=>$header_types[$i]} @@ -423,7 +430,11 @@ transaction:{ undef %views; } catch{ - $sql_last = "Last SQL statement: $sql_last\n" if $sql_last; + if($sql_last){ + $sql_last = "Last SQL statement: $sql_last\n" + }else{ + $sql_last = "" + } CNFSQLException->throw(error=>$sql_last.$@, show_trace=>1); } return $self->{parser}-> const('$RELEASE_VER'); @@ -527,9 +538,7 @@ qq(PRAGMA table_info($tbl_stm_name);); 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_stm_name", show_trace=>1); -} + return 0 if !@r; if($isPostgreSQL){ return "\"$r[0]\"=?"; }else{ -- 2.34.1