From f279af735ee532e5894b2c4f6cca990044c4d713 Mon Sep 17 00:00:00 2001 From: Will Budic Date: Mon, 27 Nov 2023 12:21:12 +1100 Subject: [PATCH] New APP_SETTINGS instruction dev., version 3.1 changed. --- system/modules/CNFParser.pm | 43 ++++++--- system/modules/ClassicAppSettings.pm | 139 +++++++++++++++++++++++++++ tests/TestManager.pm | 2 +- tests/testAppSettings.pl | 88 +++++++++++++++++ tests/testCartesianProduct.pl | 16 +-- 5 files changed, 268 insertions(+), 20 deletions(-) create mode 100644 system/modules/ClassicAppSettings.pm create mode 100644 tests/testAppSettings.pl diff --git a/system/modules/CNFParser.pm b/system/modules/CNFParser.pm index 24ff05f..648e3ae 100644 --- a/system/modules/CNFParser.pm +++ b/system/modules/CNFParser.pm @@ -19,7 +19,7 @@ require CNFDateTime; ##no critic qw(Subroutines::RequireFinalReturn) ##no critic Perl::Critic::Policy::ControlStructures::ProhibitMutatingListFunctions -use constant VERSION => '3.0'; +use constant VERSION => '3.1'; our @files; our %lists; our %properties; @@ -43,7 +43,7 @@ our %ANONS; our %RESERVED_WORDS = map +($_, 1), qw{ CONST CONSTANT DATA DATE VARIABLE VAR FILE TABLE TREE INDEX - VIEW SQL MIGRATE DO LIB PROCESSOR + VIEW SQL MIGRATE DO LIB PROCESSOR APP_SETTINGS PLUGIN MACRO %LOG INCLUDE INSTRUCTOR }; sub isReservedWord { my ($self, $word)=@_; return $word ? $RESERVED_WORDS{$word} : undef } @@ -211,7 +211,7 @@ package PropertyValueStyle { } sub setPlugin{ my ($self, $obj) = @_; - $self->{plugin} = $obj; + $self->{plugin} = \$obj; } sub result { my ($self, $value) = @_; @@ -322,6 +322,7 @@ sub property { my($self, $name) = @_; if($ref eq 'ARRAY'){ return @{$ret} }elsif($ref eq 'PropertyValueStyle'){ + return ${$ret->{plugin}} if $ret->{instructor} eq 'APP_SETTINGS'; return $ret; } else{ @@ -543,6 +544,9 @@ sub doInstruction { my ($self,$e,$t,$v) = @_; elsif($t eq 'MACRO'){ $instructs{$e}=$v; } + elsif($t eq 'APP_SETTINGS'){ + $self->instructPlugin(InstructedDataItem -> new($e, 'APP_SETTINGS', $v)); + } elsif(exists $instructors{$t}){ if(not $instructors{$t}->instruct($e, $v) && $self->{STRICT}){ CNFParserException->throw("Instruction processing failed for '<<$e<$t>>'!\t"); @@ -939,7 +943,7 @@ sub parse { my ($self, $cnf_file, $content, $del_keys) = @_; }elsif($type eq 'InstructedDataItem'){ my $t = $struct->{ins}; if($t eq 'PLUGIN'){ - instructPlugin($self,$struct,$anons); + instructPlugin($self,$struct); } }else{warn "What is -> $struct type:$type ?"} } @@ -1003,15 +1007,15 @@ sub doInclude { my ($self, $prp_file) = @_; } sub instructPlugin { - my ($self, $struct, $anons) = @_; + my ($self, $struct) = @_; try{ - $properties{$struct->{'ele'}} = doPlugin($self, $struct, $anons); + $properties{$struct->{'ele'}} = doPlugin($self, $struct); $self->log("Plugin instructed ->". $struct->{'ele'}); }catch($e){ if($self->{STRICT}){ CNFParserException->throw(error=>$e); }else{ - $self->trace("Error @ Plugin -> ". $struct->toString() ." Error-> $@") + $self->trace("Error @ ".$struct->{ins}." -> ". $struct->toString() ." Error-> $@") } } } @@ -1146,13 +1150,24 @@ sub runPostParseProcessors { # @TODO Current Under development. ### sub doPlugin { - my ($self, $struct, $anons) = @_; - my ($elem, $script) = ($struct->{'ele'}, $struct->{'val'}); + my ($self, $struct) = @_; + my ($elem, $instructor, $script) = ($struct->{'ele'}, $struct-> {'ins'}, $struct->{'val'}); my $plugin = PropertyValueStyle->new($elem, $script); my $pck = $plugin->{package}; my $prp = $plugin->{property}; my $sub = $plugin->{subroutine}; - if($pck && $prp && $sub){ + if($instructor eq 'APP_SETTINGS'){ + $pck = 'ClassicAppSettings' if ! $pck; + ## no critic (RequireBarewordIncludes) + require "$pck.pm"; + my $obj = $pck -> new($plugin); + $sub = 'setup_with' if !$sub; + $obj-> $sub($self); + $plugin->setPlugin($obj); + $plugin->{instructor} = $instructor; + return $plugin; + } + elsif($pck && $prp && $sub){ ## no critic (RequireBarewordIncludes) require "$pck.pm"; #Properties are global, all plugins share a %Settings property if specifed, otherwise the default will be set from here only. @@ -1167,6 +1182,7 @@ sub doPlugin { my $res = $obj-> $sub($self, $prp); if($res){ $plugin->setPlugin($obj); + $plugin->{instructor} = $instructor; return $plugin; }else{ die "Sorry, the PLUGIN feature has not been Implemented Yet!" @@ -1458,4 +1474,9 @@ __END__ - 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. \ No newline at end of file + 3. Macro format specifications, have been aforementioned in this document. However make sure that your macro an constant also including the *$* signifier if desired. + - APP_SETTINGS - Provides external expected application settings defaults to the configuration. + 1. These are added and processed in place as they appear sequentionaly 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. diff --git a/system/modules/ClassicAppSettings.pm b/system/modules/ClassicAppSettings.pm new file mode 100644 index 0000000..2c82ef3 --- /dev/null +++ b/system/modules/ClassicAppSettings.pm @@ -0,0 +1,139 @@ +### +# This is a Classic CNF Application setup and wiring implementation. To provide proper syncing and priorities of setting, based on application defaults, +# script implemented change (release or user changed) and in user or application changed settings, that can now be now in a store, +# a rather retrieved change from there. +# +# Application provided app settings have also the benefit to rather keyword access properties directly avoiding method calls in the code. +# Further explanations is that this module, sets up in a standard way the settings from some application based or from package provided defaults. +# With by transition from what is in the script or not, comparing with expected defaults of settings. i.e. the app has English defaults for values. +# But we changed constants to a Japanese translation and feed it to the app, now not having to change the whole codebase. +# +# Or the config script might be missing a property setting, but the application package settings (this file package) +# will have the default. Use this module as a template to provide own settings for transitions or app requirements. +# +# Or only more commonly, employ the static ClassicAppSettings::_set_defaults method before initiating or calling the parser with a script. +# Containing a <...>> instruction. +# +# App Settings Transition Flow +# +# App.Defaults -> ClassicAppSettings -> CNF Merge Default -> ClassicAppSettings [<-> App.StoreSynch Resolve] optional -> App.Settings +# +# The app has a configuration file to obtain settings, if missing gets them from assigned code defaults. And if the settings have changed or stored. +# They get retrieved and replaced regardless what is in code default or in the configuration script. Is this complex? +# @TODO Also, what happens if script based settings are changed (by admin) and should have higher priority as from the old setting and/or the one in the store? +# This also happens when we have an new Application release having new settings or worse changed defaults, and an an upgrade shall merge. +# Can or does JSON do all this stuff too, that CNF is designed for? The answer is NO! +### +package ClassicAppSettings; + +use strict;use warnings; +use feature qw(signatures); + + +use constant VERSION => '1.0'; +our %global_defaults; +our $gl_clone_constances = 0; + +sub _set_defaults(%defaults){ + %global_defaults = %defaults +} +sub _set_clone_constances(){ + $gl_clone_constances = 1 +} + +## +# Called by the parser internally for the APP_Settings instruction. +## +sub new { + my ($class, $attrs, $self) = @_; + $self = {}; + if ($attrs){ + foreach(keys %$attrs) + { $self -> {$_} = $attrs -> {$_} if $_ !~ 'package|subroutine|property' } + } + bless $self, $class; +} + +my $global_config; +my %sync_state; + +sub global($this){ + return $$global_config +} + +sub expect($this){ + return \%global_defaults +} + +sub setConstant($this, $config, $CONSTANT){ + if($config->{$CONSTANT} && not $this ->{$CONSTANT}){ + $this ->{$CONSTANT} = $config->{$CONSTANT} + } +} +## +# Possible synch type status changes that can be detected. +# APP_SETTINGS_SYNC == 1 - Scripted setting not found as an default. +# APP_SETTINGS_SYNC == 2 - New Setting in script not declared. +# APP_SETTINGS_SYNC == 3 - Scripted setting changed from default. +# APP_SETTINGS_SYNC == 4 - Constance not programatically properly wired. +# APP_SETTINGS_SYNC == 5 - Constance synched in, can't be changed with store synch. +## +sub setup_with($this, $config, %constants){ + + $this->setConstant($config,'APP_NAME'); + $this->setConstant($config,'APP_VERSION'); + if($gl_clone_constances){ + foreach (%{$config}){ + if($_ =~ m/^[A-Z_0-9]+$/) {$this -> setConstant($config, $_); $sync_state{$_} = 5} + } + } + foreach my $key(keys %{$this}){ + if(not exists $global_defaults{$key}){ + $sync_state{$key} = 1; + } + } + foreach my $key(keys %global_defaults){ + if(not exists $this->{$key}){ + $this->{$key} = $global_defaults{$key}; + $sync_state{$key} = 2; + }else{ + my $v = $global_defaults{$key}; + if(not defined($this->{$key})){ + $sync_state{$key} = 4; + $this->{$key} = $global_defaults{$key}; + }elsif($this->{$key} ne $v){ + #Default changed in script + $sync_state{$key} = 3; + } + } + } + $global_config = \$config; +} +### +# Must be called by obtainer of this, that also handles the store. +# Just befoer the App uses the settings. +### +sub sync_with($this, %store){ + foreach my $key ( keys %store ) { + if(not exists $this->{$key}){ + $sync_state{$key} = 6; + }else{ + $sync_state{$key} = 7; + } + $this -> {$key} = $store{$key} + } + return \%sync_state; +} + +1; + +=begin copyright +Programed by : Will Budic +EContactHash : 990MWWLWM8C2MI8K (https://github.com/wbudic/EContactHash.md) +Source : https://github.com/wbudic/PerlCNF.git +Documentation : Specifications_For_CNF_ReadMe.md + This source file is copied and usually placed in a local directory, outside of its repository project. + So it could not be the actual or current version, can vary or has been modiefied for what ever purpose in another project. + Please leave source of origin in this file for future references. +Open Source Code License -> https://github.com/wbudic/PerlCNF/blob/master/ISC_License.md +=cut copyright \ No newline at end of file diff --git a/tests/TestManager.pm b/tests/TestManager.pm index 64c64b8..a0c5f59 100644 --- a/tests/TestManager.pm +++ b/tests/TestManager.pm @@ -133,7 +133,7 @@ sub evaluate { ### sub isDefined{ my ($self, $var, $val)=@_; - die "The var parameter is missing for val for TestManager->isDefined($var,$val)!" if not defined $val; + die "The expected parameters required failed TestManager->isDefined($var,$val)!" if @_ < 3; my $ref = ref($val); if (defined $val||$ref){ print GREEN."\t$stab YDef ".$self->{test_cnt} .'.'. ++$self->{sub_cnt}.": Passed -> Scalar [$var] is defined.\n" diff --git a/tests/testAppSettings.pl b/tests/testAppSettings.pl new file mode 100644 index 0000000..17ddc0e --- /dev/null +++ b/tests/testAppSettings.pl @@ -0,0 +1,88 @@ +use warnings; use strict; +use 5.36.0; +use lib "tests"; +use lib "/system/modules"; + +require TestManager; +require CNFParser; +require ClassicAppSettings; + +my $test = TestManager -> new($0); + +use Syntax::Keyword::Try; try { + + ### + $test->case("Test Parse CNF APP_SETTINGS instruction."); + + ClassicAppSettings::_set_defaults( + APP_NAME => "Test Example Application", + SAMPLE_SETTING_1 => "This will be overwritten", + NEW_SETTING => "New setting not expexted in configuration, APP_SETTINGS_SYNC == 1" + ); + my $parser = CNFParser -> new(undef,{DO_ENABLED=>0}); + $parser->parse(undef,qq( + <Sample App>> + < + package: ClassicAppSettings + config_dir: ~/.conig/MyApp + SAMPLE_SETTING_1 = "Overwritten" + SAMPLE_SETTING_2 = "This is should trigger APP_SETTINGS_SYNC == 2, script new entry is not expected," + >> + )); + + my $app_settings = $parser->property('CONFIG_SETTINGS'); + $test -> isDefined("CONFIG_SETTINGS",$app_settings); + + my $config = $app_settings->global(); + $test -> isDefined("\$config global",$config); + + my $app_name = $app_settings->{APP_NAME}; # First Priority if exists and not overwriten. + $test -> isDefined("\$app_name",$app_name); + + # + $test->nextCase(); + # + + $test->case("App settings values as per priorities by apperance in script or set as default."); + + # + my $gl__name = $app_settings->global()->{APP_NAME}; #A constant. Second Priority if first doesn't exists. + my $def_name = $app_settings->expect()->{APP_NAME}; #A default. Last Priority taking account. + + $test->evaluate('$app_name is "Test Example Application"?', $app_name,'Sample App'); + $test->evaluate('$gl__name is "Test Example Application"?', $gl__name,'Sample App'); + $test->evaluate('$def_name is "Test Example Application"?', $def_name,'Test Example Application'); + + my $gl_samp1e = $app_settings->expect()->{SAMPLE_SETTING_1}; + my $sample1 = $app_settings->{SAMPLE_SETTING_1}; + $test->evaluate('$gl_samp1e is "This will be overwritten"?', $gl_samp1e,'This will be overwritten'); + $test->evaluate('$sample1 is "Overwritten"?', $sample1,'Overwritten'); + + # + $test->nextCase(); + # + + $test->case("Test synching with storage."); + + # + my $synch_results = $app_settings -> sync_with( SAMPLE_SETTING_1=>'Changed by the App', + SAMPLE_SETTING_2=>'...', SAMPLE_SETTING_3=>'NEW' + ); + my $sync_sample = $app_settings->{SAMPLE_SETTING_1}; + $test->evaluate('$sync_sample is "Changed by the App"?', $sync_sample, 'Changed by the App'); + $test->subcase("Test synch results."); + $test->evaluate("SAMPLE_SETTING_3 added by synch?", $synch_results->{SAMPLE_SETTING_3}, 6); + $test->evaluate("SAMPLE_SETTING_1 changed by synch?", $synch_results->{SAMPLE_SETTING_1}, 7); + $test->evaluate("SAMPLE_SETTING_2 changed by synch?", $synch_results->{SAMPLE_SETTING_2}, 7); + + + # + $test->done(); + # +} +catch{ + $test -> dumpTermination($@); + $test->doneFailed(); +} + + diff --git a/tests/testCartesianProduct.pl b/tests/testCartesianProduct.pl index ebab942..b823515 100644 --- a/tests/testCartesianProduct.pl +++ b/tests/testCartesianProduct.pl @@ -1,5 +1,5 @@ #!/usr/bin/env perl -use warnings; use strict; +use warnings; use strict; use Syntax::Keyword::Try; use lib "tests"; @@ -14,8 +14,8 @@ my $test = TestManager -> new($0); my $cnf; try{ - - + + $test->case("Test Cartesian Product lib."); my @colors = ["red","blue","green"]; my @sizes = ["small","medium","large"]; @@ -24,7 +24,7 @@ try{ $test->evaluate("Result has ".(3*3*3)." combinations?",27,scalar @res); - # + # $test-> nextCase(); # @@ -42,12 +42,12 @@ try{ $test->evaluate("Copy item 1 is trmmed?","ibm.com",$copy[0]); $test->evaluate("Copy item 2 is trmmed?","x.com",$copy[1]); - # - $test->done(); + # + $test->done(); # } -catch { - $test -> dumpTermination($@); +catch { + $test -> dumpTermination($@); $test -> doneFailed(); } -- 2.34.1