###
# 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;
+package CNF;
+use v5.38;
+use strict; use warnings;
+use feature qw(try say);
+
use IO::Handle qw(flush);
use IO::Compress::Xz qw($XzError);
use IO::Uncompress::UnXz qw($UnXzError);
use File::Copy;
use Fcntl qw(:flock);
+use CNFExceptions qw(throw_exception);
+
+no warnings 'experimental::try'; no warnings 'once';
+
# 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)
}
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 .= '.log' if $log && $log !~ /\.log$/;
+ my ($dir,$file) = ("",$log{file},"");
+ if($log{directory} && $file !~ /\//){
+ $dir = $log{directory}; $dir = '.' if not $dir; $dir .= '/' if $dir !~ /\/$/;
+ }elsif($file){
+ $file =~ s/\..*$/.log/;
+ }
+ my $log = $file; $log = '.log' if $log && $log !~ /\.log$/;
if(not $log){
if(!$LOG_DISABLED){
$LOG_DISABLED = 1;
return $time . " " .$message
}
$LOG_TAIL_COUNT = $log{tail}; $LOG_TAIL_COUNT = 0 if not $LOG_TAIL_COUNT;
- $LOG_FILE = ensureDir($dir.$log);
+ $LOG_FILE = ensureDir($log);
}
if($LOG_FILE){ # now available do it
open (my $fh, ">>", $LOG_FILE) or die $! . '->'. $LOG_FILE;
$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 -> $!");
+ $fh->autoflush(1);
}
try{
my @data = @{$table_spec -> {data}};
foreach my $next(@data){
my $transition = join '`', CNFMeta::_deRefArray($next);
-if(!$cnf_tagged){
-my $header = join '`', @{ $head[$CNFMeta::TABLE_HEADER{COL_NAMES}] };
-my $meta_tag = '__HAS_HEADER__';
-$meta_tag.= ' __AUTO_NUMBERED__' if ${$head[$CNFMeta::TABLE_HEADER{ID_TYPE}]} eq 'AUTOINCREMENT';
-$cnf_tagged = 1;
-$fh->print(
-qq(<<$key<DATA> $meta_tag
-$header~
-))
-}
- $fh->print ($transition, "~\n");
+ if(!$cnf_tagged){
+ my $header = join '`', @{ $head[$CNFMeta::TABLE_HEADER{COL_NAMES}] };
+ my $meta_tag = '__HAS_HEADER__';
+ $meta_tag.= ' __AUTO_NUMBERED__' if ${$head[$CNFMeta::TABLE_HEADER{ID_TYPE}]} eq 'AUTOINCREMENT';
+ $cnf_tagged = 1;
+ print $fh qq(<<$key<DATA> $meta_tag\n$header~\n)
+ }
+ print $fh qq($transition~\n);
}
- $fh->print(">>\n") if($cnf_tagged)
+ print $fh qq(>>\n) if($cnf_tagged)
}
}catch($e){
- CNFParserException->throw(error=>$e);
+ throw_exception(error=>$e);
}
flush($fh);
- close($fh) or CNFParserException->throw("Can't close $path -> $!");
+ close($fh) or throw_exception("Can't close $path -> $!");
}
###
# Resolve CNF file name and location based on Application Project level.
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.
+
+
+--DEBUG USE--
+# try{
+# # test();
+# CNFParserException->throw(error=>"keks", show_trace=>1);# , origin=>'Server');
+# }catch($e){
+# die $e;
+# }
\ No newline at end of file
--- /dev/null
+package CNFExceptionBase;
+use parent 'Exception::Class::Base';
+use Data::Dumper;
+
+
+sub trace {
+ my $self = shift;
+ # Tell Devel::StackTrace to ignore the boring parts
+ return $self->{trace} ||= Devel::StackTrace->new(
+ ignore_package => [ 'Syntax::Keyword::Try' ],
+ );
+}
+
+
+sub full_message {
+ my $self = shift;
+ my $msg = $self->message;
+ my $stack = "";
+ my $tab = " "; # Your defined tab
+
+ # Iterate through each frame in the stack trace
+ if ($self->trace) {
+ foreach my $frame ($self->trace->frames) {
+
+ # 1. Get the list of arguments for this frame
+ my @args = $frame->args;
+ # 2. Stringify arguments (handling refs safely)
+ my $arg_str = join(', ', map {
+ defined $_ ? (ref $_ ? Data::Dumper->new([$_])->Indent(0)->Terse(1)->Dump : "'$_'") : 'undef'
+ } @args);
+
+ # 3. Update your format to include (arg1, arg2...)
+ my $package = $frame->package;
+ my $subroutine = $frame->subroutine;
+ my $filename = $frame->filename;
+ my $line = $frame->line;
+
+ # Apply your specific format
+ $stack .= "$tab $package@($line) $subroutine($arg_str) <- $filename:$line\n";
+ }
+ }
+
+ return "$msg\n$stack";
+}
+
+1;
\ No newline at end of file
--- /dev/null
+package CNFExceptions;
+use strict;
+use warnings;
+use CNFExceptionBase;
+use Exception::Class (
+ 'CNFParserException' => {
+ isa => 'CNFExceptionBase',
+ alias => 'throw_exception',
+ fields => ['origin']
+ },
+ 'CNF_SQL_Exception' => {
+ alias=>'throw_sql_exception',
+ fields => ['origin']
+ },
+ 'CNF_PluginException' => {
+ isa => 'CNFExceptionBase',
+ alias => 'throw_plugin_error',
+ fields => [ 'origin', 'original_info', 'type' ]
+ },
+ 'CNF_ErrorFatal' =>{
+ alias => 'throw_runtime_halt_exception',
+ fields => ['origin']
+ }
+);
+
+use parent 'Exporter';
+our @EXPORT_OK = qw( throw_exception throw_sql_exception throw_plugin_error throw_runtime_halt_exception );
+
+1;
sub new {
my($class, $path) =@_;
- my @stat = stat($path);
- my $self = {path=>$path, content_length => $stat[7], last_modified => $stat[9]};
+ my @stat = stat($path); $path =~ /\.(\w+)$/;
+ my $extension = $1;
+ my $self = {path=>$path, extension=> $extension, content_length => $stat[7], last_modified => $stat[9]};
bless $self, $class;
return $self;
}
-sub content($self) {
+sub content($self) { #warning returns scalar reference.
return exists $self -> {content} ? $self -> {content} : load($self) -> {content} ;
}
sub changed($self){ return 1 if not $self->{last_modified}; #We return changed if doesn't exist.
# Open Source Code License -> https://choosealicense.com/licenses/isc/
#
package CNFMeta;
-
+use Carp qw(cluck);
use strict; use warnings; no warnings qw(experimental::signatures);
use constant {
VERSION => "2.0", #Version of CNFMeta itself is this, not exported, access with CNFMeta::VERSION.
sub _meta {
my $constance = shift;
if($constance){
- return qr/\s*\_+$constance\_+/
+ return qr/\s*\_+$constance\_+\s*/
}
$constance;
}
my @col_names = _deRefArray($header[0]);
for my $index(0..$#col_names){
return $index if $name eq $col_names[$index];
- }
- warn "Not found column name:$name";
+ }
+ cluck "Table [$$table->{name}]:$name <- has no such column.";
}
# Main Parser for the Configuration Network File Format.
##
package CNFParser;
-use base 'CNF';
-
-use Exception::Class ('CNFParserException');
-use Syntax::Keyword::Try;
-use strict;use warnings; no warnings 'once';
+use base 'CNF';
+use feature qw(try say signatures);
+no warnings 'once'; no warnings 'experimental::try';
use Hash::Util qw(lock_hash unlock_hash);
-
+use feature 'try';
use constant VERSION => '3.3.7';
use constant APP_STS => 'APP_SETTINGS';
use constant APP_ARGS => 'ARGUMENTS';
+use CNFExceptions qw( throw_exception throw_runtime_halt_exception );
require CNFNode;
require CNFDateTime;
RUN_PROCESSORS => 1, # When enabled post parse processors are run, these are outside of the scope of the parsers executions.
};
}
- $CONSTREQ = $self->{CONSTANT_REQUIRED};
+ $CONSTREQ = $self->{CONSTANT_REQUIRED}; $self->{CNF_NEW_CALLER} = (caller(1))[3];
if ($self->{ANONS_ARE_PUBLIC}){
$anechoic = \%ANONS;
###
sub const { my ($self,$c)=@_;
return $self->{$c} if exists $self->{$c};
- if ($CONSTREQ){CNFParserException->throw("Required constants variable ' $c ' not defined in config!")}
+ if ($CONSTREQ){throw_parser_exception("Required constants variable ' $c ' not defined in config!")}
# Let's try to resolve. As old convention makes constants have a '$' prefix all uppercase.
$c = '$'.$c;
return $self->{$c} if exists $self->{$c};
$r = $self->{$s} if !$r;
$r = $instructs{$s} if !$r;
CNFParserException->throw(
- error=>"Unable to find property for $t.$name -> $find\n",
+ message=>"Unable to find property for $t.$name -> $find\n",
show_trace=>$self->{STACK_TRACE}
) if !$r;
$value =~ s/\Q$find\E/$r/g;
#private to parser sub.
sub doInstruction { my ($self,$e,$t,$v,$is_tagged) = @_;
my $DO_ENABLED = $self->{'DO_ENABLED'}; my $priority = 4; my $isMetaConst;
+ $self->last_require(\"doInstruction($e,$t,$v)") if $self->{STRICT};
if(!$t && !$v && ref($e) eq 'InstructedProcessItem'){
my $itm = $e;
$e = $itm->{ele} . $itm ->{aid};
autoload $v;
$v =~ s/^(.*\/)*|(\..*)$//g;
$anechoic->{$e} = $v;
- }catch{
+ }catch($e){
$self->warn("Module DO_ENABLED library failed to load: $v\n");
$anechoic->{$e} = '<<ERROR>>'
}
sub parseString{
return parse(shift,undef,shift)
}
+my $last_require;
+sub last_require{shift;$last_require=shift}
+###
+# Return config origin. Useful to identify the configuration further.
+# Private parser methods can only call.
+##
+sub origin{
+my $self = shift; my $stack;
+my ($drill,$tab,$last_plugin,$package, $filename, $line, $subroutine)=(1," ","<>");
+ while(($package, $filename, $line, $subroutine) = caller($drill)){
+ $stack .= "\n"; $tab = "" if $package ne 'CNFParser';
+ $stack .= "$tab($package -> $subroutine) <- $filename:$line";
+ $drill++;
+ }
+ $self->{CNF_CALLER} = $stack;
+ if(defined $last_require){
+ if (ref(${$last_require}) eq 'InstructedProcessItem'){
+ $last_plugin = ${$last_require}->toString()
+ }else{
+ $last_plugin = ${$last_require}
+ }
+ }
+return "CNF v.".$self->{CNF_VERSION}."/".$self->{CNF_CONTENT}." -> $last_plugin [".$stack."\n]";
+}
###
# Parses a CNF file or a text content if specified, for this configuration object.
##
# We control from here the constants, as we need to unlock them if a previous parse was run.
unlock_hash(%$self); my $recursing = 0;
-
if( not $content ){
- $cnf_file = $cnf_file -> {path} if ref($cnf_file) eq 'CNFGlobalFile';
- open(my $fh, "<:perlio", $cnf_file )
- or CNFParserException->throw(error=>"Can't open $cnf_file -> $!",show_trace=>$self->{STACK_TRACE});
- read $fh, $content, -s $fh;
- close $fh;
+ if (ref($cnf_file) eq 'CNFGlobalFile'){
+ $content = ${$cnf_file -> content()};
+ $cnf_file = $cnf_file -> {path};
+ $self->{CNF_CONTENT} = "CNFGlobalFile($cnf_file)";
+ }else{
+ open(my $fh, "<:perlio", $cnf_file )
+ or throw_exception(error=>"Can't open $cnf_file -> $!",show_trace=>$self->{STACK_TRACE});
+ read $fh, $content, -s $fh;
+ close $fh;
+ $self->{CNF_CONTENT} = $CUR_SCRIPT = $cnf_file;
+ }
if(exists $self->{CNF_CONTENT} && $self->{CNF_CONTENT} eq 'script'){
$recursing = 1
}else{
my @stat = stat($cnf_file);
$self->{CNF_STAT} = \@stat;
- $self->{CNF_CONTENT} = $CUR_SCRIPT = $cnf_file;
}
}else{
my $type = Scalar::Util::reftype($content);
if($type && $type eq 'ARRAY'){
- $content = join "",@$content;
+ $content = join "", @$content;
$self->{CNF_CONTENT} = 'ARRAY';
+ }elsif($type && $type eq 'SCALAR'){
+ $CUR_SCRIPT = $content;
+ $content = $$content;
+ $self->{CNF_CONTENT} = 'scalar'
}else{
$CUR_SCRIPT = \$content;
$self->{CNF_CONTENT} = 'script'
}
}
my @src_hdr_ver = ($content =~ m/^\!(CNF\s*((\d+\.*\d*)\.*\d*))/m);
+ $self->{CNF_VERSION} = VERSION;
if(@src_hdr_ver){
if(VERSION =~ m/^(\d+\.\d+)/ && $src_hdr_ver[2] > $1){
$self->{CNF_VERSION} = $src_hdr_ver[0];
$self->warn(
qq(CNF Script version is newer, are you using the script possible required parser version $src_hdr_ver[0]?))
- }else{
- $self->{CNF_VERSION} = VERSION;
}
}
+
my $spc = $content =~ /\n/ ? '(<{2,3}?)(<*.*?>*)(>{2,3})' : '\s*(<{2,3}?)(<*.*?>*?)(>{2,3})\s*$';
my @tags = ($content =~ m/$spc/gms);
foreach my $tag (@tags){
$lists{$e} = \@array;
next;
}else{
- doInstruction($self,$e,$t,$v)
+ doInstruction($self,$e,$t,$v)
}
}elsif ($e =~ m/^@|%/){#collection processing?
}elsif(!$t && $e && $v){
$anechoic->{$e} = $v;
}else{
- doInstruction($self,$e,$t,$v)
+ doInstruction($self,$e,$t,$v)
}
}
}
my $struct = $items[$idx];
my $type = ref($struct);
if(not $type){
- CNFParserException->throw("Illegal struct encountered->$struct") if $struct
+ throw_exception("Illegal struct encountered->$struct") if $struct
}else{
my $priority = $struct-> {'^'};
if( $type eq 'CNFNode' && $priority > 0 && $priority < 5){
## no critic BuiltinFunctions::ProhibitStringyEval
my $eva = eval($struct->{val}); $eva =~ s/\n$//g;
$self -> {$struct->{ele}} = $eva;
+ }else{
+ $self->warn("Assuming [".$struct->toString()."] is plugin.");
+ instructPlugin($self, $struct);
}
}else{warn "What is -> $struct type:$type ?"}
}
sub transitionValueFromInstruction { my ($self, $ele, $instruction, $type, $val) = @_;
if($instruction eq 'int'){
- return int($val)
+ return int($val)
}
elsif($instruction eq 'date'){
- return $self->toCNFDate($val)
+ return $self->toCNFDate($val)
}
elsif($instruction eq 'list'){
return split(DELIMITER(), $val)
}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;
+ $instructs{$ele} = $instruction;
}else{
$self->warn("DO_ENABLED is set to false to do instruction -> ($ele, $instruction, $val) \n")
}
try{
## no critic (RequireBarewordIncludes)
#require "$instruction.pm" if $instruction !~ /::/;
+ $self->last_require(\"($ele, $instruction, $val)");
use Module::Load;
autoload $instruction;
$val =~ s/^\(\s*|\s*\)$//g;
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/;
+ 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");
+ }catch($eTrans){
+ $self->error("Failed to transition -> $self->{CNF_LAST_REQUIRE} :$eTranse");
+ throw_exception(error=>$eTrans) if $self -> {STRICT};
}
}else{
$self->warn("DO_ENABLED is set to false to do instruction -> ($ele, $instruction, $val) \n")
}
- return $val;
+ return $val;
}
#
sub includeContains{
$properties{$struct->{'ele'}} = $plugin;
$self->log("Plugin instructed -> ".
$plugin->{element}.'<'.$plugin->{package}.'>.'.$plugin->{subroutine}.'('.$plugin->{property}.')');
- }catch($e){
+ }catch($eIns){
if($self->{STRICT}){
- CNFParserException->throw(error=>$e);
+ CNFParserException->throw(error=>$eIns);
}else{
$self->trace("Error @ ".$struct->{ins}." -> ". $struct->toString() ." Error-> $@")
}
$self->{POSTParseProcessors} = \@arr;
}
+use feature qw(signatures);
sub runPostParseProcessors {
my $self = shift;
my $arr = $self->{POSTParseProcessors} if exists $self->{POSTParseProcessors};
my $pck = $plugin->{package};
my $prp = $plugin->{property};
my $sub = $plugin->{subroutine};
+ $self->last_require(\$struct);
if($instructor eq APP_STS){
$pck = 'ClassicAppSettings' if ! $pck;
## no critic (RequireBarewordIncludes)
return $plugin;
}
elsif($pck && $prp && $sub){
+ try{
## no critic (RequireBarewordIncludes)
require "$pck.pm" if $pck !~ /::/;
+ }catch($erpck){
+ $self -> error($self->origin(). ": $erpck");
+ }
#Properties are global, all plugins share a %Settings property if specified, otherwise the default will be set from here only.
my $settings = $properties{'%Settings'};
if($settings){
$plugin->{$_} = $settings->{$_} unless exists $plugin->{$_}
} ;
}
- my $obj = $pck->new($plugin);
- my $res = $obj-> $sub($self, $prp);
- if($res){
- $plugin->setPlugin($obj);
- $plugin->{instructor} = $instructor;
- return $plugin;
- }else{
- die "Sorry, the PLUGIN in <<".$plugin->{element}.">> feature has failed or not been fully implemented yet!"
+ try{
+ my $obj = $pck->new($plugin);
+ my $res = $obj-> $sub($self, $prp);
+ if($res){
+ $plugin->setPlugin($obj);
+ $plugin->{instructor} = $instructor;
+ return $plugin;
+ }else{
+ die "Sorry, the PLUGIN in <<".$plugin->{element}.">> feature has failed or not been fully implemented yet!"
+ }
+ }catch($doPlugErr){
+ throw_runtime_halt_exception(error=>$doPlugErr, origin=>$self->origin(), show_trace=>1)if(not ref($doPlugErr));
+ throw_exception(message=>$doPlugErr->message()) if $self->{STRICT};
+ $self->error($self->origin()." ->\n".$doPlugErr->message());
}
}
else{
## no critic BuiltinFunctions::ProhibitStringyEval
no strict 'refs';
if($link =~/(\w*)::\w+$/){
+ $self->last_require(\$link);
use Module::Loaded qw(is_loaded);
if(is_loaded($1)){
$ret = \&{+$link}($self);
eval require "$1.pm";
$ret = &{+$link};
if(!$ret){
- $self->error( qq(Package constance link -> $link is not available (try to place in main:: package with -> 'use $1;')));
+ $self->error( qq($self->origin(): Package constance link -> $link is not available (try to place in main:: package with -> 'use $1;')));
$ret = $link
}
}
# SQL Processing part for the Configuration Network File Format.
###
package CNFSQL;
-
use strict;use warnings;#use warnings::unused;
-use Exception::Class ('CNFSQLException'); use Carp qw(cluck);
+use CNFExceptions qw(throw_sql_exception);
+use Carp qw(cluck);
use Syntax::Keyword::Try;
use Time::HiRes qw(time);
use DateTime;
use DBI;
use Tie::IxHash;
-use constant VERSION => '2.1';
+use constant VERSION => '2.2';
our (%tables_create_stmts, %tables_id_type, %tables_data_map);
our %views = ();
if($ref eq 'CNFDateTime'){
$ref =''; $val = $val -> toDateTimeFormatWithZone()
}
- if($ref eq ''){
+ if($ref eq '' && $val){
my @sp = split '`', $val;
if(scalar @sp>1){$val=$sp[0];$dsc=$sp[1];}else{$dsc=""}
$st->execute($key,$val,$dsc);
+ }elsif(not defined $val){
+ warn "Encountered undefined Key: $key." if $key !~ /CNF_.*CALLER/
}
}
$db->commit();
$sqlSEL->execute($key);
my @a = $sqlSEL->fetchrow_array();
if(@a==0){
- my @sp = split '`', $val;
- if(scalar @sp>1){$val=$sp[0];$dsc=$sp[1];}else{$dsc=""}
- $sqlINS->execute($key,$val,$dsc);
+ if(not defined $val){
+ warn "Encountered undefined Key: $key." if $key !~ /CNF_.*CALLER/
+ }else{
+ my @sp = split '`', $val;
+ if(scalar @sp>1){$val=$sp[0];$dsc=$sp[1];}else{$dsc=""}
+ $sqlINS->execute($key,$val,$dsc);
+ }
}elsif(@upd){
foreach my $find(@upd){
if($find eq $key){
$do_not_auto_synch = 0;
$schema_tables{$tbl_stm_name}=1;
- }catch{
- die "Failed to create:\n$st\nError:$@"
+ }catch($e){
+ die "Failed to create:\n$st\nError:$e"
}
}
else{
undef %tables_create_stmts; undef %tables_id_type;
undef %views;
}
-catch{
+catch($e){
if($sql_last){
$sql_last = "Last SQL statement: $sql_last\n"
}else{
$sql_last = ""
}
- CNFSQLException->throw(error=>$sql_last.$@, show_trace=>1);
+ throw_sql_exception(error=>$sql_last.$e, show_trace=>1);
}
return $self->{parser}-> const('$RELEASE_VER');
}
my $dsn = $source .'dbname='.$path.$store;
try{
return DBI->connect($dsn, $user, $pass, {AutoCommit => 0, RaiseError => 1, PrintError => 0, show_trace=>1});
- }catch{
- die "<p>Error->$
@</p><br><pre>DSN: $dsn</pre>" if $die_in_html;
+ }catch($e){
+ die "<p>Error->$
e</p><br><pre>DSN: $dsn</pre>" if $die_in_html;
die $@
}
}
while(!$r[5]){
@r = $st->fetchrow_array();
if(!@r){
- CNFSQLException->throw(error=> "Table has no Primary Key -> $tbl_stm_name", show_trace=>1);
+ throw_sql_exception(error=> "Table has no Primary Key -> $tbl_stm_name", show_trace=>1);
}
}
return $r[1]."=?";
$ret{$row[0]} = \[$row[1], $row[2]]
}
return \%ret;
- }catch{
- CNFSQLException->throw(error=>"Database error encountered!\n ERROR->$@\n", show_trace=>1);
+ }catch($e){
+ throw_sql_exception(error=>"Database error encountered!\n ERROR->$e\n", show_trace=>1);
}
}
try{
$db -> do("UPDATE CNF_CONFIG SET VALUE = '$value' WHERE NAME == '$name';");
- }catch{
- CNFSQLException->throw(error=>"Database error encountered!\n ERROR->$@\n", show_trace=>1);
+ }catch($e){
+ throw_sql_exception(error=>"Database error encountered!\n ERROR->$e\n", show_trace=>1);
}
}
return 0 if not $pst;
$pst->execute();
return $pst;
- }catch{
- CNFSQLException->throw(error=>"Database error encountered!\n ERROR->$@ SQL-> $sql DSN:".$dsn, show_trace=>1);
+ }catch($e){
+ throw_sql_exception(error=>"Database error encountered!\n ERROR->$e SQL-> $sql DSN:".$dsn, show_trace=>1);
}
}
#@deprecated
try{
$db->do("select count(*) from $tbl_stm_name;");
return 1;
- }catch{}
+ }catch($e){}
return 0;
}
###
my $cocoon_key = $self->passCodeGenerate();
$config = CNFParser -> blank() -> parse(undef,qq(
<<COCOON_KEY<$cocoon_key>>>
- <<cocoon<DATA>__AUTO_NUMBERED__ __HAS_HEADER__
+ <<cocoon<DATA>__AUTO_NUMBERED__ __HAS_HEADER__
ID`FULL NAME`ALIAS`PASS_CODE _UNIQUE_`DATE _DATE_`NOTES _TEXT_~
#`$full_name`$alias`$pass_code`$date`$encrypted~
>>
package DataProcessorPlugin;
+use feature qw(signatures try);
use PluginBase;
+use CNFExceptions qw(throw_plugin_error);
use Date::Manip;
-use constant VERSION => '1.0';
+use constant VERSION => '1.1';
+no warnings 'experimental::try'; no warnings 'once';
sub new ($class, $plugin){
my $settings;
shift @rows if($knock_out);
$$table->{data} = \@rows;
$$table->{data_processed} = 1;
-}catch{
- PluginException->throw(error=>"<p>Error->$@</p><br> processProperty('$property')</pre>", show_trace=>1);
+}catch($e){
+ throw_plugin_error(error=>$e, show_trace=>1);
}
}
return 1
package DataProcessorWorldCitiesPlugin;
-use PluginBase;
+use feature qw(signatures try);
+use PluginBase;
+use CNFExceptions qw(throw_plugin_error);
+use Date::Manip;
+use constant VERSION => '1.1';
# @Deprecated Plugin not needed anymore in script.
sub new ($class,$plugin){
return bless {}, $class
###
package DatabaseCentralPlugin;
use PluginBase;
-use Exception::Class ('DBCentralPluginException');
-
-use Time::Piece;
+use CNFExceptions qw(throw_plugin_error);
use DBI;
+use Time::Piece;
use Date::Manip;
require CNFDateTime; require CNFMeta; require CNFSQL;
-use constant VERSION => '1.1';
+use constant VERSION => '1.2';
+no warnings 'experimental::try'; no warnings 'once';
my ($IS_SQLITE,$DSN,$SUPPRESS_DATA_LOG)=(0,(),0);
# Error brace strategy is needed for large systems to throw easy to debug possible exceptions.
return if !$pst;
$pst->execute();
return $pst
-}catch{
- DBCentralPluginException->throw(error=>"<p>Error->$@</p><br><pre>DSN: $DSN sql:$sql</pre>");
+}catch($err_dbc){
+ throw_plugin_error(
+ error => "<p>Error->$err_dbc</p><br><pre>DSN: $DSN sql:$sql</pre>" );
}
}
suppress_data_log=>$SUPPRESS_DATA_LOG},
@update);
%CNFConfig = %{$parser -> SQL() -> selectCNFConfigRecords($db)};
- }catch{
- DBCentralPluginException->throw(error=>"Error->$@ \nDSN: $DSN");
+ }catch($e){
+ throw_plugin_error(error=>"Error->$e \nDSN: $DSN");
}
my $DT_db_synch_date = $CNFConfig{DB_SYNCH_DATE}; #This date can by synch run updates that are to the db a change.
}catch($e){
$db->rollback();
my $brace = brace(); my $tbln = $tbl->{name}; $brace = "braced for ($brace)" if $brace;
- DBCentralPluginException->throw(
+ throw_plugin_error(
error=>"Error: $e (Property \[".
$tbl->toPath()."/name='$tbln'] $brace");
}
}catch($e){
my $error = "Error with statment in ".$tbl->toPath()."/\@name=[".$tbl->{name}."]->{$query} == \'".$tbl -> {$query}."\' Error -> $e";
- DBCentralPluginException->throw(error=>$error)
+ throw_plugin_error(error=>$error)
}
}
return 2;
}
}catch($e){
- DBCentralPluginException->throw(error=>"Error->$e ".
+ throw_plugin_error(error=>"Error->$e ".
"Property -> ".$node->toPath()."/\@name=[".$node->{name}."]-> sqlCreateTable -> ".$node->{sqlCreateTable}."\n".$node->toScript());
}
}
package GenericInstructionHandler;
-use PluginBase;
+use feature qw(signatures try);
+use PluginBase;
+use CNFExceptions qw(throw_plugin_error);
+use Date::Manip;
+use constant VERSION => '1.1';
sub new {my ($class, $args) = @_;
bless $args, $class;
package HTMLIndexProcessorPlugin;
+use feature qw(signatures try);
use PluginBase;
-use Exception::Class ('HTMLIndexProcessorPluginException');
+use CNFExceptions qw(throw_plugin_error);
+use Date::Manip;
+use constant VERSION => '1.1';
use CGI;
use CGI::Session '-ip_match';
-use constant VERSION => '1.0';
+use constant VERSION => '1.1';
sub new ($class, $plugin){
}
$parser->data()->{$property} = \$buffer;
}catch($e){
- HTMLIndexProcessorPluginException->throw(error=>$e, show_trace=>1);
+ throw_plugin_error(error=>$e, show_trace=>1);
}
}
###
sub loadDocument($parser, $doc) {
my $slurp = do {
- open my $fh, '<:encoding(UTF-8)', $doc or HTMLIndexProcessorPluginException->throw("Document not avaliable: $doc");
+ open my $fh, '<:encoding(UTF-8)', $doc or throw_plugin_error("Document not available: $doc");
local $/;
<$fh>;
};
# Processing of these is placed in the data parsers data.
###
package HTMLProcessorPlugin;
-use PluginBase;
-use Exception::Class ('HTMLProcessorPluginException');
+use feature qw(signatures try);
+use strict; use warnings; no warnings 'once'; no warnings 'experimental::try';
+use PluginBase;
+use CNFExceptions qw(throw_plugin_error);
+use Date::Manip;
+
+use constant VERSION => '1.1';
+
+
+use Clone qw(clone);
-use constant VERSION => '1.0';
sub new ($class, $plugin){
my $settings;
my $tree = $parser->anon($property);
die "Tree property '$property' is not available!" if(!$tree or ref($tree) ne 'CNFNode');
-
+no warnings 'experimental::try';
try{
$header = $parser-> {'HTTP_HEADER'} if exists $parser->{'HTTP_HEADER'};
$title = $tree -> {'Title'} if exists $tree->{'Title'};
$parser->data()->{$property} = \$buffer;
-}catch{
- HTMLProcessorPluginException->throw(error=>$@ ,show_trace=>1);
+}catch($e){
+ throw_plugin_error(error=>$e ,show_trace=>1);
}
}
#
# Processing of these is placed in the data parsers data.
#
package MarkdownPlugin;
-use PluginBase;
-use Exception::Class ('MarkdownPluginException');
+use feature qw(signatures try);
+use PluginBase;
+use CNFExceptions qw(throw_plugin_error);
+
##no critic ControlStructures::ProhibitMutatingListFunctions
use constant VERSION => '1.1';
return bless $settings, $class
}
+no warnings 'experimental::try'; no warnings 'once';
+
###
# Process config data to contain expected fields and data.
###
}elsif($script !~ /\n/ and -e $script ){
my $file = $parser->anon($property);
$script = do {
- open my $fh, '<:encoding(UTF-8)', $script or MarkdownPluginException->throw("File not available: $script");
+ open my $fh, '<:encoding(UTF-8)', $script or throw_pl("File not available: $script");
local $/;
<$fh>;
};
$parser->data()->{$property.'_headings'} = [__PACKAGE__,'toHTML_headings',$doc[1]];
}catch($e){
- MarkdownPluginException->throw(error=>$e ,show_trace=>1);
+ throw_exception(error=>$e ,show_trace=>1);
}}
sub toHTML_headings($self,$hdrs) {
$buff .= qq(<p>$para</p>\n) if $para;
return [\$buff,\@titles]
}catch($e){
- MarkdownPluginException->throw(error=>$e ,show_trace=>1);
+ throw_exception(error=>$e ,show_trace=>1);
}}
sub code2HTML($parser, $val){
sub style ($parser, $script){
- MarkdownPluginException->throw(error=>"Invalid argument passed as script!",show_trace=>1) if !$script;
+ throw_plugin_error(error=>"Invalid argument passed as script!",show_trace=>1) if !$script;
#Links <https://duckduckgo.com>
$script =~ s/<(http[:\/\w.]*)>/<a href=\"$1\">$1<\/a>/g;
$script =~ s/(\*\*([^\*]*)\*\*)/\<em\>$2<\/em\>/gs;
-package PluginBase;
-use v5.36;
-use strict;
-use warnings; no warnings qw(experimental::signatures);
-use Syntax::Keyword::Try;
-use feature qw(signatures);
+package PluginBase;
+use strict; use warnings; no warnings qw(experimental::signatures);
+use feature qw(signatures try say);
use Scalar::Util qw(looks_like_number);
use Clone qw(clone);
use Module::Load;
-use Exception::Class ('PluginException');
-
require Exporter;
-
our $TAB = ' 'x4;
our @ISA = qw(Exporter);
our @EXPORT = qw($TAB);
use Carp qw(confess);
BEGIN {
- $SIG{'__DIE__'} = sub { confess(@_) };
+ $SIG{'__DIE__'} = sub { confess(@_) };
}
sub import {
-
- feature->import(':5.36');
+
+ feature->import(':5.38');
+ warnings->import;
+ strict->import;
feature->import('signatures');
+ feature->import('try');
+ feature->import('say');
warnings->import;
warnings->unimport('once');
- strict->import;
- Syntax::Keyword::Try->import;
+ strict->import;
+ #Syntax::Keyword::Try->import;
Module::Load->import;
Carp->import('confess');
- Exception::Class->import('PluginException');
-
+ Clone->import('clone');
+ #Exception::Class->import('CNF_PluginException');
my $caller = caller(0);
package RSSFeedsPlugin;
-
-use strict;
-use warnings;
-no warnings qw(experimental::signatures);
use feature qw(signatures);
+use strict; use warnings; no warnings 'once'; no warnings 'experimental::try';
+use PluginBase;
+
+use CNFExceptions qw(throw_plugin_error);
+use constant VERSION => '1.2';
+
+
+
use Scalar::Util qw(looks_like_number);
-use Syntax::Keyword::Try;
-use Exception::Class ('CNFPluginException');
use Clone qw(clone);
use Capture::Tiny 'capture_stdout';
use FileHandle;
use Benchmark;
-use constant VERSION => '1.2';
+
+
+
our %MHDR = %CNFMeta::TABLE_HEADER;
our $TZ;
my @lbls = CNFMeta::_deRefArray($header[$MHDR{COL_NAMES}]);
- my %hdr; my $page;
+ my %hdr; my $page; no warnings 'experimental::try';
try{
for(my $i=0;$i<@lbls;$i++){ #<- Column names are set here, if names in script are changed, They must be changed bellow.
$hdr{$lbls[$i]} = $i
#$parser->log("Feed spec: @col");
my $name = $col[$hdr{Name}];
next if($feed && $feed ne $name);
- my $tree = fetchFeed($self, $parser, $name, $col[$hdr{URL}], $col[$hdr{Expires}], $col[$hdr{Description}]);
+ my $tree = $self->fetchFeed($parser, $name, $col[$hdr{URL}], $col[$hdr{Expires}], $col[$hdr{Description}]);
$parser->log("Fetched feed:".$name);
if($tree && ref($$tree) eq 'CNFNode'){
if(not isCNFTrue($self->{CNF_TREE_LOADED}) && isCNFTrue($self->{CNF_TREE_STORE})){
}
}
}catch($e){
- CNFParserException->throw(error=>$e, show_trace=>1);
+ throw_plugin_error(error=>$e, show_trace=>1);
$parser-> error("RSSFeedsPlugin\@collectFeeds() Error:$@")
}
$parser->data()->{PAGE} = \$page if $page;
}
}
}
- unless ( -e $fname ) {
+ unless ( -e $fname ) { no warnings 'experimental::try';
try{
$cnf_parser->log("Fetching: $fname -> [$url] ...");
my $res = getstore($url, $fname);
$cnf_parser->error("Error<$res>!\n");
`curl $url -o $fname`
}
- }catch{
+ }catch($e){
$cnf_parser->error( "Error: $@.\n");
return;
}
# of project based local libraries in Perl.
# Nothing quite other than it, yet does exists.
##
-package TestManager;
-use warnings; use strict;
+package TestManager;
+BEGIN{ #before we compile, set locations per project standards.
+ use lib "tests";
+ # use lib "system/modules";
+}
+# TestBase- Is located loaded and visible by the test files. Module placed local to them.
+use parent TestBase;
+
use Term::ANSIColor qw(:constants);
use Timer::Simple;
+use IO::Handle;
+
+
my $timer = Timer::Simple->new(start => 0, string => 'human');
my $stab = "";
my $current_test_file;
-our $CWD;
-
-BEGIN{
-use Cwd qw(getcwd); $CWD = getcwd;
-}
-
###
# Notice All test are to be run from the project directory.
###
sub new {
my ($class, $test_file, $self) = @_;
- $test_file = $0 if not $test_file;
- $self = bless {test_file=> $CWD.'/'.$test_file,test_cnt=>1,sub_cnt=>0,sub_err=>0,suited=>1}, $class;
- print BLUE."Running -> ".WHITE."$test_file\n".RESET;
- $self->{open}=0;
- if($test_file =~ m/^$CWD/){
+ $test_file = $0 if not $test_file;
+ if($test_file =~ m/^$w_d_test/){
$current_test_file = $test_file;
}else{
- $current_test_file = "$CWD/$test_file"
+ $current_test_file = "$w_d_test/$test_file"
}
+ $self = bless {test_file=>$current_test_file ,test_cnt=>1,sub_cnt=>0,sub_err=>0,suited=>1}, $class;
+ print BLUE."Running -> ".WHITE."$test_file\n".RESET;
+ $self->{open}=0;
return $self;
}
++$self->{sub_err};
my ($package, $filename, $line) = caller; $filename =~ s/^(\/(.+)\/)//gs;
print BLINK. BRIGHT_RED. "\t$stab Fail ".$self->{test_cnt}.".".$sub_cnt.": $err",
- BLUE, "\n\t$stab\t at -> ",RESET,"$CWD/$filename:$line\n", RESET;
+ BLUE, "\n\t$stab\t at -> ",RESET,"$filename:$line\n", RESET;
return $self
}
my $sub_cnt = ++$self->{sub_cnt};
my ($package, $filename, $line) = caller; $filename =~ s/^(\/(.+)\/)//gs;
print BRIGHT_GREEN, "\t$stab Pass ".$self->{test_cnt}.".".$sub_cnt.": $msg",
- BLUE, "at -> ",RESET,"$CWD/$filename:$line\n";
+ BLUE, "at -> ",RESET,"$filename:$line\n";
return $self
}
sub case {
my ($self, $out, $ref) = @_;
my ($package, $filename, $line) = caller; $filename =~ s/^(\/(.+)\/)//gs;
+ STDERR->autoflush(1);
+ STDOUT->autoflush(1);
exit 8 if not $self -> {suited} and $ENV{'RUNNING_IN_SUIT'};
- die "Case REF not in ordinal string format!\n For -> $CWD/$filename:$line\n" if $ref && $ref !~ m/\d*/g;
+ die "Case REF not in ordinal string format!\n For -> $filename:$line\n" if $ref && $ref !~ m/\d*/g;
$stab="";
nextCase($self) if $self->{open};
- print BRIGHT_CYAN,"\tCase ".$self->{test_cnt}.": $out", BLUE, "\n\tat -> ",
- "$CWD/$filename:$line\n", RESET;
+ print BRIGHT_CYAN,"\tCase ".$self->{test_cnt}." line $out", BLUE, "\n\tat -> ",
+ $TestBase::w_d_test."$filename:$line\n", RESET;
+ #print "tests/$filename:$line\n";
$self->{open}=1;
return $self
}
next
}else{
my $tracing = "\n".RED."tracing ->";
- $str =~ s/called at/$tracing/gs;
+ $str =~ s/called at/$tracing/gs;
}
}
$trace .= '<'.'-'x$i .RED.$str.RESET."\n";
($trace,$file,$lnErr) = ($comment =~ m/(.*)\sat\s*(.*)\sline\s(\d*)\.$/);
}
$comment =~ s/(\s+line\s)(\d+)\.*\s+/:$2\n/gm;
+ # my @hasTrace = ($comment =~ m/Trace begun at.*|^.*\s+at\s+line.*\d+/gim);
+ my @isManagerTestTrace = ($comment =~ m/.*<-.*test.*\.pl.*/gim);
+ if(@isManagerTestTrace){
+ $current_test_file = pop @isManagerTestTrace;
+ $current_test_file =~s/.*<-\s*//;
+ }
+
+
print BOLD BRIGHT_RED "Test file failed -> $comment";
if($file){
open (my $flh, '<:perlio', $file) or die("Error $! opening file: '$file'\n$comment");
my $line = $slurp[$i];
if($. >= $lnErr+1){
print $comment, RESET.frmln($.).$line;
- $file = "$CWD/$file" if $file !~ m/^$CWD/;
- print "[".$file.":$i] Case $failed->{test_cnt}\n\t".BRIGHT_RED."Failed\@Line".WHITE." $i -> ",
+ $file = $TestBase::w_d_cwd.$file if $file !~ m/^$TestBase::w_d_cwd/;
+ print "[ ".$file.":$i ] Case $failed->{test_cnt}\n\t".BRIGHT_RED."Failed\@Line".WHITE." $i -> ",
$slurp[$i-1].RESET."Failed test file: $current_test_file";
last
}elsif($line=~m/^\s*(\#.*)/){
package TestBase;
-use warnings; use strict;
-use Syntax::Keyword::Try;
+use warnings;
+use strict;
+use feature qw(signatures try);
+no warnings 'once';
use Cwd qw(abs_path);
-use File::Basename;
-use lib dirname( abs_path(__FILE__) );
-use lib dirname( abs_path(__FILE__) ) . "/../system/modules";
-use TestManager;
+
+BEGIN { #before we compile, set locations per project standards.
+ use lib "tests";
+ use lib "system/modules";
+}
+
+# Comment out above BEGIN, and uncomment bellow to debug in vscode, has an plugin bug.
+
+# BEGIN { #before we compile, set locations per project standards.
+# use lib "/home/will/dev_new/PerlCNF/tests";
+# use lib "/home/will/dev_new/PerlCNF/system/modules";
+# }
+
use CNFParser;
+use CNFSQL;
+use CNFMeta;
+use CNFGlobalFile;
+use CNFDateTime;
+use CNFNode;
+use Benchmark;
+use Carp 'confess';
+use File::Basename;
+
+our $test_directory_path = dirname( abs_path(__FILE__) );
+use File::Basename;
+our ( $w_d_cwd, $w_d_test, $w_d_syst);
+{
+
+ $w_d_cwd = $test_directory_path; $w_d_cwd =~ s|\w+$||;
+ $w_d_test = $TestBase::test_directory_path . '/';
+ $w_d_syst = $w_d_cwd. 'system/modules/';
+
+}
+
+
+our @EXPORT = qw($test_directory_path $w_d_cwd $w_d_test $w_d_syst);
+require Exporter;
+
+sub import {
+
+ warnings->import;
+ strict->import;
+ feature->import('signatures');
+ feature->import('try');
+ feature->import('say');
+ my $caller = caller(0);
+ do {
+ no strict 'refs';
+ *{"$caller\:\:Benchmark"} = *{"Benchmark"};
+ *{"$caller\:\:CNFParser"} = *{"CNFParser"};
+ *{"$caller\:\:CNFGlobalFile"} = *{"CNFGlobalFile"};
+ *{"$caller\:\:CNFDateTime"} = *{"CNFDateTime"};
+ *{"$caller\:\:CNFMeta"} = *{"CNFMeta"};
+ *{"$caller\:\:CNFSQL"} = *{"CNFSQL"};
+ *{"$caller\:\:output_path"} = \&output_path;
+ };
+}
-sub base_path{
- my $self = shift;
- return `pwd`
+sub output_path ($file_name) {
+ $file_name = basename($file_name);
+ return "$test_directory_path/output/$file_name";
}
+1;
-1;
\ No newline at end of file
+#use feature qw(signatures try);
+#use lib "/home/will/dev_new/PerlCNF/system/modules";
+#use lib '/home/will/dev_new/PerlCNF/tests';
+#use TestManager;
+#use CNF;
+#use CNFParser;
+#use CNFMeta;
# Part of Test Manager running all your test files and collecting stats.
# Nothing quite other than it, yet does exists.
##
-use v5.30;
-#use warnings; use strict;
+use v5.38.0;
use POSIX;
-use Syntax::Keyword::Try;
+use lib "./system/modules";
+use lib "./tests";
+use TestBase;
use Date::Manip;
use Term::ANSIColor qw(:constants);
use IPC::Run qw( run timeout );
-use Cwd qw(getcwd);
-my $CWD = getcwd;
-
-use lib "system/modules";
-use lib "./tests";
-try{
+no warnings 'once'; no warnings 'experimental::try'; try{
require TestManager;
$ENV{'RUNNING_IN_SUIT'} = 1;
-}catch{
+}catch($e){
print RED "Failed to require -> ".WHITE."TestManager.pm".RED.
"\nPlease run tests from the project directory.\n";
exit 1
###
print '-'x100, "\n";
my $manager = TestManager->new("Test Suit [ $0 ] (".(scalar localtime).")");
-print qq/With options -> --display_issues = $DISPLAY_ISSUES,
+print qq/Perl -> $^V is used.\nWith options -> --display_issues = $DISPLAY_ISSUES,
--run_in_taint_mode = $RUN_IN_TAINT_MODE,
--display_tests_output = $DISPLAY_TESTS_OUTPUT,
--display_errors_output = $DISPLAY_ERRORS_OUTPUT,
- CWD = $CWD\n/;
+ TEST_W_D = $TestBase::w_d_test\n/;
print '-'x100, "\n";
try{
opendir my($dh), $TEST_LOCAL_DIR or die WHITE."Couldn't open dir '$TEST_LOCAL_DIR':".RED." $!";
foreach my $file(sort @files) {
- $file = "tests/$file";
my ($in,$output, $warnings);
my @perl = ('/usr/bin/env','perl');
+ $file = $TestBase::w_d_test . $file;
push @perl, '-T' if $RUN_IN_TAINT_MODE;
push @perl, $file;
print "Running->$file\n";
$unsuited_test_files[@unsuited_test_files] = $file;
$tests_unsuited++; print BOLD. YELLOW."Skipping is unsuited ->$file\n",RESET; next;
}
- my @test_ret = $output=~m/(\d*)\|(\w*)\|($CWD\/$file)$/g;
- $output=~s/\d*\|\w*\|($CWD\/$file)\s$//g;
+ my @test_ret = $output=~m/(\d*)\|(\w*)\|($file)$/g;
+ $output=~s/\d*\|\w*\|($file)\s$//g;
if ($warnings){
for(split "\n", $warnings){
- $WARN{$CWD."/$file"} = $warnings;
+ $WARN{$file} = $warnings;
}
}
if(@test_ret && $test_ret[1] eq 'SUCCESS'){
push @OUT, $output;
}else{
$test_fail++;
- my $failed = BOLD. RED. "Failed Test File -> ". RESET. $CWD."/$file".RESET."\n";
+ my $failed = BOLD. RED. "Failed Test File -> ". RESET.$file.RESET."\n";
print $failed;
print RED, "\t", $warnings, RESET if $warnings;
$failed[@failed] = $failed;
print BOLD BRIGHT_RED, "HALT! Not all tests have passed!\n", ( join "", @failed) ,
BOLD WHITE, "Finished with test Suit ->$0\n", RESET;
}elsif($test_pass){
- print BOLD BLUE "Test Suit:", RESET WHITE, "$CWD/$0 [\n";
+ print BOLD BLUE "Test Suit:", RESET WHITE, "$0 [\n";
foreach (@files) {
print WHITE, "\t\t$_\n",;
}
if(@unsuited_test_files){
print BOLD WHITE."List of unsuited test files -> [\n".RESET;
foreach(@unsuited_test_files){
- print YELLOW, "\t$CWD/$_\n",;
+ print YELLOW, "\t$_\n",;
}
print BOLD WHITE."]\n",RESET;
}
print "To display all encountered issues or warnings, on next run try:\n\tperl tests/testAll.pl --display_issues\n"
}
my $time_stop = strftime "%Y-%m-%d %H:%M:%S", localtime;
- print qq/Tests ended $time_stop at $CWD. Start time was: $time_start/;
+ print qq/Tests ended $time_stop at $TestBase::w_d_test. Start time was: $time_start/;
print "\n",'-'x100, "\n";
}
-catch{
- $manager -> dumpTermination($@)
+catch($e){
+ $manager -> dumpTermination($e)
}
=begin copyright
#!/usr/bin/env perl
-use warnings; use strict;
-use lib::relative ('.','../system/modules');
-
-require TestManager;
-require CNFParser;
-require ClassicAppSettings;
+use lib "./system/modules";
+use lib "./tests";
+use TestManager;
+use ClassicAppSettings;
my $test = TestManager -> new($0);
-use Syntax::Keyword::Try; try {
+no warnings 'experimental::try'; no warnings 'once'; try {
###
$test->case("Test Parse CNF APP_SETTINGS instruction.");
SAMPLE_SETTING_1 => "This will be overwritten",
NEW_SETTING => "New setting not expected in configuration, APP_SETTINGS_SYNC == 1"
);
- my $parser = CNFParser -> new(undef,{DO_ENABLED=>0,'%LOG'=>{enabled=>1, console=>1}});
+ my $parser = CNFParser -> new(undef,{DO_ENABLED=>0,'%LOG'=>{enabled=>1, file=>output_path(__FILE__), console=>1}});
$parser->parse(undef,qq(
<<APP_NAME<CONST>Sample App>>
<<CONFIG_SETTINGS <APP_SETTINGS>
>>
));
+ $parser->log("Started testing AppSettings.");
+
my $app_settings = $parser->property('CONFIG_SETTINGS');
$test -> isDefined("CONFIG_SETTINGS",$app_settings);
$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);
+ $parser->log("Ended successfully testing AppSettings.");
#
$test->done();
#
+
}
-catch{
- $test -> dumpTermination($@);
+catch ($e){
+ $test -> dumpTermination($e);
$test -> doneFailed();
}
#!/usr/bin/env perl
-use warnings; use strict;
-use Syntax::Keyword::Try;
-#no critic "eval"
-
-use lib "system/modules";
-# use lib::relative "../system/modules";
-
-require TestManager;
-require CNFParser;
+use lib './tests';
+use lib './system/modules';
+use TestManager;
my $test = TestManager -> new($0) -> unsuited();
my $cnf;
-try{
+no warnings 'experimental::try'; no warnings 'once'; try{
###
# Test instance creation.
#
my $CNF_SCRIPT = qq{
<<< ARGUMENTS
-x=0 # x,y positions.
- -Y = 10
+ -Y = 10
-text = "Some Value"
-text = This added value. # Will convert -text argument into an array.
-text* = cnf_anon_name # Will link add script of some anon to now array -text.
my $args = $cnf->anon(CNFParser::APP_ARGS());
if($test->isDefined("args", $args)){
my @args = @$args;
- $test->evaluate("\@args has elements?", 7,scalar @args) ;
+ $test->evaluate("\@args has elements?", 7, scalar @args) ;
}else{
- $test -> failed("Arguments not have been obtained!")
+ $test -> failed("Arguments not have been obtained!")
}
#
$test->done();
#
}
-catch{
- $test -> dumpTermination($@);
+catch($e){
+ $test -> dumpTermination($e);
$test -> doneFailed();
}
-
-#
-# TESTING ANY POSSIBLE SUBS ARE FOLLOWING FROM HERE #
-#
\ No newline at end of file
-use warnings; use strict;
-use lib "system/modules";
-
-require TestManager;
-require CNFParser;
+#!/usr/bin/env perl
+use lib "./system/modules";
+use lib "./tests";
+use TestManager;
my $test = TestManager -> new($0);
-use Syntax::Keyword::Try; try {
+no warnings 'experimental::try'; no warnings 'once'; try {
###
$test->case("Test CNF to JSON.");
$test->done();
#
}
-catch{
- $test -> dumpTermination($@);
+catch($e){
+ $test -> dumpTermination($e);
$test->doneFailed();
}
#!/usr/bin/env perl
-use warnings; use strict;
-use Syntax::Keyword::Try;
-use lib::relative ('.','../system/modules');
+use lib "./system/modules";
+use lib "./tests";
+use TestManager;
-require CNFParser;
-require TestManager;
my $test = TestManager -> new($0);
my $cnf;
-try{
+no warnings 'experimental::try'; no warnings 'once'; try{
###
# Test instance creation.
$test->done();
#
}
-catch{
- $test -> dumpTermination($@);
+catch($e){
+ $test -> dumpTermination($e);
$test -> doneFailed();
}
#!/usr/bin/env perl
-use warnings; use strict;
-use Syntax::Keyword::Try;
-use lib::relative ('.','../system/modules');
+use lib "./system/modules";
+use lib "./tests";
+use TestManager;
-require CNFParser;
-require TestManager;
my $test = TestManager -> new($0);
my $cnf;
-try{
+no warnings 'experimental::try'; no warnings 'once'; try{
###
# Test instance creation.
$test->done();
#
}
-catch{
- $test -> dumpTermination($@);
+catch ($e){
+ $test -> dumpTermination($e);
$test -> doneFailed();
}
#!/usr/bin/env perl
-use lib './tests';
-use parent 'TestBase';
-use Syntax::Keyword::Try;
-
+use v5.38;
+use lib "./system/modules";
+use lib "./tests";
+use TestManager;
my $test = TestManager -> new($0);
my $cnf;
-
-try{
+no warnings 'experimental::try'; no warnings 'once'; try{
###
# Test instance with cnf a file.
try{
my $immutable = $cnf->{IMMUTABLE};
$test->failed("Failed access allowed to undefined constances.")
- }catch{
+ }catch($e){
$test->passed("It errored, trying to access undeclared constance.");
}
my $immutable = $cnf->const('IMMUTABLE');
$test->passed("Passed to access constance with variable resolve.");
$test->isDefined('$FRENCH_PARAGRAPH',$immutable);
- }catch{
- $test->failed("Failed access allowed to undefined constances.")
+ }catch($e){
+ $test->failed("Failed access allowed to undefined constance.")
}
#
###
try{
$cnf->{IMMUTABLE} = "change?";
$test->failed('Variable should be a constant!');
- }catch{
+ }catch($e){
$test->subcase('Passed test is constance.');
}
try{
$$cnf->{DYNAMIC_IMMUTABLE} = "new";;
$test->failed('Variable should not be alloed added constance!');
- }catch{
+ }catch($e){
$test->subcase('Passed dynamic added constance not possible.');
}
###
- # Test DATA instructions and Plugin powers of PCNF.
+ # Test DATA instructions and Plugin powers of CNF.
###
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.
}
}
-
#
$test->done();
#
}
-catch{
- $test -> dumpTermination($@);
- $test -> doneFailed();
+catch($e){
+ $test -> dumpTermination($e);
+ $test -> doneFailed();
}
#!/usr/bin/env perl
-use lib './tests';
-use parent 'TestBase';
-use Syntax::Keyword::Try;
+use lib "./system/modules";
+use lib "./tests";
+use TestManager;
my $test = TestManager -> new($0);
my $cnf;
-try{
+no warnings 'experimental::try'; no warnings 'once'; try{
###
# Test instance creation.
try{
$cnf->{MyConstant} = "";
$test->failed("Constance must not be able to change!");
- }catch{
+ }catch($e){
$test->passed("Passed not can change!");
}
$test->subcase('Try finding an constant not existing');
try{
$cnf->{EXISTS} = "";
$test->failed("Constance exists how?");
- }catch{
+ }catch($e){
$test->passed("Passed constant EXISTS not has been made to exists!");
}
$test->isDefined('MyConstant',$val);
$test->evaluate('MyConstant',"Can't be changed!",$val);
- }catch{
+ }catch($e){
$test->failed("Failed to import methods");
}
$test->done();
#
}
-catch{
- $test -> dumpTermination($@);
+catch($e){
+ $test -> dumpTermination($e);
$test -> doneFailed();
}
#!/usr/bin/env perl
-use warnings; use strict;
-use feature 'say';
-use lib "system/modules";
-
-require TestManager;
-require CNFGlobalFile;
-require CNFDateTime;
+use lib "./system/modules";
+use lib "./tests";
+use TestManager;
my $test = TestManager->new($0);
-use Syntax::Keyword::Try; try {
+no warnings 'experimental::try'; no warnings 'once'; try {
###
# Test instance creation.
$test->done();
#
}
-catch{
- $test -> dumpTermination($@);
+catch($e){
+ $test -> dumpTermination($e);
$test->doneFailed();
}
-use warnings; use strict;
-use lib "system/modules";
-
-require TestManager;
-require CNFParser;
-require CNFMeta; CNFMeta->_import_into_this_package();
+#!/usr/bin/env perl
+use lib "./system/modules";
+use lib "./tests";
+use TestManager;
+CNFMeta->_import_into_this_package();
my $test = TestManager -> new($0);
-use Syntax::Keyword::Try; try {
+no warnings 'experimental::try'; no warnings 'once'; try {
###
$test->case("Test CNFMeta regexp directly.");
$test->done();
#
}
-catch{
- $test -> dumpTermination($@);
+catch($e){
+ $test -> dumpTermination($e);
$test->doneFailed();
}
#!/usr/bin/env perl
-use warnings; use strict;
-use feature 'say';
-use lib "system/modules";
-
-require TestManager;
-require CNFParser;
-require CNFNode;
+use lib "./system/modules";
+use lib "./tests";
+use TestManager;
my $test = TestManager->new($0);
-use Syntax::Keyword::Try; try {
+no warnings 'experimental::try'; no warnings 'once'; try {
###
# Test instance creation.
$test->done();
#
}
-catch{
- $test -> dumpTermination($@);
+catch($e){
+ $test -> dumpTermination($e);
$test->doneFailed();
}
#!/usr/bin/env perl
-use warnings; use strict;
-use feature 'say';
-##
-# Disable bellow use lib::relative when debugging -> "perl.perlInc"
-# if set hard linked to vscode project/workspace finds the right folder.
-##
- use lib::relative (".","../system/modules");
-##
-
-require TestManager;
-require CNFParser;
-require CNFNode;
+use lib "./system/modules";
+use lib "./tests";
+use TestManager;
my $test = TestManager->new($0);
package Constants;
# read only references but these are NOT constants.
*GlobelTroter = \"TEST";
package main;
-use Syntax::Keyword::Try; try {
+no warnings 'experimental::try'; no warnings 'once'; try {
my $parser = CNFParser->new();
$test->done();
#
}
-catch{
+catch($e){
$test -> dumpTermination($@);
$test -> doneFailed();
}
#!/usr/bin/env perl
-use warnings; use strict;
-use Syntax::Keyword::Try;
+use lib "./system/modules";
+use lib "./tests";
+use TestManager;
-##
-# Disable bellow use lib::relative when debugging -> "perl.perlInc"
-# if set hard linked to vscode project/workspace finds the right folder.
-##
- use lib::relative (".","../system/modules");
-##
-
-require CNFParser;
-require TestManager;
my $test = TestManager -> new($0);
my $cnf;
my $logfile = 'tests/output/zzz_temp.log';
-try{
+no warnings 'experimental::try'; no warnings 'once'; try{
###
# Test instance creation.
#
$test->done();
#
}
-catch{
- $test -> dumpTermination($@);
+catch($e){
+ $test -> dumpTermination($e);
$test -> doneFailed();
}
#!/usr/bin/env perl
-use lib './tests';
-use parent 'TestBase';
-use Syntax::Keyword::Try;
+use lib "./system/modules";
+use lib "./tests";
+use TestManager;
my $test = TestManager->new($0);
my $cnf;
-my $base = TestBase::base_path();
-try {
+
+no warnings 'experimental::try'; no warnings 'once'; try {
###
# Test instance creation.
###
}catch($e){
- $test->dumpTermination($@);
+ $test->dumpTermination($e);
$test->doneFailed();
}
#!/usr/bin/env perl
-use warnings; use strict;
-use Syntax::Keyword::Try;
-use Benchmark;
-use File::stat;
+use lib "./system/modules";
+use lib "./tests";
+use TestManager;
-use lib::relative ('.','../system/modules');
+use File::stat;
-require TestManager;
-require CNFParser;
-require CNFDateTime;
my $test = TestManager -> new($0);
my $cnf;
-try{
+no warnings 'experimental::try'; no warnings 'once'; try{
my $fstat = CNF::_fetchScriptStat($0);
die $test->failed() if not $cnf = CNFParser->new( undef,
{DO_ENABLED=>1,'%LOG'=>{console=>1},TZ=>'Australia/Sydney', CNF_STAT => $fstat}
}
-catch{
- $test -> dumpTermination($@);
+catch($e){
+ $test -> dumpTermination($e);
$test -> doneFailed();
}
#!/usr/bin/env perl
-use warnings; use strict;
-use Syntax::Keyword::Try;
-use Math::Cartesian::Product;
-
-use lib "system/modules";
-
-require TestManager;
-require CNFParser;
+use lib "./system/modules";
+use lib "./tests";
+use TestManager;
+use Math::Cartesian::Product;
my $test = TestManager -> new($0);
my $cnf;
-try{
+no warnings 'experimental::try'; no warnings 'once'; try{
$test->case("Test Cartesian Product lib.");
$test->done();
#
}
-catch {
- $test -> dumpTermination($@);
+catch($e){
+ $test -> dumpTermination($e);
$test -> doneFailed();
}
#!/usr/bin/env perl
-use warnings; use strict;
-use lib::relative ('.','../system/modules');
-
-require TestManager;
-require CNFParser;
-require Cocoon;
+use lib "./system/modules";
+use lib "./tests";
+use TestManager;
+use Cocoon;
my $test = TestManager -> new($0);
+my $cnf;
our $APP_PASS_KEY = "For now can be anything. Not just 123!";
-use Syntax::Keyword::Try; try {
+no warnings 'experimental::try'; no warnings 'once'; try {
###
$test->case("Test Cocoon Instance creation");
$coco->register("Johnny Spare", "jspare" ,$generate, "Example 1 entry",undef);
$coco->register("Melany Stare", "mstare" ,$coco->passCodeGenerate(), "Example2",undef);
if(!$coco->register("Bubba Cuba", "cuba" ,$generate, "",undef)){
- $test->passed("Passed register Bubba Cuba not possible with previous assigne pass code.");
+ $test->passed("Passed register Bubba Cuba not possible with previous assigned pass code.");
}else{
- $test->failed("Failed Bubba Cuba got register with previously registered pass_code!");
+ $test->failed("Failed Bubba Cuba got register while having a previously registered pass_code!");
}
#
$test->done();
#
}
-catch{
- $test -> dumpTermination($@);
+catch($e){
+ $test -> dumpTermination($e);
$test -> doneFailed();
}
#!/usr/bin/env perl
-use warnings; use strict;
-use Syntax::Keyword::Try;
-use lib::relative ('.','../system/modules');
-
-require TestManager;
-require CNFParser;
+use lib "./system/modules";
+use lib "./tests";
+use TestManager;
+use TestBase;
my $test = TestManager -> new($0);
my $cnf;
-try{
+no warnings 'experimental::try'; no warnings 'once'; try{
###
# Test instance creation.
$test->done();
#
}
-catch{
- $test -> dumpTermination($@);
+catch($e){
+ $test -> dumpTermination($e);
$test -> doneFailed();
}
#!/usr/bin/env perl
-use warnings; use strict;
-use Syntax::Keyword::Try;
-use lib "system/modules";
-
-
-
-require TestManager;
-require CNFParser;
+use lib "./system/modules";
+use lib "./tests";
+use TestManager;
my $test = TestManager -> new($0);
my $cnf;
-try{
+no warnings 'experimental::try'; no warnings 'once'; try{
###
# Test instance creation.
$test->done();
#
}
-catch{
- $test -> dumpTermination($@);
+catch($e){
+ $test -> dumpTermination($e);
$test -> doneFailed();
}
#!/usr/bin/env perl
-use warnings; use strict;
-use Syntax::Keyword::Try;
-use lib "system/modules";
-
-
-require TestManager;
-require CNFDateTime;
-require CNFParser;
+use lib "./system/modules";
+use lib "./tests";
+use TestManager;
my $test = TestManager -> new($0);
my $cnf;
-try{
+no warnings 'experimental::try'; no warnings 'once'; try{
$test->case("Test TZ settings.");
$test->subcase("Test list availabe countries.");
my @countries = CNFDateTime::_listAvailableCountryCodes();
$test->done();
#
}
-catch{
- $test -> dumpTermination($@);
+catch($e){
+ $test -> dumpTermination($e);
$test -> doneFailed();
}
#!/usr/bin/env perl
-use warnings; use strict;
-use lib::relative ('.','../system/modules');
-
-require TestManager;
-require CNFParser;
+use lib "./system/modules";
+use lib "./tests";
+use TestManager;
my $test = TestManager -> new($0);
-use Syntax::Keyword::Try; try {
+no warnings 'experimental::try'; no warnings 'once'; try {
###
$test->case("Test Do.");
$test->done();
#
}
-catch{
- $test -> dumpTermination($@);
- $test->doneFailed();
+catch($e){
+ $test -> dumpTermination($e);
+ $test -> doneFailed();
}
#!/usr/bin/env perl
-use warnings; use strict;
-use Syntax::Keyword::Try;
-use Benchmark;
-use lib "system/modules";
-
-
-require TestManager;
-require CNFParser;
-require CNFSQL;
+use lib "./system/modules";
+use lib "./tests";
+use TestManager;
my $test = TestManager -> new($0);
my $cnf;
-try{
+no warnings 'experimental::try'; no warnings 'once'; try{
# die $test->failed() if not $cnf = CNFParser->new();
# $test->case("Passed new instance CNFParser.");
my $db_synch_date = $cnf ->{DB_SYNCH_DATE};
$test -> isDefined("\$db_synch_date",$db_synch_date);
-#
+
#
$test->done();
#
}
-catch{
- $test -> dumpTermination($@);
+catch($e){
+ $test -> dumpTermination($e);
$test -> doneFailed();
}
#!/usr/bin/env perl
-use lib './tests';
-use parent 'TestBase';
-use Syntax::Keyword::Try;
+use lib "./system/modules";
+use lib "./tests";
+use TestManager;
my $test = TestManager -> new($0);
my $cnf;
#my $plugin = ExtensionSamplePlugin->new({Language=>'English',DateFormat=>'US'});
-try{
+no warnings 'experimental::try'; no warnings 'once'; try{
###
# Test instance creation.
#
$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{
+ }catch($e){
$test->isDefined("SOME_CONSTANCE",$cnf->{SOME_CONSTANCE});
}
$test->done();
#
}
-catch{
+catch($e){
$test -> dumpTermination($@);
$test -> doneFailed();
}
-use warnings; use strict;
-use lib "system/modules";
+#!/usr/bin/env perl
+use lib "./system/modules";
+use lib "./tests";
+use TestManager;
-require TestManager;
-require CNFParser;
-require CNFNode;
-require HTMLProcessorPlugin;
-require ShortLink;
+use HTMLProcessorPlugin;
+use ShortLink;
my $test = TestManager -> new($0);
-use Syntax::Keyword::Try; try {
+no warnings 'experimental::try'; no warnings 'once'; try {
$test->done();
#
}
-catch{
- $test -> dumpTermination($@);
- $test->doneFailed();
+catch($e){
+ $test -> dumpTermination($e);
+ $test -> doneFailed();
}
-use warnings; use strict;
-use lib "system/modules";
-require TestManager;
-require CNFParser;
+#!/usr/bin/env perl
+use lib "./system/modules";
+use lib "./tests";
+use TestManager;
require MarkdownPlugin;
my $test = TestManager -> new($0);
-use Syntax::Keyword::Try; try {
+no warnings 'experimental::try'; no warnings 'once'; try {
my $parser = CNFParser -> new();
$test->done();
#
}
-catch{
- $test -> dumpTermination($@);
+catch($e){
+ $test -> dumpTermination($e);
$test -> doneFailed();
}
-
#!/usr/bin/env perl
-use warnings; use strict;
-use lib "system/modules";
-
-require TestManager;
-require CNFParser;
+use lib "./system/modules";
+use lib "./tests";
+use TestManager;
my $test = TestManager->new($0);
}
}
-use Syntax::Keyword::Try; try {
+no warnings 'experimental::try'; no warnings 'once'; try {
###
# Test inside tag/macro in value.
###
try {
$cnf->{'$DEBUG'} = 'false'
}
- catch {
+ catch($e) {
$test->subcase(
"Passed keep constant test for \$cnf->DEBUG=$cnf->{DEBUG}");
}
# CNF Constances can't be modifed anymore, let's test.
try{
$cnf->{'$DEBUG'}= 'false'
- }catch{
+ }catch($e){
$test->subcase("Passed keep constant test for \$cnf->DEBUG=$cnf->{DEBUG}");
}
$test->done();
#
}
-catch{
- $test -> dumpTermination($@);
- $test->doneFailed();
+catch($e){
+ $test -> dumpTermination($e);
+ $test -> doneFailed();
}
#!/usr/bin/env perl
-use warnings; use strict;
-use Syntax::Keyword::Try;
-use lib "system/modules";
-
-require TestManager;
-require CNFParser;
+use lib "./system/modules";
+use lib "./tests";
+use TestManager;
my $test = TestManager -> new($0);
my $cnf;
-try{
+no warnings 'experimental::try'; no warnings 'once'; try{
###
# Test instance creation.
#
$test->done();
#
}
-catch {
- $test -> dumpTermination($@);
+catch($e){
+ $test -> dumpTermination($e);
$test -> doneFailed();
}
#!/usr/bin/env perl
-use warnings; use strict;
-use Syntax::Keyword::Try;
-use lib "system/modules";
-
-require TestManager;
-require CNFParser;
+use lib "./system/modules";
+use lib "./tests";
+use TestManager;
my $test = TestManager -> new($0);
my $cnf;
-try{
+no warnings 'experimental::try'; no warnings 'once'; try{
###
# Test instance creation.
#
));
print $test->failed("Test failed! Passed to overwrite existing instruction, which are global.");
- }catch{
+ }catch($e){
$test->passed("Passed fail on trying to overwrite existing instruction, which are global.");
}
$test -> done();
#
}
-catch{
- $test -> dumpTermination($@);
+catch($e){
+ $test -> dumpTermination($e);
$test -> doneFailed();
}
-use warnings; use strict;
-use lib "system/modules";
+#!/usr/bin/env perl
+use lib "./system/modules";
+use lib "./tests";
+use TestManager;
-require TestManager;
-require CNFParser;
-require CNFNode;
require MarkdownPlugin;
my $test = TestManager -> new($0);
-use Syntax::Keyword::Try; try {
+no warnings 'experimental::try'; no warnings 'once'; try {
###
$test->case("Test instances of parser and MarkDownPlugin.");
my $parser = CNFParser -> new();
$test->done();
#
}
-catch{
- $test -> dumpTermination($@);
- $test->doneFailed();
+catch($e){
+ $test -> dumpTermination($e);
+ $test -> doneFailed();
}
#!/usr/bin/env perl
-use warnings; use strict;
-use lib::relative ('.','../system/modules');
-
-require TestManager;
-require CNFParser;
+use lib "./system/modules";
+use lib "./tests";
+use TestManager;
my $test = TestManager->new($0);
-use Syntax::Keyword::Try; try {
+no warnings 'experimental::try'; no warnings 'once'; try {
###
# Test instance creation.
$test->done();
#
}
-catch{
- $test -> dumpTermination($@);
- $test->doneFailed();
+catch($e){
+ $test -> dumpTermination($e);
+ $test -> doneFailed();
}
#!/usr/bin/env perl
-use warnings; use strict;
-use Syntax::Keyword::Try;
-use lib "system/modules";
-use PerlKeywords qw(%KEYWORDS %FUNCTIONS &matchForCSS &CAP &span_to_html);
-
+use lib "./system/modules";
+use lib "./tests";
use TestManager;
-
+use PerlKeywords qw(%KEYWORDS %FUNCTIONS &matchForCSS &CAP &span_to_html);
my $test = TestManager -> new($0);
my $cnf;
-try{
+no warnings 'once'; no warnings 'experimental::try'; try{
$test->case("Regex as string.");
my $regex = qr/\s*#.*$/o;
$test->done();
#
}
-catch{
- $test -> dumpTermination($@);
+catch($e){
+ $test -> dumpTermination($e);
$test -> doneFailed();
}
+
#!/usr/bin/env perl
-use warnings; use strict;
-use Syntax::Keyword::Try;
-use lib "system/modules";
-use Date::Manip;
+use lib "./system/modules";
+use lib "./tests";
+use TestManager;
-require TestManager;
-require CNFParser;
+use Date::Manip;
my $test = TestManager -> new($0);
my $cnf;
-try{
+no warnings 'experimental::try'; no warnings 'once'; try{
###
# Test instance creation.
#
$test->done();
#
}
-catch{
- $test -> dumpTermination($@);
+catch($e){
+ $test -> dumpTermination($e);
$test -> doneFailed();
}
#!/usr/bin/env perl
-use warnings; use strict;
-use Syntax::Keyword::Try;
-use lib::relative ('.','../system/modules');
+use lib "./system/modules";
+use lib "./tests";
+use TestManager;
-require TestManager;
-require CNFParser; CNFParser::_import_into_this_package();
+CNFParser::_import_into_this_package();
my $test = TestManager -> new($0);
-try{ #If STRICT is true parser will throw error, accessing from here.
+no warnings 'experimental::try'; no warnings 'once'; try{ #If STRICT is true parser will throw error, accessing from here.
die $test->failed() if not my $cnf = CNFParser->new(undef,{STRICT=>0,'%LOG'=>{console=>1}});
$test->case('Passed CNFParser->new().');
$test->case("Parse Typical Processor registration.");
$test -> done();
#
}
-catch{
- $test -> dumpTermination($@);
+catch($e){
+ $test -> dumpTermination($e);
$test -> doneFailed();
}
#!/usr/bin/env perl
-use warnings; use strict;
-use Syntax::Keyword::Try;
+use lib "./system/modules";
+use lib "./tests";
+use TestManager;
+
use Benchmark;
-use lib "system/modules";
-require TestManager;
-require CNFParser;
-require CNFSQL;
my $test = TestManager -> new($0);
my $cnf;
`rm -f tests/test_db_central.db`;
-try{
+no warnings 'experimental::try'; no warnings 'once'; try{
die $test->failed() if not $cnf = CNFParser->new();
$test->case("Passed new instance CNFParser.");
$test->done();
#
}
-catch{
- $test -> dumpTermination($@);
+catch($e){
+ $test -> dumpTermination($e);
$test -> doneFailed();
}
#!/usr/bin/env perl
-use warnings; use strict;
-use Syntax::Keyword::Try;
-use Benchmark;
-use lib "system/modules";
+use lib "./system/modules";
+use lib "./tests";
+use TestManager;
-require TestManager;
-require CNFParser;
-require CNFSQL;
my $test = TestManager -> new($0);
my $cnf;
DB_SQL_SOURCE = DBI:Pg:host=localhost;port=5433;
>>>
);
-try{
+no warnings 'experimental::try'; no warnings 'once'; try{
die $test->failed() if not $cnf = CNFParser->new(undef,{'%LOG'=>{console=>1}});
$test->case("Passed new instance CNFParser.");
$test->done();
#
}
-catch{
- $test -> dumpTermination($@);
+catch($e){
+ $test -> dumpTermination($e);
$test -> doneFailed();
}
#!/usr/bin/env perl
-use warnings;
-use strict;
-use feature "say";
-use Syntax::Keyword::Try;
-use Benchmark;
-use lib::relative ( '.', '../system/modules' );
+use lib "./system/modules";
+use lib "./tests";
+use TestManager;
-require TestManager;
-require CNFParser;
-require CNFSQL;
+use Benchmark;
my $test = TestManager -> new($0);
my $cnf;
<<<FILE $0>>>
);
-try{
+no warnings 'experimental::try'; no warnings 'once'; try{
die $test->failed()
$test->done();
#
}
-catch{
- $test -> dumpTermination($@);
+catch($e){
+ $test -> dumpTermination($e);
$test -> doneFailed();
}
#!/usr/bin/env perl
-use warnings; use strict;
-use Syntax::Keyword::Try;
-use Benchmark;
+use lib "./system/modules";
+use lib "./tests";
+use TestManager;
-use lib::relative '../system/modules';
-#use lib "system/modules";
-require TestManager;
-require CNFParser;
-require CNFSQL;
+use Benchmark;
my $test = TestManager -> new($0);
my $cnf;
-try{
+no warnings 'experimental::try'; no warnings 'once'; try{
die $test->failed() if not $cnf = CNFParser->blank({DO_ENABLED=>1,DEBUG=>1,'%LOG'=>{console=>1}});
$test->passed("Passed new instance CNFParser.");
$test->done();
#
}
-catch{
- $test -> dumpTermination($@);
+catch($e){
+ $test -> dumpTermination($e);
$test -> doneFailed();
}
#!/usr/bin/env perl
-use warnings; use strict;
-use Syntax::Keyword::Try;
+use lib "./system/modules";
+use lib "./tests";
+use TestManager;
+
use Benchmark;
-use lib "system/modules";
-require TestManager;
-require CNFParser;
-require CNFSQL;
my $test = TestManager -> new($0)->unsuited();
my $cnf;
-try{
+no warnings 'experimental::try'; no warnings 'once'; try{
- $test->case("Test direct local SQL Database Setup and Init.");
+ $test->case("Test direct local SQL Database Setup and Init.","1");
my $content = do {local $/;<DATA>};
$cnf = CNFParser->new(undef,{DO_ENABLED=>1,DEBUG=>1,'%LOG'=>{console=>1},TZ=>"Australia/Sydney"});
$cnf->parse(undef,$content);
$test->done();
#
}
-catch{
- $test -> dumpTermination($@);
+catch($e){
+ $test -> dumpTermination($e);
$test -> doneFailed();
}
!CNF3.3.4
//ID when is of CNF_ID column name, AUTOINCREMENT is done by CNF and it is a primary unique key, not by the database.
<< TASKS <DATA> __SQL_TABLE__
-ID __CNF_ID__`Date _DATE_ `Due _DATE_ `Task __TEXT__`Completed _BOOL_`Priority __ID_~
+ID __CNF_ID__`Date _DATE_ `Due _DATE_ `Task __TEXT__`Completed _BOOL_`Priority __ID_~
#`2023-10-18`2023-11-22`Write test.`0`1~
#`2023-10-18`2023-12-01`Implement HSHContact.`0`3~
>><<PRIORITIES <DATA> __SQL_TABLE__
#!/usr/bin/env perl
-use warnings; use strict;
-use Syntax::Keyword::Try;
+use lib "./system/modules";
+use lib "./tests";
+use TestManager;
+
use Benchmark;
use lib::relative ('.','../system/modules');
`rm -f tests/test_db_central.db`;
-try{
+no warnings 'experimental::try'; no warnings 'once'; try{
die $test->failed() if not $cnf = CNFParser->new();
$test->case("Passed new instance CNFParser.");
$test->done();
#
}
-catch{
- $test -> dumpTermination($@);
+catch($e){
+ $test -> dumpTermination($e);
$test -> doneFailed();
}
-use warnings; use strict;
-use feature 'say';
-use lib "system/modules";
+#!/usr/bin/env perl
+use lib "./system/modules";
+use lib "./tests";
+use TestManager;
+
-require TestManager;
require ShortLink;
my $test = TestManager->new($0);
-use Syntax::Keyword::Try; try {
+no warnings 'experimental::try'; no warnings 'once'; try {
$test->case("List generation.");
# say "dcp[".length($xdecomp)."]:".$xdecomp;
}
-catch{
- $test -> dumpTermination($@);
+catch($e){
+ $test -> dumpTermination($e);
$test->doneFailed();
}
\ No newline at end of file
#!/usr/bin/env perl
-use warnings; use strict;
-use Syntax::Keyword::Try;
-use lib "system/modules";
-
-require TestManager;
-require CNFParser;
-require CNFNode;
+use lib "./system/modules";
+use lib "./tests";
+use TestManager;
my $test = TestManager -> new($0);
my $cnf;my $err;
-try{
+no warnings 'experimental::try'; no warnings 'once'; try{
$test->case("Test nested multiline value.");
my $property = ${CNFNode->new({name=>'TEST'})->process(CNFParser->new(), qq(
}
-catch {
+catch($e) {
$test -> dumpTermination($@);
$test -> doneFailed();
}
#!/usr/bin/env perl
-use warnings; use strict;
-use Syntax::Keyword::Try;
-use lib "system/modules";
-
-require TestManager;
-require CNFParser;
-require CNFNode;
+use lib "./system/modules";
+use lib "./tests";
+use TestManager;
my $test = TestManager -> new($0);
my $cnf;my $err;
-try{
+no warnings 'experimental::try'; no warnings 'once'; try{
$test->case("Test HTML Conversion.");
}
-catch {
- $test -> dumpTermination($@);
+catch($e) {
+ $test -> dumpTermination($e);
$test -> doneFailed();
}
#!/usr/bin/env perl
-use warnings; use strict;
-use Syntax::Keyword::Try;
-use lib "system/modules";
-
-require TestManager;
-require CNFParser;
+use lib "./system/modules";
+use lib "./tests";
+use TestManager;
my $test = TestManager -> new($0);
my $cnf;
-try{
+no warnings 'experimental::try'; no warnings 'once'; try{
###
# Test instance cnf file loading time.
$test->done();
#
}
-catch{
- $test -> dumpTermination($@);
+catch($e){
+ $test -> dumpTermination($e);
$test -> doneFailed();
}
lifelog.hopto.org / PerlCNF.git / commitdiff