From 016f0db4affe844880c29329945c70f6beea0770 Mon Sep 17 00:00:00 2001 From: Will Budic Date: Mon, 10 Nov 2025 17:50:31 +1100 Subject: [PATCH] CNF base package now made, logging revisited. --- system/modules/CNF.pm | 342 ++++++++++++++++++++++ system/modules/CNFParser.pm | 369 ++++-------------------- system/modules/CNFSQL.pm | 2 +- system/modules/DataProcessorPlugin.pm | 2 +- system/modules/DatabaseCentralPlugin.pm | 22 +- system/modules/RSSFeedsPlugin.pm | 5 +- 6 files changed, 406 insertions(+), 336 deletions(-) create mode 100644 system/modules/CNF.pm diff --git a/system/modules/CNF.pm b/system/modules/CNF.pm new file mode 100644 index 0000000..72214ee --- /dev/null +++ b/system/modules/CNF.pm @@ -0,0 +1,342 @@ +### +# 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 />"); + } + 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 __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. diff --git a/system/modules/CNFParser.pm b/system/modules/CNFParser.pm index 0f10333..87da235 100644 --- a/system/modules/CNFParser.pm +++ b/system/modules/CNFParser.pm @@ -2,30 +2,36 @@ # 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; @@ -42,19 +48,8 @@ our %ANONS; 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 } ### ### @@ -84,7 +79,7 @@ sub new { my ($class, $path, $attrs, $del_keys, $self) = @_; } $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. @@ -112,7 +107,12 @@ sub new { my ($class, $path, $attrs, $del_keys, $self) = @_; $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; } # @@ -123,17 +123,7 @@ sub new { my ($class, $path, $attrs, $del_keys, $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(); @@ -171,15 +161,7 @@ return <<__JSON {"$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. ## @@ -348,7 +330,7 @@ sub const { my ($self,$c)=@_; # 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->{$_}){ @@ -679,152 +661,7 @@ sub doInstruction { my ($self,$e,$t,$v,$is_tagged) = @_; } } } -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 />"); - } - 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 __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. @@ -974,20 +811,20 @@ sub parse { my ($self, $cnf_file, $content, $del_keys) = @_; if($tag =~ m/^<\s*(\w*)\s+(.*?)>*$/gs){ # Original fastest and early format: <<>> 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){ @@ -997,8 +834,8 @@ sub parse { my ($self, $cnf_file, $content, $del_keys) = @_; # 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'."); } } } @@ -1053,7 +890,7 @@ sub parse { my ($self, $cnf_file, $content, $del_keys) = @_; $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;# escaped brackets from v.2.8. @@ -1075,8 +912,8 @@ sub parse { my ($self, $cnf_file, $content, $del_keys) = @_; } }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 @@ -1085,9 +922,9 @@ sub parse { my ($self, $cnf_file, $content, $del_keys) = @_; $_ ? $_ : 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){ @@ -1099,7 +936,7 @@ sub parse { my ($self, $cnf_file, $content, $del_keys) = @_; 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{ @@ -1266,10 +1103,6 @@ sub parse { my ($self, $cnf_file, $content, $del_keys) = @_; 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 } # @@ -1316,7 +1149,7 @@ sub instructPlugin { 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}){ @@ -1577,8 +1410,8 @@ sub doPlugin { 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; @@ -1729,63 +1562,6 @@ sub writeOut { my ($self, $handle, $property) = @_; } } -### -# 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; @@ -1809,9 +1585,6 @@ sub trace { cluck $message } } -sub dumpENV{ - foreach (keys(%ENV)){print $_,"=", "\'".$ENV{$_}."\'", "\n"} -} sub SQL { my ($self,$e,$v) = @_; @@ -1880,20 +1653,10 @@ sub _configure{ } 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; @@ -1911,37 +1674,3 @@ Documentation : https://lifelog.hopto.org/gitweb/?p=PerlCNF.git;a=blob;f=Specifi 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. diff --git a/system/modules/CNFSQL.pm b/system/modules/CNFSQL.pm index 3a0c4ff..67ca696 100644 --- a/system/modules/CNFSQL.pm +++ b/system/modules/CNFSQL.pm @@ -388,7 +388,7 @@ transaction:{ } elsif ( $tbl_spec_info[$i][1] =~ m/^BOOL/ ) { - $v = CNFParser::_isTrue($v) ? 1 : 0; + $v = CNF::_isTrue($v) ? 1 : 0; } $ins[$i] = $v; } diff --git a/system/modules/DataProcessorPlugin.pm b/system/modules/DataProcessorPlugin.pm index 3938678..b5b631f 100644 --- a/system/modules/DataProcessorPlugin.pm +++ b/system/modules/DataProcessorPlugin.pm @@ -91,7 +91,7 @@ try{ }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}){ unless($row_value){ diff --git a/system/modules/DatabaseCentralPlugin.pm b/system/modules/DatabaseCentralPlugin.pm index 89c0256..1fea9fd 100644 --- a/system/modules/DatabaseCentralPlugin.pm +++ b/system/modules/DatabaseCentralPlugin.pm @@ -13,7 +13,7 @@ use Time::Piece; 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); @@ -48,9 +48,9 @@ sub centralDBConnect($self){ 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; @@ -169,7 +169,7 @@ if($ref eq 'CNFNode'){ ### 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){ @@ -455,7 +455,7 @@ sub _CNFValTypeTypeRow($idx,$spec,$row) { }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) @@ -510,7 +510,7 @@ sub checkCreateTableSQLProcess ($self, $parser, $schema, $db, $table_prefix, $db 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)){ @@ -534,7 +534,7 @@ sub 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 "; @@ -545,7 +545,7 @@ sub createSQLStatements($self, $parser, $schema,$table_name, $table_data, $node) 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){ @@ -591,7 +591,7 @@ sub createSQLStatements($self, $parser, $schema,$table_name, $table_data, $node) } # 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. @@ -644,7 +644,7 @@ sub createSQLStatements($self, $parser, $schema,$table_name, $table_data, $node) $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); diff --git a/system/modules/RSSFeedsPlugin.pm b/system/modules/RSSFeedsPlugin.pm index 2f7d06d..dde719e 100644 --- a/system/modules/RSSFeedsPlugin.pm +++ b/system/modules/RSSFeedsPlugin.pm @@ -18,8 +18,7 @@ use LWP::Simple; use Benchmark; -use constant VERSION => '1.1'; -CNFParser::_import_into_this_package(); +use constant VERSION => '1.2'; our %MHDR = %CNFMeta::TABLE_HEADER; our $TZ; @@ -32,7 +31,7 @@ sub new ($class, $plugin){ return bless $settings, $class } - +sub isCNFTrue{return CNF::_isTrue(shift)} ### # Process config data to contain expected fields. -- 2.34.1