]> lifelog.hopto.org Git - PerlCNF.git/commitdiff
Arguments instruction full imp.
authorWill Budic <redacted>
Thu, 30 Oct 2025 23:06:29 +0000 (10:06 +1100)
committerWill Budic <redacted>
Thu, 30 Oct 2025 23:06:29 +0000 (10:06 +1100)
system/modules/CNFMeta.pm
system/modules/CNFParser.pm
system/modules/CNFSQL.pm

index 7c11d6f663875761f91cac52b8999e0d43fb49b9..1b699d88ada4d7fb45de50bc128347a580fe6ca8 100644 (file)
@@ -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";
index fbb51dd760ae226d7d9fda0364d49a2a042abc9c..7bf58923afd708a237c238c775fea95072cc5021 100644 (file)
@@ -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){
index d3c98873e62a613e78c7e52068db06ffda79cfec..c5b2a2a1e56e40f99655c3d5895201f6bc2351b7 100644 (file)
@@ -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{