```
2. CNF Instruction
1. Name and instruction signified is a tag of ```name<instruction>```, where the ```<>``` get stripped off.
- 2. Instruction can be any of the following.
- 1. **list** - converts value to an array.
- 2. **link** - links to an generic CNF repository items as value (by scalar reference).
- 3. **do** - if Do is enabled instantiated an perl object from the value and puts to be the value.
- 3. Value becomes converted according to instruction.
-
+ 1. Instruction can be any of the following.
+ 1. **list** - Converts value to an array.
+ 2. **link** - Links to an generic CNF repository items as value (by scalar reference).
+ 3. **do** - If DO_ENABLED repository instantiated an perl object from the value.
+ 4. **int** - Converts value to int and guaranteed number.
+ 5. **date** - Converts value to CNFDateTime object.
+ 6. **{some_package_name}** - Will try to create constant Perl object instance. If DO_ENABLED.
+ 2. Value becomes converted according to instruction.
## CNF Tag Formats
return \@stat;
}
-my $LOG_TRIM_SUB;
-my $LOG_TAIL_COUNT = 0;
-my $LOG_CURRENT_LINE_CNT = 0;
-my $LOG_FILE;
+my ($LOG_TRIM_SUB, $LOG_TAIL_COUNT, $LOG_CURRENT_LINE_CNT, $LOG_FILE, $LOG_DISABLED) = ("",0,0,"",0);
###
# The following is a typical example of a log settings property.
#
my $dir = $log{directory}; $dir = '.' if not $dir; $dir .= '/' if $dir !~ /\/$/;
my $log = $log{file}; $log .= '.log' if $log && $log !~ /\.log$/;
if(not $log){
- warn "Missing log file name in %LOG settings.";
+ if(!$LOG_DISABLED){
+ $LOG_DISABLED = 1;
+ warn "Missing log file name in %LOG settings, not logging an file.";
+ }
return $time . " " .$message
}
$LOG_TAIL_COUNT = $log{tail}; $LOG_TAIL_COUNT = 0 if not $LOG_TAIL_COUNT;
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 };
+ PLUGIN PROPERTY 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 toCNFDate{
+ my ($self, $v) = @_;
+ if ( $v && $v !~ /now|today/i ) {
+ $v =~ s/^\s//;
+ if ( $self->{STRICT} && $v !~ /^\d\d\d\d-\d\d-\d\d/ ) { $self->warn(
+"Invalid date format: $v expecting -> YYYY-MM-DD at start as possibility of DD-MM-YYYY or MM-DD-YYYY is ambiguous."
+ )}
+ $v = CNFDateTime::_toCNFDate( $v, $self->{'TZ'} );
+ }
+ else {
+ $v = CNFDateTime->now( { TZ => $self->{'TZ'} } );
+ }
+ return $v;
+}
+
sub END {
$LOG_TRIM_SUB->() if $LOG_TRIM_SUB;
undef %RESERVED_WORDS;
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.
+ - 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.
use feature qw(signatures);
use Scalar::Util qw(looks_like_number);
sub _matchType($type, $val, @rows) {
- if ($type == $CNF_DATA_TYPES{BOOL}){return 1}
+ if(not defined $type){return 0}
+ elsif($type == $CNF_DATA_TYPES{BOOL}){return 1}
elsif($type == $CNF_DATA_TYPES{INT} || $type == $CNF_DATA_TYPES{NUMBER} && looks_like_number($val)){return 1}
elsif($type == $CNF_DATA_TYPES{DATE}){
if($val=~/\d*\/\d*\/\d*/){return 1}
###
# Validates and returns a constant named value as part of this configs instance.
-# Returns undef if it doesn't exist, or empty and an exception
+# Returns undef if it doesn't exist, or empty and an exception
# if constant required argument is set for this repository.
###
sub const { my ($self,$c)=@_;
- return $self->{$c} if exists $self->{$c} && $self->{$c} !~ m/\s*/s ;
+ return $self->{$c} if exists $self->{$c};
if ($CONSTREQ){CNFParserException->throw("Required constants variable ' $c ' not defined in config!")}
- # Let's try to resolve. As old convention makes constants have a '$' prefix all upprercase.
+ # Let's try to resolve. As old convention makes constants have a '$' prefix all uppercase.
$c = '$'.$c;
return $self->{$c} if exists $self->{$c};
return undef;
}
}
$is_tagged = defined($t); $t = $e if not $is_tagged;
- if($t eq 'CONST' or $t eq 'CONSTANT'){#Single constant with multiline value;
+ if($t =~ /^CONST/){#Single constant with multiline value;
# It is NOT allowed to overwrite an constant like an anon variable.
if (not exists $self->{$e}){
$v =~ s/^\s//; $v = "" if not defined $v;
$self->doDATAInstructions_($e,$v)
}elsif($t eq 'DATE'){
my $isMetaConst = $v =~ s/$meta_const//s;
- if($v && $v !~ /now|today/i){
- $v =~ s/^\s//;
- if($self->{STRICT}&&$v!~/^\d\d\d\d-\d\d-\d\d/){
- $self-> warn("Invalid date format: $v expecting -> YYYY-MM-DD at start as possibility of DD-MM-YYYY or MM-DD-YYYY is ambiguous.")
- }
- $v = CNFDateTime::_toCNFDate($v,$self->{'TZ'});
- }else{
- $v = CNFDateTime->now({TZ=>$self->{'TZ'}});
- }
+ $v = $self->toCNFDate($v);
if($isMetaConst){
$self ->{$e} = $v
}else{
}
}
+
##
# 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.
my $v = $2;
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.
+ if($t =~ /^CONST/ or $isVar){ #constant multiple properties.
foreach my $line (split '\n', $v) {
my $isMETAConst = $line =~ s/$meta_const//s;
- next if $line =~ /^#/;
+ next if $line =~ /^#/ || ! $line;
$line =~ s/^\s+|\s+$//; # strip unwanted spaces
$line =~ s/\s*#.*$//; #strip comment for end of line.
$line =~ s/\s*>$//;
- $line =~ m/([\$\w<>]*)(\s*=\s*)(.*)/;
+ $line =~ m/([\$\w:<>]*)\s*([=:]{1})\s*(.*)/;
my $name = $1;
$line = $3;
if($isVar && not $isMETAConst){
$anechoic ->{$name} = $line if $line
}else{
- $name =~ s/^\$// if $isMETAConst;
+ $name =~ s/^\$//;
if($name =~ m/^<(.*)>$/){
$name = $1; $line = CNF::_isTrue($line);
+ }elsif($name =~ m/(.*)<(.*)>$/){
+ $name = $1; $line = $self->transitionValueFromInstruction($name, $2, 'CONST', $line)
}
# 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' previous exists.");
+ $self->warn("Skipped constant reassignment for '$name' previous exists.") if $line;
}
}
}
my $struct = $items[$idx];
my $type = ref($struct);
if(not $type){
- CNFParserException->throw("Illegal struct encountered->$struct") if $struct
+ CNFParserException->throw("Illegal struct encountered->$struct") if $struct
}else{
- my $priority = $struct-> {'^'};
- if($type eq 'CNFNode' && $priority > 0 && $priority < 5){
+ my $priority = $struct-> {'^'};
+ if( $type eq 'CNFNode' && $priority > 0 && $priority < 5){
$struct->validate() if $self->{ENABLE_WARNINGS};
- if($struct->name() eq ANN()){
- my $anode = $struct->process($self, $struct->script());
- foreach my $node($$anode->nodes()){
- $anechoic ->{$node->name()} = \$node;
- }
- }else{
+ if($struct->name() eq ANN()){
+ my $anode = $struct->process($self, $struct->script());
+ foreach my $node($$anode->nodes()){
+ $anechoic ->{$node->name()} = \$node;
+ }
+ }else{
$anechoic ->{$struct->name()} = $struct->process($self, $struct->script());
$self->log("Processed -> ".$struct->name()) if $self->{DEBUG}
- }
- $splice[@splice] = $idx - @splice;
+ }
+ $splice[@splice] = $idx - @splice;
}elsif($type eq 'InstructedProcessItem' && $priority > 0 && $priority < 5){
- my $t = $struct->{ins};
- if($t eq 'PLUGIN'){
- instructPlugin($self, $struct);
- $splice[@splice] = $idx - @splice;
- }
+ my $t = $struct->{ins};
+ if($t eq 'PLUGIN'){
+ instructPlugin($self, $struct);
+ $splice[@splice] = $idx - @splice;
+ }
}
}
}
}
$self->log("Processed -> ".$struct->name()) if $self->{DEBUG}
}elsif($type eq 'InstructedProcessItem'){
- instructPlugin($self, $struct);
+ my $ins = $struct->{ins};
+ if($ins eq 'PLUGIN'){
+ instructPlugin($self, $struct);
+ }
+ elsif($ins eq 'LINK'){
+ $self -> {$struct->{ele}} = $self -> obtainLink($struct->{val})
+ }
+ elsif($ins eq 'DO'){
+ my @args;
+ ## no critic BuiltinFunctions::ProhibitStringyEval
+ my $eva = eval($struct->{val}); $eva =~ s/\n$//g;
+ $self -> {$struct->{ele}} = $eva;
+ }
}else{warn "What is -> $struct type:$type ?"}
}
undef %instructs;
runPostParseProcessors($self) if $runProcessors;
return $self
}
+#
+
+sub transitionValueFromInstruction { my ($self, $ele, $instruction, $type, $val) = @_;
+ if($instruction eq 'int'){
+ return int($val)
+ }
+ elsif($instruction eq 'date'){
+ return $self->toCNFDate($val)
+ }
+ elsif($instruction eq 'list'){
+ return split(DELIMITER(), $val)
+ }elsif($instruction eq 'link'){ # i.e. <<val<link><CONST>*some_property*(,..)>>
+ $type = 'LINK'; $instruction = InstructedProcessItem->new($ele, $type, $val);
+ $instructs{$ele} = $instruction;
+ }elsif($instruction eq 'do'){ # i.e. <<instance<do><CONST>PerlPackageName(,..)>>
+ if($self->{'DO_ENABLED'}){
+ $type = 'DO'; $instruction = InstructedProcessItem->new($ele, $type, $val);
+ $instructs{$ele} = $instruction;
+ }else{
+ $self->warn("DO_ENABLED is set to false to do instruction -> ($ele, $instruction, $val) \n")
+ }
+ }elsif($self->{'DO_ENABLED'} && $instruction !~ /CNFParser$/){ #For security CNFParser not allowed to instantiate.
+ try{
+ ## no critic (RequireBarewordIncludes)
+ #require "$instruction.pm" if $instruction !~ /::/;
+ use Module::Load;
+ autoload $instruction;
+ $val =~ s/^\(\s*|\s*\)$//g;
+ if($val =~ /=>/){
+ my @args= split('=>', $val); my %args;
+ for(my $i=0; $i<$#args; $i+=2){
+ my $n = $args[$i]; $n =~ s/^\s*(['"])(.*)\g{1}$/$2/; $i++;
+ my $v = $args[$i]; $v =~ s/^\s*(['"])(.*)\g{1}$/$2/;
+ $args{$n} = $v
+ }
+ return $instruction->new(\%args);
+ }else{
+ return $instruction->new($val);
+ }
+ }catch($e){
+ $self->error("Failed to transition -> ($ele, $instruction, $val):$e");
+ }
+ }else{
+ $self->warn("DO_ENABLED is set to false to do instruction -> ($ele, $instruction, $val) \n")
+ }
+ return $val;
+}
#
sub includeContains{
my $path = shift;
# Instructor instance is global to the repository and can be registered to multiple different word instructions.
# Reasoning is that multiple and included CNF files can use own name for the instructor, but the instance is shared the same.
# Programmatically then the package code is used to provide additional settings, via private fields, if desired.
-# Rather then make new instances with own private fields. Instructor currently os not an constructor,
+# Rather then make new instances with own private fields. Instructor currently is not an constructor,
# also receives for peruse the actual repository in unprotected state as part of the parsing process.
# Hence the DO_ENABLE setting is required to be true, this method to be ever called.
#
###
# Register PostParseProcessor for further externally processing.
-# $package - Is the anonymouse package name.
+# $package - Is the anonymous package name.
# $body - Contains attribute(s) where function is the most required one.
###
sub registerProcessor {
for my $eid (0 .. $size){
my @row = @{$entry[$eid]};
if ($ID_Spec_Size){
- # If zero it is presumed ID field, corresponding to row number + 1 is our assumed autonumber.
+ # If zero it is presumed ID field, corresponding to row number + 1 is our assumed autonumbering.
if($row[0] == 0){
my $times = $padding - length($eid+1);
$row[0] = CNFMeta::_zero_prefix($times,$eid+1);
my $dts = $row[$i];
my $dt = UnixDate(ParseDateString($dts), "%Y-%m-%d %T");
if($dt){ $row[$i] = $dt; $mod = 1 }else{
- warn "Row in row[$i]='$dts' has imporper date format, contents: @row";
+ warn "Row in row[$i]='$dts' has improper date format, contents: @row";
}
}else{
my $v = $row[$i];
###
# Process config data directly from a raw data file containing no Perl CNF tags.
-# This is prefered way if your data is over, let's say 10 000 rows.
+# This is preferred way if your data is over, let's say 10 000 rows.
###
sub loadAndProcess ($self, $parser, $property) {
#!/usr/bin/env perl
-use warnings; use strict;
+use lib './tests';
+use parent 'TestBase';
use Syntax::Keyword::Try;
-use lib::relative ('.','../system/modules');
-
-
-require TestManager;
-require CNFParser;
my $test = TestManager -> new($0);
my $cnf;
#
###
$test->subcase("Test constance's instructed block.");
- my $samp = $cnf->{'$TITLE_HEADING'};
+ my $samp = $cnf->{TITLE_HEADING};
$test->evaluate('TITLE_HEADING', $samp, 'Example Application');
$samp = $cnf->{'$FRENCH_PARAGRAPH'};
$test->isDefined('$FRENCH_PARAGRAPH',$samp);
###
$test->case("Test mutability.");
try{
- $cnf->{'$IMMUTABLE'} = "change?";
+ $cnf->{IMMUTABLE} = "change?";
$test->failed('Variable should be a constant!');
}catch{
$test->subcase('Passed test is constance.');
}
try{
- $$cnf->{'$DYNAMIC_IMMUTABLE'} = "new";;
+ $$cnf->{DYNAMIC_IMMUTABLE} = "new";;
$test->failed('Variable should not be alloed added constance!');
}catch{
$test->subcase('Passed dynamic added constance not possible.');
###
- # Test DATA instuctions and Plugin powers of PCNF.
+ # Test DATA instructions and Plugin powers of PCNF.
###
die $test->failed() if not $cnf = CNFParser->new('./tests/example.cnf', {
DO_ENABLED=>1, # Disabled by default. Here we enable as we are using an plugin.
#!/usr/bin/env perl
-use warnings; use strict;
+use lib './tests';
+use parent 'TestBase';
use Syntax::Keyword::Try;
-use lib::relative ('.','../system/modules');
-require CNFParser;
-require TestManager;
my $test = TestManager -> new($0);
my $cnf;
try{
--- /dev/null
+#!/usr/bin/env perl
+use lib './tests';
+use parent 'TestBase';
+use Syntax::Keyword::Try;
+
+my $test = TestManager->new($0);
+my $cnf;
+my $base = TestBase::base_path();
+
+try {
+ ###
+ # Test instance creation.
+ ###
+ die $test->failed()
+ if not my $cnf =
+ CNFParser->new( undef, { DO_ENABLED => 1, DEBUG => 1 } )->parseString(
+ q(
+<<<CONST
+
+OBJ<TestInstructor> = (greeting => 'Hello World!')
+
+<BoolType> = yes
+TestDO<do>=`date`
+TestLink<link>=Property1
+now<date>:now
+TestINT<int>:1024
+
+
+>>>
+
+# Tree is an standard property that is an CNFNode object.
+# It is also possible to link to a plugin based property.
+<<Property<TREE>
+ attr1:1
+ attr1: 2
+ attr1: "3"
+>>
+
+<<Property2<PLUGIN>
+ package : DataProcessorPlugin
+ subroutine : process
+ property : employees
+>>
+
+<<employees$$<DATA>
+#ID`Full Name`@DOB~
+#`Taras Bulba`06/08/1983~
+22`Marianne Brunswick`19880101~
+>>
+<<employees$$<DATA>#`Johnny Von Latecomeclan`30-12-1999>>
+<<employees$$<DATA>#`Robert Plant`today>>
+
+)
+ );
+ $test->case( "Passed new instance CNFParser.", '1' );
+ $test->subcase( 'CNFParser->VERSION is ' . CNFParser->VERSION );
+
+ $test->case( "Test 'bool' transition type.", "2" );
+ my $testBoolType = $cnf->{BoolType};
+ my $refCur = ref $testBoolType;
+ $test->evaluate( '$testBoolType is 1?', $testBoolType, 1 );
+ $test->evaluate( '$testBoolType $ref is ?', $refCur, '' );
+
+ $test->case( "Test 'do' transition type.", "3" );
+ my $testDO = $cnf->{TestDO};
+ $refCur = ref $testDO;
+ $test->isDefined( '$testDO', $testDO );
+ $test->evaluate( '$testDO $ref is ?', $refCur, '' );
+
+ $test->case( "Test 'now' transition type.", "4" );
+ my $now = $cnf->{now};
+ $refCur = ref $now;
+ $test->isDefined( '$now', $now );
+ $test->evaluate( '$bow $ref is CNFDateTime?', $refCur, 'CNFDateTime' );
+
+ $test->case( "Test 'int' transition type.", "5" );
+ my $TestINT = $cnf->{TestINT};
+ $refCur = ref $TestINT;
+ $test->isDefined( '$TestINT', $TestINT );
+ $test->evaluate( '$bow $ref is CNFDateTime?', $refCur, 'int' );
+
+ $test->case( "Test Object' transition type.", "6" );
+ my $obj = $cnf->{OBJ};
+ $refCur = ref $obj;
+ $test->isDefined( '$obj', $obj );
+ $test->evaluate( '$bow $ref is CNFDateTime?', $refCur, 'TestInstructor' );
+ $test->evaluate( "\$obj->{greeting} == 'Hello World'?",
+ $obj->{greeting}, 'Hello World' );
+
+ $obj->process($cnf);
+
+ #
+ $test->done();
+ #
+
+
+}catch($e){
+ $test->dumpTermination($@);
+ $test->doneFailed();
+}
+
#!/usr/bin/env perl
-use warnings; use strict;
+use lib './tests';
+use parent 'TestBase';
use Syntax::Keyword::Try;
-use lib::relative ('.','../system/modules');
-
-require TestManager;
-require CNFParser;
-require ExtensionSamplePlugin;
my $test = TestManager -> new($0);
my $cnf;
$test->evaluate("Second table has 28 entries?", scalar( @{$data{$table[1]}} ), 28);
$test->evaluate("First table has 2 as first value?", $data{$table[0]}[0], 2);
$test->evaluate("Second table has 9 as first value?", $data{$table[1]}[0], 9);
+ try{
$test->isDefined("SOME_CONSTANCE",$cnf->{'$SOME_CONSTANCE'}); #<---- Deprecated old convention signifier prefixed uppercase as VAR ins. converts.
#----> to use $cnf->{SOME_CONSTANCE} in the code for the future.
-
+ die ('Deprecated old convention $const passed for CNF:'.$cnf->{CNF_VERSION})
+ }catch{
+ $test->isDefined("SOME_CONSTANCE",$cnf->{SOME_CONSTANCE});
+ }
#
$test->done();
lifelog.hopto.org / PerlCNF.git / commitdiff