--- /dev/null
+###
+# Base Class for the Configuration Network File Format.
+##
+package CNF; use strict; use warnings; no warnings 'once';
+use Exception::Class ('CNFParserException');
+use Syntax::Keyword::Try;
+use IO::Handle qw(flush);
+use IO::Compress::Xz qw($XzError);
+use IO::Uncompress::UnXz qw($UnXzError);
+use File::ReadBackwards;
+use File::Copy;
+
+# Do not remove the following no critic, no security or object issues possible.
+# We can use perls default behavior on return.
+##no critic qw(Subroutines::RequireFinalReturn)
+##no critic Perl::Critic::Policy::ControlStructures::ProhibitMutatingListFunctions
+
+
+
+###
+# Check a value if it is CNF boolean true.
+# For isFalse just negate check with not, as undef is considered false or 0.
+##
+sub _isTrue{
+ my $value = shift;
+ return 0 if(not $value);
+ return ($value =~ /1|true|yes|on|da/i) ? 1:0
+}
+
+my $LOG_TRIM_SUB;
+my $LOG_TAIL_COUNT = 0;
+my $LOG_CURRENT_LINE_CNT = 0;
+my $LOG_FILE;
+###
+# The following is a typical example of a log settings property.
+#
+# <<@<%LOG>
+# file = web_server.log
+# # Should it mirror to console too?
+# console = 1
+# # Disable/enable output to file at all?
+# enabled = 0
+# # Tail size cut, set to 0 if no tail cutting is desired.
+# tail = 1000
+# >>
+###
+sub log {
+ my $self = shift;
+ my $message = shift;
+ my $type = shift; $type = "" if !$type;
+ my $isWarning = $type eq 'WARNG';
+ my $attach = join @_; $message .= $attach if $attach;
+ my %log = $self -> property('%LOG');
+ my $time = CNFDateTime -> now(exists($self->{TZ})?{TZ=>$self->{TZ}}:undef) -> toTimestamp();
+
+ $message = "$type "."\e[33m".$message."\e[0m" if $isWarning;
+ $message = "" if not $message;
+ if($message =~ /^ERROR/ || ($isWarning && $self->{ENABLE_WARNINGS})){
+ $message =~ s/(\s+line\s)(\d+)\.*\s+/:$2\n/gm;
+ print $time . " " .$message;
+ }
+ elsif(%log && $log{console}){
+ print $time . " " .$message ."\n"
+ }
+ if(%log && _isTrue($log{enabled}) && $message){
+ if(!$LOG_FILE){
+ my $dir = $log{directory}; $dir = '.' if not $dir; $dir .= '/' if $dir !~ /\/$/;
+ my $log = $log{file};
+ $LOG_TAIL_COUNT = $log{tail}; $LOG_TAIL_COUNT = 0 if not $LOG_TAIL_COUNT;
+ $LOG_FILE = $dir.$log;
+ if(not $log){
+ warn "Missing log file name in %LOG settings.";
+ return $time . " " .$message
+ }
+ mkdir $dir if not ( -e $dir and -d $dir);
+ }
+ open (my $fh, ">>", $LOG_FILE) or die $!;
+ print $fh $time . " - " . $message ."\n";
+ close $fh;
+
+ if($LOG_TAIL_COUNT>0){
+#2025-11-10 Mayor rewrite since v.3.3.6 Previous version was buffering and sorting unnecessary, slowing performance.
+ if($LOG_CURRENT_LINE_CNT == 0 && !$LOG_TRIM_SUB){
+ #This section scope is only called once.
+ $fh = File::ReadBackwards->new($LOG_FILE) or die $!;
+ ++ $LOG_CURRENT_LINE_CNT while($fh->readline);
+ ###
+ $LOG_TRIM_SUB = sub {
+ ##
+ my $tmpFile = "/tmp/".$log{file};
+ my $fh = File::ReadBackwards->new($LOG_FILE) or die $!;
+ my $cut = $LOG_CURRENT_LINE_CNT - $LOG_TAIL_COUNT;
+ open (my $fhTemp, ">", $tmpFile) or die $!;
+ for (1..$cut){
+ print $fhTemp $fh->readline()
+ }
+ close $fhTemp;
+
+ open (my $fhLog, ">", $LOG_FILE) or die $!;
+ $fh = File::ReadBackwards->new($tmpFile) or die $!;
+ for (1..$cut){
+ my $line = $fh->readline();
+ print $fhLog $line;
+ }
+ close $fhLog;
+ $LOG_CURRENT_LINE_CNT = $cut;
+ unlink $tmpFile
+ }
+ }else{
+ $LOG_CURRENT_LINE_CNT++;
+ }
+ if($LOG_CURRENT_LINE_CNT > $LOG_TAIL_COUNT+1){
+ $LOG_TRIM_SUB->();
+ }
+ }
+ }
+ return $time . " " .$message;
+}
+
+# my $LOG_TRIM_SUB = sub {
+# my $fh = File::ReadBackwards->new($LOG_FILE) or die $!;
+# my @buffer; $buffer[@buffer] = $fh->readline() for (1..$LOG_CURRENT_LINE_CNT);
+# open (my $fhTemp, ">", "/tmp/".$log{file}) or die $!;
+# foreach my $line(reverse @buffer){print $fhTemp $line if $line}
+# close $fhTemp;
+# move("/tmp/".$log{file}, $LOG_FILE);
+# $LOG_CURRENT_LINE_CNT = int(scalar($fh->{lines}));
+# };
+
+our @files;
+
+##
+# Load CNF DATA file.
+##
+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")
+ or CNFParserException->throw(error=>"IO::Uncompress::UnXz failed: $UnXzError",show_trace=>$self->{STACK_TRACE});
+ $fh -> read(\$content);
+ }else{
+ 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;
+ my @tags = ($content =~ m/<<(\w*<(.*?).*?>>)/gs);
+ if(@tags>0){
+ foreach my $tag (@tags){
+ next if not $tag;
+ my @kv = split /</,$tag;
+ $e = $kv[0];
+ $tag = $kv[1];
+ $i = index $tag, "\n";
+ if($i==-1){
+ $tag = $v = substr $tag, 0, (rindex $tag, ">>");
+ }
+ else{
+ $v = substr $tag, $i+1, (rindex $tag, ">>")-($i+1);
+ $tag = substr $tag, 0, $i;
+ if($tag=~/^(DATA)>(.*)/){
+ $tag = $1;
+ $v = $2."\n".$v if $2
+ }
+ }
+ if($tag eq 'DATA'){
+ $self->doDATAInstructions_($e,$v)
+ }
+ }
+ }else{
+ $self->doDATAInstructions_($e,$content)
+ }
+
+ return \$content;
+}
+##
+# Write CNF DATA to file.
+##
+sub writeToDataFile { my ($self, $path, $property, $fh)=@_;
+
+ if($self->{XZ_STORE}){
+ $fh = IO::Compress::Xz->new($path.".xz") or CNFParserException->throw("IO::Compress::Xz failed: $XzError")
+ }else{
+ open($fh, ">", $path ) or CNFParserException->throw("Can't open $path -> $!");
+ }
+
+ try{
+ foreach my $key (sort keys %{$self->{'__DATA__'}}){
+ next if ($property && $property ne $key);
+ my $cnf_tagged = 0;
+ my $table_spec = ${$self->{__DATA__}{$key}};
+ my @head = @{$table_spec -> {header}};
+ my @data = @{$table_spec -> {data}};
+ foreach my $next(@data){
+ my $transition = join '`', @$next;
+ if(!$cnf_tagged){
+ $cnf_tagged = 1;
+ my $header = join '`', @{ $head[$CNFMeta::TABLE_HEADER{COL_NAMES}] };
+ $fh->print(
+qq(<<$key<DATA> __HAS_HEADER__
+$header~
+))
+ }
+ $fh->print ($transition, "~\n");
+ }
+ print $fh->print(">>\n") if($cnf_tagged)
+ }
+ }catch($e){
+ CNFParserException->throw(error=>$e);
+ }
+ flush($fh);
+ close($fh) or CNFParserException->throw("Can't close $path -> $!");
+}
+###
+# Resolve CNF file name and location based on Application Project level.
+##
+sub localProjectConfigFile{
+ my $self = shift;
+ my ($project,$name) = ($self->{PROJECT_NAME},$0);
+ if ( !$project ) {
+ my $git = `git config --get remote.origin.url`;
+ if ($git) {
+ $git =~ /.*\/(.*)\.*.*$/;
+ $project = "$1/";
+ }
+ }else{
+ $project .= "/" if $project !~ /\/$/
+ }
+ $name =~ m/.*\/(.*)\..*$/ ; $self->{CNF_SCRIPT_NAME} = $1; #<- protected access.
+ $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;
+ if($v=~m/^\*(.*)\*\/(.*)/){
+ my $link = $1; $v = $2;
+ my $translation="";
+ foreach(split '/', $link){
+ my $prp = $self->property($_);
+ if($prp){
+ $translation = $prp;
+ next
+ }elsif($translation){
+ $translation = $translation -> {$_};
+ }
+ }
+ if ($v eq '$0'){
+ $path = $self->localProjectConfigFile;
+ if($translation){
+ $path = $translation .'/'.$self->{CNF_SCRIPT_NAME}.'.cnf';
+ }
+ }elsif($translation){
+ $path = $translation .'/'. $v;
+ }
+ if( -e $path ){
+ $self ->parse($path)
+ }else{
+ $self->warn("Skipping conventional local config file is missing: $path")
+ }
+ }
+ elsif ($v eq '$0'){
+ $path = $self->localProjectConfigFile;
+ if( -e $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;
+ }else{
+ $path = $v;
+ }
+ foreach(@files){
+ return if $_ eq $path
+ }
+ return if not _isTrue($self->{AUTOLOAD_DATA_FILES});
+ #
+ $self->loadDataFile($path,$e)
+}
+
+
+
+###
+# CNF Instruction tag covered reserved words.
+# You can't use any of these as your own possible instruction implementation, unless in lower case.
+###
+our %RESERVED_WORDS = map +($_, 1), qw{ CONST CONSTANT DATA DATE VARIABLE VAR
+ FILE TABLE TREE INDEX ARGUMENTS
+ VIEW SQL MIGRATE DO LIB PROCESSOR APP_SETTINGS
+ PLUGIN MACRO %LOG INCLUDE INSTRUCTOR };
+###
+# Check if a name or tag is an CNF instruction.
+###
+sub isReservedWord { my $word = pop @_ ; return $word ? $RESERVED_WORDS{$word} : undef }
+
+sub END {
+$LOG_TRIM_SUB->() if $LOG_TRIM_SUB;
+undef %RESERVED_WORDS;
+undef @files;
+}
+
+__END__
+## Instructions & Reserved words
+
+ 1. Reserved words relate to instructions, that are specially treated, and interpreted by the parser to perform extra or specifically processing on the current value.
+ 2. Reserved instructions can't be used for future custom ones, and also not recommended tag or property names.
+ 3. Current Reserved words list is.
+ - CONST - Concentrated list of constants, or individually tagged name and its value.
+ - VARIABLE - Concentrated list of anons, or individually tagged name and its value.
+ - DATA - CNF scripted delimited data property, having uniform table data rows.
+ - DATE - Translate PerlCNF date representation to DateTime object. Returns now() on empty property value.
+ - FILE - CNF scripted delimited data property is in a separate file.
+ - %LOG - Log settings property, i.e. enabled=>1, console=>1.
+ - TABLE - SQL related.
+ - TREE - Property is a CNFNode tree containing multiple depth nested children nodes.
+ - INCLUDE - Include properties from another file to this repository.
+ - INDEX - SQL related.
+ - INSTRUCTOR - Provides custom new anonymous instruction.
+ - VIEW - SQL related.
+ - PLUGIN - Provides property type extension for the PerlCNF repository.
+ - PROCESSOR- Registered processor to be called once all parsing is done and repository secured.
+ - SQL - SQL related.
+ - MIGRATE - SQL related.
+ - MACRO
+ 1. Value is searched and replaced by a property value, outside the property scripted.
+ 2. Parsing abruptly stops if this abstract property specified is not found.
+ 3. Macro format specifications, have been aforementioned in this document. However make sure that your macro an constant also including the *$* signifier if desired.
+ - LIB - Loads dynamically an external Perl package via either path or as a standard module. This is ghosting normal 'use' and 'require' statements.
+ - DO - Performs a controlled out scope evaluation of an embedded Perl script or execution of a shell system command. This requires the DO_ENABLED constance to be set for the parser. Otherwise, is not enabled by default.
+ - APP_SETTINGS - Provides external expected application settings defaults to the configuration.
+ 1. These are added and processed in place as they appear sequentially in the script.
+ 1. It can be made possible in the future, to meta instruct to run APP_SETTING at the processing or post processing stages of CNF parsing.
+ 2. These can be externally added constance type CNF items if are found missing or not specified in current cnf file or from includes.
+ 3. An application usually obtains its settings object as an CNF property. Decoupling the CNF from handling this, making it abstract to the parser.
+ - ARGUMENTS - Special case command line options to CNF anons as default value/settings arguments and conversions.
# Main Parser for the Configuration Network File Format.
##
package CNFParser;
+use base 'CNF';
-use strict;use warnings; no warnings 'once';#use warnings::unused;
use Exception::Class ('CNFParserException');
use Syntax::Keyword::Try;
+use strict;use warnings; no warnings 'once';
use Hash::Util qw(lock_hash unlock_hash);
-use File::ReadBackwards;
-use File::Copy;
-use IO::Handle qw(flush);
-use IO::Compress::Xz qw($XzError);
-use IO::Uncompress::UnXz qw($UnXzError);
-require CNFMeta; CNFMeta::_import_into_this_package();
+
+use constant VERSION => '3.3.6';
+use constant APP_STS => 'APP_SETTINGS';
+use constant APP_ARGS => 'ARGUMENTS';
+
require CNFNode;
require CNFDateTime;
+require CNFMeta; CNFMeta::_import_into_this_package();
+## @see CNFMeta for explanation.
+sub _import_into_this_package {
+ my $parent = shift;
+ my $caller = caller; no strict "refs";
+ {
-# Do not remove the following no critic, no security or object issues possible.
-# We can use perls default behavior on return.
-##no critic qw(Subroutines::RequireFinalReturn)
-##no critic Perl::Critic::Policy::ControlStructures::ProhibitMutatingListFunctions
+ *{"${caller}::const"} = defined($parent)?sub{return const($parent,shift)}:\&const;
+ *{"${caller}::CNFProperty"} = \&property;
+ *{"${caller}::TRUE"} = 1;
+ *{"${caller}::FALSE"} = 0;
+
+ }
+ return 1;
+}
-use constant VERSION => '3.3.5';
-use constant APP_STS => 'APP_SETTINGS';
-use constant APP_ARGS => 'ARGUMENTS';
-our @files;
our %lists;
our %properties;
our %instructors;
my @includes; my $CUR_SCRIPT;
my %instructs;
my $IS_IN_INCLUDE_MODE;
- my $LOG_TRIM_SUB;
my $prc__last_pri = 6; #Process Last Processing Priority.
-###
-# CNF Instruction tag covered reserved words.
-# You can't use any of these as your own possible instruction implementation, unless in lower case.
-###
-our %RESERVED_WORDS = map +($_, 1), qw{ CONST CONSTANT DATA DATE VARIABLE VAR
- FILE TABLE TREE INDEX ARGUMENTS
- VIEW SQL MIGRATE DO LIB PROCESSOR APP_SETTINGS
- PLUGIN MACRO %LOG INCLUDE INSTRUCTOR };
-
-sub isReservedWord { my ($self, $word)=@_; return $word ? $RESERVED_WORDS{$word} : undef }
###
###
}
$CONSTREQ = $self->{CONSTANT_REQUIRED};
- if ($self->{'ANONS_ARE_PUBLIC'}){
+ if ($self->{ANONS_ARE_PUBLIC}){
$anechoic = \%ANONS;
}else{
#Not public, means are private to this object, that is, anons are not static.
$self->{XZ_STORE} = 0 if not exists $self->{XZ_STORE};
$self->{STACK_TRACE} = 1 if not exists $self->{STACK_TRACE}; # Enabled by default, to throw stack trace exceptions.
undef $SQL;
- bless $self, $class; $self -> parse($path, undef, $del_keys) if($path);
+ $self = bless $self, $class;
+ if($path){
+ $self -> parse($path, undef, $del_keys);
+ }else{
+ $self = lock_hash(%$self) if $self->{STRICT};
+ }
return $self;
}
#
sub blank{
return new(shift,undef,@_)
}
-## @see CNFMeta for explanation.
-sub _import_into_this_package {
- my $caller = caller; no strict "refs";
- {
- *{"${caller}::configDumpENV"} = \&dumpENV;
- *{"${caller}::anon"} = \&anon;
- *{"${caller}::SQL"} = \&SQL;
- *{"${caller}::isCNFTrue"} = \&_isTrue;
- }
- return 1;
-}
+
our $meta_has_priority = meta_has_priority();
our $meta_priority = meta_priority();
{"$property"="$val"}
__JSON
}
-###
-# Check a value if it is CNFPerl boolean true.
-# For isFalse just negate check with not, as undef is considered false or 0.
-##
-sub _isTrue{
- my $value = shift;
- return 0 if(not $value);
- return ($value =~ /1|true|yes|on|t|da/i) ? 1:0
-}
+
###
# Post parsing instructed special item objects. They have lower priority to Order of appearance and from CNFNodes.
##
# Validates if this repository contains expected and required constant.
# Returns 0 if an required constant has not been found in the provided list.
sub constantsRegistryCheck{ my ($self,@list)=@_;
- return 0 if !@list;
+ return 0 if !@list;
my $r = 1; my ($package, $filename, $line) = caller;
foreach(@list){
if(not exists $self->{$_}){
}
}
}
-sub localProjectConfigFile{
- my $self = shift;
- my ($project,$name) = ($self->{PROJECT_NAME},$0);
- if ( !$project ) {
- my $git = `git config --get remote.origin.url`;
- if ($git) {
- $git =~ /.*\/(.*)\.*.*$/;
- $project = "$1/";
- }
- }else{
- $project .= "/" if $project !~ /\/$/
- }
- $name =~ m/.*\/(.*)\..*$/ ; $self->{CNF_SCRIPT_NAME} = $1; #<- protected access.
- $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;
- if($v=~m/^\*(.*)\*\/(.*)/){
- my $link = $1; $v = $2;
- my $translation="";
- foreach(split '/', $link){
- my $prp = $self->property($_);
- if($prp){
- $translation = $prp;
- next
- }elsif($translation){
- $translation = $translation -> {$_};
- }
- }
- if ($v eq '$0'){
- $path = $self->localProjectConfigFile;
- if($translation){
- $path = $translation .'/'.$self->{CNF_SCRIPT_NAME}.'.cnf';
- }
- }elsif($translation){
- $path = $translation .'/'. $v;
- }
- if( -e $path ){
- $self ->parse($path)
- }else{
- $self->warn("Skipping conventional local config file is missing: $path")
- }
- }
- elsif ($v eq '$0'){
- $path = $self->localProjectConfigFile;
- if( -e $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;
- }else{
- $path = $v;
- }
- foreach(@files){
- return if $_ eq $path
- }
- return if not _isTrue($self->{AUTOLOAD_DATA_FILES});
- #
- $self->loadDataFile($path,$e)
-}
-
-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")
- or CNFParserException->throw(error=>"IO::Uncompress::UnXz failed: $UnXzError",show_trace=>$self->{STACK_TRACE});
- $fh -> read(\$content);
- }else{
- 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;
- my @tags = ($content =~ m/<<(\w*<(.*?).*?>>)/gs);
- if(@tags>0){
- foreach my $tag (@tags){
- next if not $tag;
- my @kv = split /</,$tag;
- $e = $kv[0];
- $tag = $kv[1];
- $i = index $tag, "\n";
- if($i==-1){
- $tag = $v = substr $tag, 0, (rindex $tag, ">>");
- }
- else{
- $v = substr $tag, $i+1, (rindex $tag, ">>")-($i+1);
- $tag = substr $tag, 0, $i;
- if($tag=~/^(DATA)>(.*)/){
- $tag = $1;
- $v = $2."\n".$v if $2
- }
- }
- if($tag eq 'DATA'){
- $self->doDATAInstructions_($e,$v)
- }
- }
- }else{
- $self->doDATAInstructions_($e,$content)
- }
-
- return \$content;
-}
-sub writeToDataFile { my ($self, $path, $property, $fh)=@_;
- if($self->{XZ_STORE}){
- $fh = IO::Compress::Xz->new($path.".xz") or CNFParserException->throw("IO::Compress::Xz failed: $XzError")
- }else{
- open($fh, ">", $path ) or CNFParserException->throw("Can't open $path -> $!");
- }
-
- try{
- foreach my $key (sort keys %{$self->{'__DATA__'}}){
- next if ($property && $property ne $key);
- my $cnf_tagged = 0;
- my $table_spec = ${$self->{__DATA__}{$key}};
- my @head = @{$table_spec -> {header}};
- my @data = @{$table_spec -> {data}};
- foreach my $next(@data){
- my $transition = join '`', @$next;
- if(!$cnf_tagged){
- $cnf_tagged = 1;
- my $header = join '`', @{ $head[$CNFMeta::TABLE_HEADER{COL_NAMES}] };
- $fh->print(
-qq(<<$key<DATA> __HAS_HEADER__
-$header~
-))
- }
- $fh->print ($transition, "~\n");
- }
- print $fh->print(">>\n") if($cnf_tagged)
- }
- }catch($e){
- CNFParserException->throw(error=>$e);
- }
- flush($fh);
- close($fh) or CNFParserException->throw("Can't close $path -> $!");
-}
##
# DATA instructions are not preserved as CNF script values as would be redundant and a waist.
# They by default are only META translated into tables for efficiency by data property name.
if($tag =~ m/^<\s*(\w*)\s+(.*?)>*$/gs){ # Original fastest and early format: <<<anon value>>>
my $t = $1;
my $v = $2;
- if(isReservedWord($self, $t)){
+ if($self->isReservedWord($t)){
my $isVar = ($t eq 'VARIABLE' || $t eq 'VAR');
if($t eq 'CONST' or $isVar or $t eq 'CONSTANT'){ #constant multiple properties.
foreach my $line (split '\n', $v) {
my $isMETAConst = $line =~ s/$meta_const//s;
next if $line =~ /^#/;
$line =~ s/^\s+|\s+$//; # strip unwanted spaces
- $line =~ s/\s*#.*$//; #strip comment for end of line.
+ $line =~ s/\s*#.*$//; #strip comment for end of line.
$line =~ s/\s*>$//;
$line =~ m/([\$\w]*)(\s*=\s*)(.*)/g;
-
+
my $name = $1;
- $line = $3;
- $line =~ s/^\s*(['"])(.*)\g{1}$/$2/ if $line;#strip quotes
+ $line = $3;
+ $line =~ s/^\s*(['"])(.*)\g{1}$/$2/ if $line;#strip quotes
$line = "" if not defined $line;
if(defined $name){
if($isVar && not $isMETAConst){
# It is NOT allowed to overwrite a constant, so check and issue warning.
if(not exists $self->{$name}){
$self->{$name} = $line;
- }else{
- $self->warn("Skipped constant reassignment for '$name'.");
+ }else{
+ $self->warn("Skipped constant reassignment for '$name'.");
}
}
}
$v =~ s/>$//m if defined($4) && $4 eq '<' or $6; #value has been crammed into an instruction?
}
- if(!$v && !$RESERVED_WORDS{$t}){
+ if(!$v && !$CNF::RESERVED_WORDS{$t}){
$v = $t; undef $t
}
$v =~ s/\\</</g; $v =~ s/\\>/>/g;# escaped brackets from v.2.8.
}
}elsif ($e eq '@'){#collection processing.
- my $isArray = $t=~ m/^@/;
- my $IsConstant = ($v =~ s/$meta_const/""/sexi);
+ my $isArray = $t=~ m/^@/;
+ my $IsConstant = ($v =~ s/$meta_const/""/sexi);
my @lst = ($isArray?split(DELIMITER(), $v):split('\n', $v));
my @props = map {
s/^\s+|\s+$//; # strip unwanted spaces
$_ ? $_ : undef # return the modified string
} @lst;
if($isArray){
- if($self->isReservedWord($t)){
- $self->warn("ERROR collection is trying to use a reserved property name -> $t.");
- next
+ if($CNF::RESERVED_WORDS{$t}){
+ $self->warn("ERROR collection is trying to use a reserved property name -> $t.");
+ next
}else{
my @arr=();
foreach (@props){
my %hsh;
my $macro = 0;
if(exists($properties{$t})){
- if($self->isReservedWord($t)){
+ if($CNF::RESERVED_WORDS{$t}){
$self->warn("Skipped a try to overwrite a reserved property -> $t.");
next
}else{
my $runProcessors = $self->{RUN_PROCESSORS} ? 1: 0;
$self = lock_hash(%$self);#Make repository finally immutable.
runPostParseProcessors($self) if $runProcessors;
- if ($LOG_TRIM_SUB){
- $LOG_TRIM_SUB->();
- undef $LOG_TRIM_SUB;
- }
return $self
}
#
try{
my $plugin = doPlugin($self, $struct);
$properties{$struct->{'ele'}} = $plugin;
- $self->log("Plugin instructed -> ".
+ $self->log("Plugin instructed -> ".
$plugin->{element}.'<'.$plugin->{package}.'>.'.$plugin->{subroutine}.'('.$plugin->{property}.')');
}catch($e){
if($self->{STRICT}){
my @next = @$next;
my $ne = $next[0];
$ne =~ s/^-//;
- if($next[1] ne "1"){
- my $found = 0;
+ if($next[1] ne "1"){
+ my $found = 0;
foreach my $option(keys %$plugin){
if(lc $option eq $ne){
$found = 1;
}
}
-###
-# The following is a typical example of an log settings property.
-#
-# <<@<%LOG>
-# file = web_server.log
-# # Should it mirror to console too?
-# console = 1
-# # Disable/enable output to file at all?
-# enabled = 0
-# # Tail size cut, set to 0 if no tail cutting is desired.
-# tail = 1000
-# >>
-###
-sub log {
- my $self = shift;
- my $message = shift;
- my $type = shift; $type = "" if !$type;
- my $isWarning = $type eq 'WARNG';
- my $attach = join @_; $message .= $attach if $attach;
- my %log = $self -> property('%LOG');
- my $time = CNFDateTime -> now(exists($self->{TZ})?{TZ=>$self->{TZ}}:undef) -> toTimestamp();
-
- $message = "$type "."\e[33m".$message."\e[0m" if $isWarning;
- $message = "" if not $message;
- if($message =~ /^ERROR/ || ($isWarning && $self->{ENABLE_WARNINGS})){
- $message =~ s/(\s+line\s)(\d+)\.*\s+/:$2\n/gm;
- print $time . " " .$message;
- }
- elsif(%log && $log{console}){
- print $time . " " .$message ."\n"
- }
- if(%log && _isTrue($log{enabled}) && $message){
- my $dir = $log{directory}; $dir = '.' if not $dir; $dir .= '/' if $dir !~ /\/$/;
- my $logfile = $log{file};
- my $tail_cnt = $log{tail};
- if($logfile){
- mkdir $dir if not ( -e $dir and -d $dir);
- open (my $fh, ">>", $dir.$logfile) or die $!;
- print $fh $time . " - " . $message ."\n";
- close $fh;
- if($tail_cnt>0 && !$LOG_TRIM_SUB){
- $fh = File::ReadBackwards->new($dir.$logfile) or die $!;
- if($fh->{lines}>$tail_cnt){
- $LOG_TRIM_SUB = sub {
- my $fh = File::ReadBackwards->new($dir.$logfile) or die $!;
- my @buffer; $buffer[@buffer] = $fh->readline() for (1..$tail_cnt);
- open (my $fhTemp, ">", "/tmp/$logfile") or die $!;
- foreach my $line(reverse @buffer){print $fhTemp $line if $line}
- close $fhTemp;
- move("/tmp/$logfile",$dir.$logfile)
- }
- }
- }
- }
- }
- return $time . " " .$message;
-}
sub error {
my $self = shift;
my $message = shift;
cluck $message
}
}
-sub dumpENV{
- foreach (keys(%ENV)){print $_,"=", "\'".$ENV{$_}."\'", "\n"}
-}
sub SQL {
my ($self,$e,$v) = @_;
}
return CNFParser->new($file);
}
-##
-# Return actual cnf file stats and state.
-##
-sub _fetchScriptStat{
- my $cnf_file = shift;
- my @stat = stat($cnf_file);
- #open(my $fh, "<:perlio", $cnf_file ) or die "Can't open $cnf_file -> $!"; close $fh;
- return \@stat;
-}
+
sub END {
-$LOG_TRIM_SUB->() if $LOG_TRIM_SUB;
undef %ANONS;
-undef @files;
undef %properties;
undef %lists;
undef %instructors;
Open Source Code License -> https://lifelog.hopto.org/gitweb/?p=PerlCNF.git;a=blob_plain;f=ISC_License.md;hb=HEAD
=cut copyright
1;
-__END__
-## Instructions & Reserved words
-
- 1. Reserved words relate to instructions, that are specially treated, and interpreted by the parser to perform extra or specifically processing on the current value.
- 2. Reserved instructions can't be used for future custom ones, and also not recommended tag or property names.
- 3. Current Reserved words list is.
- - CONST - Concentrated list of constants, or individually tagged name and its value.
- - VARIABLE - Concentrated list of anons, or individually tagged name and its value.
- - DATA - CNF scripted delimited data property, having uniform table data rows.
- - DATE - Translate PerlCNF date representation to DateTime object. Returns now() on empty property value.
- - FILE - CNF scripted delimited data property is in a separate file.
- - %LOG - Log settings property, i.e. enabled=>1, console=>1.
- - TABLE - SQL related.
- - TREE - Property is a CNFNode tree containing multiple depth nested children nodes.
- - INCLUDE - Include properties from another file to this repository.
- - INDEX - SQL related.
- - INSTRUCTOR - Provides custom new anonymous instruction.
- - VIEW - SQL related.
- - PLUGIN - Provides property type extension for the PerlCNF repository.
- - PROCESSOR- Registered processor to be called once all parsing is done and repository secured.
- - SQL - SQL related.
- - MIGRATE - SQL related.
- - MACRO
- 1. Value is searched and replaced by a property value, outside the property scripted.
- 2. Parsing abruptly stops if this abstract property specified is not found.
- 3. Macro format specifications, have been aforementioned in this document. However make sure that your macro an constant also including the *$* signifier if desired.
- - LIB - Loads dynamically an external Perl package via either path or as a standard module. This is ghosting normal 'use' and 'require' statements.
- - DO - Performs a controlled out scope evaluation of an embedded Perl script or execution of a shell system command. This requires the DO_ENABLED constance to be set for the parser. Otherwise, is not enabled by default.
- - APP_SETTINGS - Provides external expected application settings defaults to the configuration.
- 1. These are added and processed in place as they appear sequentially in the script.
- 1. It can be made possible in the future, to meta instruct to run APP_SETTING at the processing or post processing stages of CNF parsing.
- 2. These can be externally added constance type CNF items if are found missing or not specified in current cnf file or from includes.
- 3. An application usually obtains its settings object as an CNF property. Decoupling the CNF from handling this, making it abstract to the parser.
- - ARGUMENTS - Special case command line options to CNF anons as default value/settings arguments and conversions.
use DBI;
use Date::Manip;
-require CNFDateTime; require CNFMeta; require CNFSQL; CNFParser::_import_into_this_package();
+require CNFDateTime; require CNFMeta; require CNFSQL;
use constant VERSION => '1.1';
my ($IS_SQLITE,$DSN,$SUPPRESS_DATA_LOG)=(0,(),0);
die "DB not set!" if !$dbname;
$IS_SQLITE = $datasource =~ /DBI:SQLite/i; $dbname .= '.db' if $IS_SQLITE && $dbname !~ /.db$/;
$DSN = $datasource .'dbname='.$dbname;
- $SUPPRESS_DATA_LOG = isCNFTrue($suppress_data_log);
- $is_auto_commit = isCNFTrue($is_auto_commit);
- $is_raise_error = isCNFTrue($is_raise_error);
+ $SUPPRESS_DATA_LOG = CNF::_isTrue($suppress_data_log);
+ $is_auto_commit = CNF::_isTrue($is_auto_commit);
+ $is_raise_error = CNF::_isTrue($is_raise_error);
$self->{DSN} = $DSN;
$self->{db_name} = $dbname;
$self->{is_sqlite} = $IS_SQLITE;
###
my $self_data = $parser->data();
my $table_prefix = $schema_node->{table_prefix}; $table_prefix = $property if !$table_prefix;
- my $db_synch = CNFParser::_isTrue($schema_node->{DB_SYNCH_WITH_SCRIPT});
+ my $db_synch = CNF::_isTrue($schema_node->{DB_SYNCH_WITH_SCRIPT});
my $db_synch_field = $schema_node->{DB_SYNCH_FIELD};
my $db_script_mod_date = $schema_node->{DB_SCRIPT_UPDATE_DATE};
if(!$db_script_mod_date){
}else{
$row_value =~ s/^\s+|\s+$//gs if $spec_type!=$CNFMeta::CNF_DATA_TYPES{TEXT};
if($spec_type==$CNFMeta::CNF_DATA_TYPES{BOOL}){
- $row_value = CNFParser::_isTrue($row_value);
+ $row_value = CNF::_isTrue($row_value);
}
elsif($spec_type==$CNFMeta::CNF_DATA_TYPES{INT}){
$row_value = int($row_value) if looks_like_number($row_value)
if(!$name&&!$property){
$parser->error("[$self_property] Invalid table node encountered, neither name or property attribute specified!")
}
- my $automap = CNFParser::_isTrue($node->{automap});
+ my $automap = CNF::_isTrue($node->{automap});
my $table_name = $table_prefix."__".$name;
if(createSQLStatements($self, $parser, $schema, $table_name, $table_data, $node)){
my $property = $node->{property};
my $self_property = $node->toPath();
- my $automap = CNFParser::_isTrue($node->{automap});
+ my $automap = CNF::_isTrue($node->{automap});
my $sqlCreateTable = "CREATE TABLE $table_name (\n";
my $sqlInsert = "INSERT INTO $table_name (";
my $sqlUpdate = "UPDATE $table_name ";
my $create_table = $node->{create_table};
my $primary_key = "";
- my @header = CNFMeta::_deRefArray($$table_data -> {header}); #CNFParser resolves and sets this initially
+ my @header = CNFMeta::_deRefArray($$table_data -> {header}); #CNF resolves and sets this initially
if($automap){ #Column Mapping is based on the node specified schema, which can be different to scripted in order or req.
if(!@header){
}
# 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;
+ if($cols && CNF::_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.
$parser->error("Error node property data link [$self_property]-> [$property] tbody not set.");
return 0
}else{
- if(not CNFParser::_isTrue($disable_sql_creation)){
+ if(not CNF::_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);
lifelog.hopto.org / PerlCNF.git / commitdiff