From: Will Budic Date: Thu, 19 Mar 2026 12:50:17 +0000 (+1100) Subject: Upgrade to v.3.36.+ perl compatibility. X-Git-Url: https://lifelog.hopto.org/gitweb/?a=commitdiff_plain;p=PerlCNF.git Upgrade to v.3.36.+ perl compatibility. --- diff --git a/system/modules/CNF.pm b/system/modules/CNF.pm index 4286a2f..1ac4b55 100644 --- a/system/modules/CNF.pm +++ b/system/modules/CNF.pm @@ -1,9 +1,11 @@ ### # 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); @@ -11,6 +13,10 @@ use File::ReadBackwards; 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) @@ -72,8 +78,13 @@ sub log { } 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; @@ -82,7 +93,7 @@ sub log { 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; @@ -209,6 +220,7 @@ sub writeToDataFile { my ($self, $path, $property, $fh)=@_; $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{ @@ -220,25 +232,22 @@ sub writeToDataFile { my ($self, $path, $property, $fh)=@_; 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 $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 $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. @@ -413,3 +422,12 @@ __END__ 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 diff --git a/system/modules/CNFExceptionBase.pm b/system/modules/CNFExceptionBase.pm new file mode 100644 index 0000000..be960b0 --- /dev/null +++ b/system/modules/CNFExceptionBase.pm @@ -0,0 +1,46 @@ +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 diff --git a/system/modules/CNFExceptions.pm b/system/modules/CNFExceptions.pm new file mode 100644 index 0000000..ced61fb --- /dev/null +++ b/system/modules/CNFExceptions.pm @@ -0,0 +1,29 @@ +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; diff --git a/system/modules/CNFGlobalFile.pm b/system/modules/CNFGlobalFile.pm index d9f14f6..58cbb33 100644 --- a/system/modules/CNFGlobalFile.pm +++ b/system/modules/CNFGlobalFile.pm @@ -11,13 +11,14 @@ no warnings qw(experimental::signatures); use feature qw(signatures say); 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. diff --git a/system/modules/CNFMeta.pm b/system/modules/CNFMeta.pm index 26ef2a5..97fb0aa 100644 --- a/system/modules/CNFMeta.pm +++ b/system/modules/CNFMeta.pm @@ -8,7 +8,7 @@ # 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. @@ -24,7 +24,7 @@ use constant { sub _meta { my $constance = shift; if($constance){ - return qr/\s*\_+$constance\_+/ + return qr/\s*\_+$constance\_+\s*/ } $constance; } @@ -305,8 +305,8 @@ sub _getColumnIndex($table, $name){ 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."; } diff --git a/system/modules/CNFParser.pm b/system/modules/CNFParser.pm index c76de3b..e79666f 100644 --- a/system/modules/CNFParser.pm +++ b/system/modules/CNFParser.pm @@ -2,17 +2,16 @@ # 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; @@ -78,7 +77,7 @@ sub new { my ($class, $path, $attrs, $del_keys, $self) = @_; 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; @@ -324,7 +323,7 @@ sub anon { my ($self, $n, $args)=@_; ### 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}; @@ -492,7 +491,7 @@ sub doProcessCollection{ my($self,$e,$t,$v) = @_; $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; @@ -507,6 +506,7 @@ sub doProcessCollection{ my($self,$e,$t,$v) = @_; #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}; @@ -629,7 +629,7 @@ sub doInstruction { my ($self,$e,$t,$v,$is_tagged) = @_; autoload $v; $v =~ s/^(.*\/)*|(\..*)$//g; $anechoic->{$e} = $v; - }catch{ + }catch($e){ $self->warn("Module DO_ENABLED library failed to load: $v\n"); $anechoic->{$e} = '<>' } @@ -800,6 +800,30 @@ sub doDATAInstructions_{ my ($self,$e,$v,$t,$d)=@_; 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. ## @@ -807,40 +831,48 @@ sub parse { my ($self, $cnf_file, $content, $del_keys) = @_; # 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){ @@ -951,7 +983,7 @@ sub parse { my ($self, $cnf_file, $content, $del_keys) = @_; $lists{$e} = \@array; next; }else{ - doInstruction($self,$e,$t,$v) + doInstruction($self,$e,$t,$v) } }elsif ($e =~ m/^@|%/){#collection processing? @@ -959,7 +991,7 @@ sub parse { my ($self, $cnf_file, $content, $del_keys) = @_; }elsif(!$t && $e && $v){ $anechoic->{$e} = $v; }else{ - doInstruction($self,$e,$t,$v) + doInstruction($self,$e,$t,$v) } } } @@ -1019,7 +1051,7 @@ sub parse { my ($self, $cnf_file, $content, $del_keys) = @_; 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){ @@ -1074,6 +1106,9 @@ sub parse { my ($self, $cnf_file, $content, $del_keys) = @_; ## 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 ?"} } @@ -1099,10 +1134,10 @@ sub parse { my ($self, $cnf_file, $content, $del_keys) = @_; 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) @@ -1112,7 +1147,7 @@ sub transitionValueFromInstruction { my ($self, $ele, $instruction, $type, $val) }elsif($instruction eq 'do'){ # i.e. <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") } @@ -1120,6 +1155,7 @@ sub transitionValueFromInstruction { my ($self, $ele, $instruction, $type, $val) 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; @@ -1127,20 +1163,21 @@ sub transitionValueFromInstruction { my ($self, $ele, $instruction, $type, $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/; + 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{ @@ -1188,9 +1225,9 @@ sub instructPlugin { $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-> $@") } @@ -1315,6 +1352,7 @@ sub addPostParseProcessor { $self->{POSTParseProcessors} = \@arr; } +use feature qw(signatures); sub runPostParseProcessors { my $self = shift; my $arr = $self->{POSTParseProcessors} if exists $self->{POSTParseProcessors}; @@ -1419,6 +1457,7 @@ sub doPlugin { 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) @@ -1466,8 +1505,12 @@ sub doPlugin { 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){ @@ -1476,14 +1519,20 @@ sub doPlugin { $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{ @@ -1501,6 +1550,7 @@ sub obtainLink { ## 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); @@ -1508,7 +1558,7 @@ sub obtainLink { 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 } } diff --git a/system/modules/CNFSQL.pm b/system/modules/CNFSQL.pm index 67ca696..d2b8f56 100644 --- a/system/modules/CNFSQL.pm +++ b/system/modules/CNFSQL.pm @@ -2,16 +2,16 @@ # 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 = (); @@ -110,10 +110,12 @@ try{ 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(); @@ -133,9 +135,13 @@ try{ $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){ @@ -173,8 +179,8 @@ try{ $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{ @@ -432,13 +438,13 @@ transaction:{ 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'); } @@ -453,8 +459,8 @@ sub _connectDB { my $dsn = $source .'dbname='.$path.$store; try{ return DBI->connect($dsn, $user, $pass, {AutoCommit => 0, RaiseError => 1, PrintError => 0, show_trace=>1}); - }catch{ - die "

Error->$@


DSN: $dsn
" if $die_in_html; + }catch($e){ + die "

Error->$e


DSN: $dsn
" if $die_in_html; die $@ } } @@ -551,7 +557,7 @@ my @r = $st->fetchrow_array(); 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]."=?"; @@ -568,8 +574,8 @@ sub selectCNFConfigRecords { $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); } } @@ -579,8 +585,8 @@ sub updateCNFConfigRecord { 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); } } @@ -595,8 +601,8 @@ sub selectRecords { 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 @@ -604,7 +610,7 @@ sub tableExists { my ($self, $db, $tbl_stm_name) = @_; try{ $db->do("select count(*) from $tbl_stm_name;"); return 1; - }catch{} + }catch($e){} return 0; } ### diff --git a/system/modules/Cocoon.pm b/system/modules/Cocoon.pm index 52a753d..af33fce 100644 --- a/system/modules/Cocoon.pm +++ b/system/modules/Cocoon.pm @@ -113,7 +113,7 @@ sub register($self, $full_name, $alias, $pass_code, $notes, $config){ my $cocoon_key = $self->passCodeGenerate(); $config = CNFParser -> blank() -> parse(undef,qq( <>> - <__AUTO_NUMBERED__ __HAS_HEADER__ + <__AUTO_NUMBERED__ __HAS_HEADER__ ID`FULL NAME`ALIAS`PASS_CODE _UNIQUE_`DATE _DATE_`NOTES _TEXT_~ #`$full_name`$alias`$pass_code`$date`$encrypted~ >> diff --git a/system/modules/DataProcessorPlugin.pm b/system/modules/DataProcessorPlugin.pm index db4239a..638231b 100644 --- a/system/modules/DataProcessorPlugin.pm +++ b/system/modules/DataProcessorPlugin.pm @@ -1,7 +1,10 @@ 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; @@ -113,8 +116,8 @@ try{ shift @rows if($knock_out); $$table->{data} = \@rows; $$table->{data_processed} = 1; -}catch{ - PluginException->throw(error=>"

Error->$@


processProperty('$property')", show_trace=>1); +}catch($e){ + throw_plugin_error(error=>$e, show_trace=>1); } } return 1 diff --git a/system/modules/DataProcessorWorldCitiesPlugin.pm b/system/modules/DataProcessorWorldCitiesPlugin.pm index 83249ea..fb2f115 100644 --- a/system/modules/DataProcessorWorldCitiesPlugin.pm +++ b/system/modules/DataProcessorWorldCitiesPlugin.pm @@ -1,5 +1,9 @@ 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 diff --git a/system/modules/DatabaseCentralPlugin.pm b/system/modules/DatabaseCentralPlugin.pm index 1fea9fd..48d8fdf 100644 --- a/system/modules/DatabaseCentralPlugin.pm +++ b/system/modules/DatabaseCentralPlugin.pm @@ -7,14 +7,14 @@ ### 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. @@ -109,8 +109,9 @@ try{ return if !$pst; $pst->execute(); return $pst -}catch{ - DBCentralPluginException->throw(error=>"

Error->$@


DSN: $DSN sql:$sql
"); +}catch($err_dbc){ + throw_plugin_error( + error => "

Error->$err_dbc


DSN: $DSN sql:$sql
" ); } } @@ -153,8 +154,8 @@ sub main ($self, $parser, $property) { 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. @@ -391,7 +392,7 @@ if($ref eq 'CNFNode'){ }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"); } @@ -414,7 +415,7 @@ try{ }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) } } @@ -523,7 +524,7 @@ sub checkCreateTableSQLProcess ($self, $parser, $schema, $db, $table_prefix, $db 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()); } } diff --git a/system/modules/GenericInstructionHandler.pm b/system/modules/GenericInstructionHandler.pm index 504b48c..3860eb2 100644 --- a/system/modules/GenericInstructionHandler.pm +++ b/system/modules/GenericInstructionHandler.pm @@ -1,5 +1,9 @@ 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; diff --git a/system/modules/HTMLIndexProcessorPlugin.pm b/system/modules/HTMLIndexProcessorPlugin.pm index 147d749..28c6dab 100644 --- a/system/modules/HTMLIndexProcessorPlugin.pm +++ b/system/modules/HTMLIndexProcessorPlugin.pm @@ -1,11 +1,14 @@ 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){ @@ -98,7 +101,7 @@ try{ } $parser->data()->{$property} = \$buffer; }catch($e){ - HTMLIndexProcessorPluginException->throw(error=>$e, show_trace=>1); + throw_plugin_error(error=>$e, show_trace=>1); } } @@ -112,7 +115,7 @@ sub dumpParser($parser){ ### 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>; }; diff --git a/system/modules/HTMLProcessorPlugin.pm b/system/modules/HTMLProcessorPlugin.pm index e1354ef..88ef54c 100644 --- a/system/modules/HTMLProcessorPlugin.pm +++ b/system/modules/HTMLProcessorPlugin.pm @@ -3,10 +3,17 @@ # 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; @@ -25,7 +32,7 @@ sub convert ($self, $parser, $property) { 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'}; @@ -74,8 +81,8 @@ try{ $parser->data()->{$property} = \$buffer; -}catch{ - HTMLProcessorPluginException->throw(error=>$@ ,show_trace=>1); +}catch($e){ + throw_plugin_error(error=>$e ,show_trace=>1); } } # diff --git a/system/modules/MarkdownPlugin.pm b/system/modules/MarkdownPlugin.pm index 562c2a4..b76aa1c 100644 --- a/system/modules/MarkdownPlugin.pm +++ b/system/modules/MarkdownPlugin.pm @@ -4,8 +4,10 @@ # 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'; @@ -32,6 +34,8 @@ sub new ($class, $plugin){ return bless $settings, $class } +no warnings 'experimental::try'; no warnings 'once'; + ### # Process config data to contain expected fields and data. ### @@ -50,7 +54,7 @@ try{ }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>; }; @@ -98,7 +102,7 @@ try{ $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) { @@ -510,7 +514,7 @@ try{ $buff .= qq(

$para

\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){ @@ -752,7 +756,7 @@ sub propValCNF($v){ 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 $script =~ s/<(http[:\/\w.]*)>/$1<\/a>/g; $script =~ s/(\*\*([^\*]*)\*\*)/\$2<\/em\>/gs; diff --git a/system/modules/PluginBase.pm b/system/modules/PluginBase.pm index 0a74e2a..aa89baa 100644 --- a/system/modules/PluginBase.pm +++ b/system/modules/PluginBase.pm @@ -1,40 +1,38 @@ -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); diff --git a/system/modules/RSSFeedsPlugin.pm b/system/modules/RSSFeedsPlugin.pm index dde719e..1fae306 100644 --- a/system/modules/RSSFeedsPlugin.pm +++ b/system/modules/RSSFeedsPlugin.pm @@ -1,12 +1,14 @@ 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; @@ -18,7 +20,9 @@ use LWP::Simple; use Benchmark; -use constant VERSION => '1.2'; + + + our %MHDR = %CNFMeta::TABLE_HEADER; our $TZ; @@ -95,7 +99,7 @@ sub collectFeeds($self, $parser) { 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 @@ -106,7 +110,7 @@ sub collectFeeds($self, $parser) { #$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})){ @@ -129,7 +133,7 @@ sub collectFeeds($self, $parser) { } } }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; @@ -219,7 +223,7 @@ sub fetchFeed($self, $cnf_parser, $name, $url, $expires, $description){ } } } - unless ( -e $fname ) { + unless ( -e $fname ) { no warnings 'experimental::try'; try{ $cnf_parser->log("Fetching: $fname -> [$url] ..."); my $res = getstore($url, $fname); @@ -229,7 +233,7 @@ sub fetchFeed($self, $cnf_parser, $name, $url, $expires, $description){ $cnf_parser->error("Error<$res>!\n"); `curl $url -o $fname` } - }catch{ + }catch($e){ $cnf_parser->error( "Error: $@.\n"); return; } diff --git a/system/modules/TestManager.pm b/system/modules/TestManager.pm index 546b694..18700fe 100644 --- a/system/modules/TestManager.pm +++ b/system/modules/TestManager.pm @@ -4,21 +4,24 @@ # 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. @@ -26,15 +29,15 @@ use Cwd qw(getcwd); $CWD = getcwd; ### 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; } @@ -54,7 +57,7 @@ sub failed { ++$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 } @@ -64,19 +67,22 @@ sub passed { 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 } @@ -275,7 +281,7 @@ sub dumpTermination { 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"; @@ -299,6 +305,14 @@ sub dumpTermination { ($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"); @@ -311,8 +325,8 @@ sub dumpTermination { 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*(\#.*)/){ diff --git a/system/modules/CNFParser.2.2.pm b/system/modules/deprecated/CNFParser.2.2.pm similarity index 100% rename from system/modules/CNFParser.2.2.pm rename to system/modules/deprecated/CNFParser.2.2.pm diff --git a/system/modules/CNFParser.2.4.pm b/system/modules/deprecated/CNFParser.2.4.pm similarity index 100% rename from system/modules/CNFParser.2.4.pm rename to system/modules/deprecated/CNFParser.2.4.pm diff --git a/tests/TestBase.pm b/tests/TestBase.pm index 35b5e25..a82cc50 100644 --- a/tests/TestBase.pm +++ b/tests/TestBase.pm @@ -1,18 +1,79 @@ 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; diff --git a/tests/testAll.pl b/tests/testAll.pl index da65815..37df3fb 100644 --- a/tests/testAll.pl +++ b/tests/testAll.pl @@ -3,23 +3,19 @@ # 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 @@ -49,11 +45,11 @@ foreach my $arg(@ARGV){ ### 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." $!"; @@ -65,9 +61,9 @@ try{ 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"; @@ -78,12 +74,12 @@ try{ $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'){ @@ -93,7 +89,7 @@ try{ 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; @@ -122,7 +118,7 @@ try{ 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",; } @@ -135,7 +131,7 @@ try{ 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; } @@ -152,11 +148,11 @@ try{ 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 diff --git a/tests/testAppSettings.pl b/tests/testAppSettings.pl index 2f93b52..4b7f0f3 100644 --- a/tests/testAppSettings.pl +++ b/tests/testAppSettings.pl @@ -1,14 +1,12 @@ #!/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."); @@ -18,7 +16,7 @@ use Syntax::Keyword::Try; try { 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( <Sample App>> < @@ -29,6 +27,8 @@ use Syntax::Keyword::Try; try { >> )); + $parser->log("Started testing AppSettings."); + my $app_settings = $parser->property('CONFIG_SETTINGS'); $test -> isDefined("CONFIG_SETTINGS",$app_settings); @@ -74,12 +74,14 @@ use Syntax::Keyword::Try; try { $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(); } diff --git a/tests/testCLIArgumentOptions.pl b/tests/testCLIArgumentOptions.pl index f388c37..5036151 100644 --- a/tests/testCLIArgumentOptions.pl +++ b/tests/testCLIArgumentOptions.pl @@ -1,19 +1,13 @@ #!/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. # @@ -26,7 +20,7 @@ try{ 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. @@ -41,10 +35,10 @@ try{ 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!") } # @@ -56,11 +50,7 @@ try{ $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 diff --git a/tests/testCNF2JSON.pl b/tests/testCNF2JSON.pl index b2f6e9a..b1a224d 100644 --- a/tests/testCNF2JSON.pl +++ b/tests/testCNF2JSON.pl @@ -1,12 +1,11 @@ -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."); @@ -82,8 +81,8 @@ use Syntax::Keyword::Try; try { $test->done(); # } -catch{ - $test -> dumpTermination($@); +catch($e){ + $test -> dumpTermination($e); $test->doneFailed(); } diff --git a/tests/testCNFAnons.pl b/tests/testCNFAnons.pl index 0bacf95..fa391c7 100644 --- a/tests/testCNFAnons.pl +++ b/tests/testCNFAnons.pl @@ -1,13 +1,11 @@ #!/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. @@ -136,8 +134,8 @@ try{ $test->done(); # } -catch{ - $test -> dumpTermination($@); +catch($e){ + $test -> dumpTermination($e); $test -> doneFailed(); } diff --git a/tests/testCNFCollections.pl b/tests/testCNFCollections.pl index ce5cdbe..886172c 100644 --- a/tests/testCNFCollections.pl +++ b/tests/testCNFCollections.pl @@ -1,13 +1,11 @@ #!/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. @@ -63,8 +61,8 @@ ask: How are you today? $test->done(); # } -catch{ - $test -> dumpTermination($@); +catch ($e){ + $test -> dumpTermination($e); $test -> doneFailed(); } diff --git a/tests/testCNFConstant1.pl b/tests/testCNFConstant1.pl index ca32b3b..3e37486 100644 --- a/tests/testCNFConstant1.pl +++ b/tests/testCNFConstant1.pl @@ -1,12 +1,11 @@ #!/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. @@ -21,7 +20,7 @@ try{ 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."); } @@ -30,8 +29,8 @@ try{ 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.") } # ### @@ -53,13 +52,13 @@ try{ 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.'); } @@ -101,7 +100,7 @@ try{ ### - # 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. @@ -124,12 +123,11 @@ try{ } } - # $test->done(); # } -catch{ - $test -> dumpTermination($@); - $test -> doneFailed(); +catch($e){ + $test -> dumpTermination($e); + $test -> doneFailed(); } diff --git a/tests/testCNFConstant2.pl b/tests/testCNFConstant2.pl index 0ae5ca5..0328a58 100644 --- a/tests/testCNFConstant2.pl +++ b/tests/testCNFConstant2.pl @@ -1,11 +1,11 @@ #!/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. @@ -17,14 +17,14 @@ try{ 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!"); } @@ -37,7 +37,7 @@ try{ $test->isDefined('MyConstant',$val); $test->evaluate('MyConstant',"Can't be changed!",$val); - }catch{ + }catch($e){ $test->failed("Failed to import methods"); } @@ -45,7 +45,7 @@ try{ $test->done(); # } -catch{ - $test -> dumpTermination($@); +catch($e){ + $test -> dumpTermination($e); $test -> doneFailed(); } diff --git a/tests/testCNFGlobalFile.pl b/tests/testCNFGlobalFile.pl index 7bcd587..7412537 100644 --- a/tests/testCNFGlobalFile.pl +++ b/tests/testCNFGlobalFile.pl @@ -1,15 +1,11 @@ #!/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. @@ -30,7 +26,7 @@ use Syntax::Keyword::Try; try { $test->done(); # } -catch{ - $test -> dumpTermination($@); +catch($e){ + $test -> dumpTermination($e); $test->doneFailed(); } diff --git a/tests/testCNFMeta.pl b/tests/testCNFMeta.pl index 763bb67..a3e4c26 100644 --- a/tests/testCNFMeta.pl +++ b/tests/testCNFMeta.pl @@ -1,13 +1,12 @@ -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."); @@ -62,7 +61,7 @@ use Syntax::Keyword::Try; try { $test->done(); # } -catch{ - $test -> dumpTermination($@); +catch($e){ + $test -> dumpTermination($e); $test->doneFailed(); } diff --git a/tests/testCNFNode.pl b/tests/testCNFNode.pl index ba50987..da6fe73 100644 --- a/tests/testCNFNode.pl +++ b/tests/testCNFNode.pl @@ -1,15 +1,11 @@ #!/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. @@ -291,7 +287,7 @@ __/ $test->done(); # } -catch{ - $test -> dumpTermination($@); +catch($e){ + $test -> dumpTermination($e); $test->doneFailed(); } diff --git a/tests/testCNFNodeShortiefs.pl b/tests/testCNFNodeShortiefs.pl index a5809a6..a6fb108 100644 --- a/tests/testCNFNodeShortiefs.pl +++ b/tests/testCNFNodeShortiefs.pl @@ -1,16 +1,7 @@ #!/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; @@ -18,7 +9,7 @@ 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(); @@ -256,7 +247,7 @@ Giving no advice. $test->done(); # } -catch{ +catch($e){ $test -> dumpTermination($@); $test -> doneFailed(); } diff --git a/tests/testCNFParserLogging.pl b/tests/testCNFParserLogging.pl index a4a5936..f11cccc 100644 --- a/tests/testCNFParserLogging.pl +++ b/tests/testCNFParserLogging.pl @@ -1,21 +1,13 @@ #!/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. # @@ -43,8 +35,8 @@ try{ $test->done(); # } -catch{ - $test -> dumpTermination($@); +catch($e){ + $test -> dumpTermination($e); $test -> doneFailed(); } diff --git a/tests/testCNFTypeTranslationSpecifiers.pl b/tests/testCNFTypeTranslationSpecifiers.pl index d89b244..5972e32 100644 --- a/tests/testCNFTypeTranslationSpecifiers.pl +++ b/tests/testCNFTypeTranslationSpecifiers.pl @@ -1,13 +1,13 @@ #!/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. ### @@ -95,7 +95,7 @@ TestINT:1024 }catch($e){ - $test->dumpTermination($@); + $test->dumpTermination($e); $test->doneFailed(); } diff --git a/tests/testCRONSchedular.pl b/tests/testCRONSchedular.pl index c420106..9fb5f72 100644 --- a/tests/testCRONSchedular.pl +++ b/tests/testCRONSchedular.pl @@ -1,19 +1,15 @@ #!/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} @@ -93,7 +89,7 @@ $test->done(); } -catch{ - $test -> dumpTermination($@); +catch($e){ + $test -> dumpTermination($e); $test -> doneFailed(); } diff --git a/tests/testCartesianProduct.pl b/tests/testCartesianProduct.pl index 355c51c..98a4df4 100644 --- a/tests/testCartesianProduct.pl +++ b/tests/testCartesianProduct.pl @@ -1,19 +1,15 @@ #!/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."); @@ -46,8 +42,8 @@ try{ $test->done(); # } -catch { - $test -> dumpTermination($@); +catch($e){ + $test -> dumpTermination($e); $test -> doneFailed(); } diff --git a/tests/testCocoonCodeGeneration.pl b/tests/testCocoonCodeGeneration.pl index 4b45b81..3d252a0 100644 --- a/tests/testCocoonCodeGeneration.pl +++ b/tests/testCocoonCodeGeneration.pl @@ -1,15 +1,14 @@ #!/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"); @@ -21,9 +20,9 @@ use Syntax::Keyword::Try; try { $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!"); } # @@ -47,7 +46,7 @@ use Syntax::Keyword::Try; try { $test->done(); # } -catch{ - $test -> dumpTermination($@); +catch($e){ + $test -> dumpTermination($e); $test -> doneFailed(); } diff --git a/tests/testCollections.pl b/tests/testCollections.pl index 5b9c019..2360af3 100644 --- a/tests/testCollections.pl +++ b/tests/testCollections.pl @@ -1,15 +1,13 @@ #!/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. @@ -82,8 +80,8 @@ $test->evaluate('@array last element is file2.cnf?', pop @array , 'file2.cnf'); $test->done(); # } -catch{ - $test -> dumpTermination($@); +catch($e){ + $test -> dumpTermination($e); $test -> doneFailed(); } diff --git a/tests/testData.pl b/tests/testData.pl index 12d6512..0ec056b 100644 --- a/tests/testData.pl +++ b/tests/testData.pl @@ -1,17 +1,12 @@ #!/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. @@ -71,8 +66,8 @@ try{ $test->done(); # } -catch{ - $test -> dumpTermination($@); +catch($e){ + $test -> dumpTermination($e); $test -> doneFailed(); } diff --git a/tests/testDateInstruction.pl b/tests/testDateInstruction.pl index dd96f23..a3d7a29 100644 --- a/tests/testDateInstruction.pl +++ b/tests/testDateInstruction.pl @@ -1,18 +1,13 @@ #!/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(); @@ -114,8 +109,8 @@ try{ $test->done(); # } -catch{ - $test -> dumpTermination($@); +catch($e){ + $test -> dumpTermination($e); $test -> doneFailed(); } diff --git a/tests/testDoAndLIb.pl b/tests/testDoAndLIb.pl index d111a44..028ccfc 100644 --- a/tests/testDoAndLIb.pl +++ b/tests/testDoAndLIb.pl @@ -1,13 +1,11 @@ #!/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."); @@ -64,7 +62,7 @@ use Syntax::Keyword::Try; try { $test->done(); # } -catch{ - $test -> dumpTermination($@); - $test->doneFailed(); +catch($e){ + $test -> dumpTermination($e); + $test -> doneFailed(); } diff --git a/tests/testExperimental.pl b/tests/testExperimental.pl index 930ff0c..387a8e1 100644 --- a/tests/testExperimental.pl +++ b/tests/testExperimental.pl @@ -1,18 +1,12 @@ #!/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."); @@ -167,14 +161,14 @@ Hello World!`~ 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(); } diff --git a/tests/testExtensions.pl b/tests/testExtensions.pl index 9a7d664..8b3f908 100644 --- a/tests/testExtensions.pl +++ b/tests/testExtensions.pl @@ -1,14 +1,14 @@ #!/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. # @@ -33,7 +33,7 @@ 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{ + }catch($e){ $test->isDefined("SOME_CONSTANCE",$cnf->{SOME_CONSTANCE}); } @@ -41,7 +41,7 @@ try{ $test->done(); # } -catch{ +catch($e){ $test -> dumpTermination($@); $test -> doneFailed(); } diff --git a/tests/testHTMLConversion.pl b/tests/testHTMLConversion.pl index 3dca149..b2d9c32 100644 --- a/tests/testHTMLConversion.pl +++ b/tests/testHTMLConversion.pl @@ -1,15 +1,14 @@ -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 { @@ -98,9 +97,9 @@ use Syntax::Keyword::Try; try { $test->done(); # } -catch{ - $test -> dumpTermination($@); - $test->doneFailed(); +catch($e){ + $test -> dumpTermination($e); + $test -> doneFailed(); } diff --git a/tests/testHTMLMarkdown.pl b/tests/testHTMLMarkdown.pl index 9ef9024..1342dde 100644 --- a/tests/testHTMLMarkdown.pl +++ b/tests/testHTMLMarkdown.pl @@ -1,13 +1,13 @@ -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(); @@ -75,9 +75,8 @@ use Syntax::Keyword::Try; try { $test->done(); # } -catch{ - $test -> dumpTermination($@); +catch($e){ + $test -> dumpTermination($e); $test -> doneFailed(); } - diff --git a/tests/testHTMLPossibleTagged.pl b/tests/testHTMLPossibleTagged.pl index 538fea2..e13e6ef 100644 --- a/tests/testHTMLPossibleTagged.pl +++ b/tests/testHTMLPossibleTagged.pl @@ -1,9 +1,7 @@ #!/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); @@ -62,7 +60,7 @@ package TestHTMLPlugin { } } -use Syntax::Keyword::Try; try { +no warnings 'experimental::try'; no warnings 'once'; try { ### # Test inside tag/macro in value. ### @@ -113,7 +111,7 @@ ut error itaque eum doloribus sint.`~ try { $cnf->{'$DEBUG'} = 'false' } - catch { + catch($e) { $test->subcase( "Passed keep constant test for \$cnf->DEBUG=$cnf->{DEBUG}"); } @@ -171,7 +169,7 @@ ut error itaque eum doloribus sint.`~ # 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}"); } @@ -183,9 +181,9 @@ ut error itaque eum doloribus sint.`~ $test->done(); # } -catch{ - $test -> dumpTermination($@); - $test->doneFailed(); +catch($e){ + $test -> dumpTermination($e); + $test -> doneFailed(); } diff --git a/tests/testInclude.pl b/tests/testInclude.pl index f1a01bad..2d2b37f 100644 --- a/tests/testInclude.pl +++ b/tests/testInclude.pl @@ -1,16 +1,13 @@ #!/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. # @@ -28,8 +25,8 @@ try{ $test->done(); # } -catch { - $test -> dumpTermination($@); +catch($e){ + $test -> dumpTermination($e); $test -> doneFailed(); } diff --git a/tests/testInstructor.pl b/tests/testInstructor.pl index 3026727..f65ce5a 100644 --- a/tests/testInstructor.pl +++ b/tests/testInstructor.pl @@ -1,16 +1,13 @@ #!/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. # @@ -36,7 +33,7 @@ try{ )); 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."); } @@ -87,8 +84,8 @@ try{ $test -> done(); # } -catch{ - $test -> dumpTermination($@); +catch($e){ + $test -> dumpTermination($e); $test -> doneFailed(); } diff --git a/tests/testMarkDownPlugin_MD2HTMLConversion.pl b/tests/testMarkDownPlugin_MD2HTMLConversion.pl index 7c05d5d..299c486 100644 --- a/tests/testMarkDownPlugin_MD2HTMLConversion.pl +++ b/tests/testMarkDownPlugin_MD2HTMLConversion.pl @@ -1,14 +1,13 @@ -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(); @@ -98,7 +97,7 @@ use Syntax::Keyword::Try; try { $test->done(); # } -catch{ - $test -> dumpTermination($@); - $test->doneFailed(); +catch($e){ + $test -> dumpTermination($e); + $test -> doneFailed(); } diff --git a/tests/testNewTagParsingForVersion2.8.pl b/tests/testNewTagParsingForVersion2.8.pl index 496bcdd..c795427 100644 --- a/tests/testNewTagParsingForVersion2.8.pl +++ b/tests/testNewTagParsingForVersion2.8.pl @@ -1,13 +1,11 @@ #!/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. @@ -110,9 +108,9 @@ use Syntax::Keyword::Try; try { $test->done(); # } -catch{ - $test -> dumpTermination($@); - $test->doneFailed(); +catch($e){ + $test -> dumpTermination($e); + $test -> doneFailed(); } diff --git a/tests/testPerlKeywords.pl b/tests/testPerlKeywords.pl index 2b0273e..7552ed1 100644 --- a/tests/testPerlKeywords.pl +++ b/tests/testPerlKeywords.pl @@ -1,17 +1,14 @@ #!/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; @@ -59,10 +56,11 @@ try{ $test->done(); # } -catch{ - $test -> dumpTermination($@); +catch($e){ + $test -> dumpTermination($e); $test -> doneFailed(); } + diff --git a/tests/testPlugin.pl b/tests/testPlugin.pl index 78f260d..298bbff 100644 --- a/tests/testPlugin.pl +++ b/tests/testPlugin.pl @@ -1,16 +1,14 @@ #!/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. # @@ -24,8 +22,8 @@ try{ $test->done(); # } -catch{ - $test -> dumpTermination($@); +catch($e){ + $test -> dumpTermination($e); $test -> doneFailed(); } diff --git a/tests/testProcessor.pl b/tests/testProcessor.pl index f87cb29..d2f7511 100644 --- a/tests/testProcessor.pl +++ b/tests/testProcessor.pl @@ -1,14 +1,13 @@ #!/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."); @@ -25,8 +24,8 @@ try{ #If STRICT is true parser will throw error, accessing from here. $test -> done(); # } -catch{ - $test -> dumpTermination($@); +catch($e){ + $test -> dumpTermination($e); $test -> doneFailed(); } diff --git a/tests/testSQL.pl b/tests/testSQL.pl index 6f540d7..5d08be9 100644 --- a/tests/testSQL.pl +++ b/tests/testSQL.pl @@ -1,19 +1,17 @@ #!/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."); @@ -135,7 +133,7 @@ ID _INT_`NAME _TEXT_~ $test->done(); # } -catch{ - $test -> dumpTermination($@); +catch($e){ + $test -> dumpTermination($e); $test -> doneFailed(); } diff --git a/tests/testSQLPostgres.pl b/tests/testSQLPostgres.pl index 03858f2..1cda857 100644 --- a/tests/testSQLPostgres.pl +++ b/tests/testSQLPostgres.pl @@ -1,12 +1,8 @@ #!/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; @@ -17,7 +13,7 @@ my $DB_SETTINGS = qq( 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."); @@ -43,8 +39,8 @@ try{ $test->done(); # } -catch{ - $test -> dumpTermination($@); +catch($e){ + $test -> dumpTermination($e); $test -> doneFailed(); } diff --git a/tests/testSQLPostgres_on_elite.pl b/tests/testSQLPostgres_on_elite.pl index c15e8d7..18c9ecf 100644 --- a/tests/testSQLPostgres_on_elite.pl +++ b/tests/testSQLPostgres_on_elite.pl @@ -1,14 +1,9 @@ #!/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; @@ -25,7 +20,7 @@ my $DB_SETTINGS = q( <<>> ); -try{ +no warnings 'experimental::try'; no warnings 'once'; try{ die $test->failed() @@ -196,8 +191,8 @@ There is: $test->done(); # } -catch{ - $test -> dumpTermination($@); +catch($e){ + $test -> dumpTermination($e); $test -> doneFailed(); } diff --git a/tests/testSQL_Export_Import_To_CNF_DATA.pl b/tests/testSQL_Export_Import_To_CNF_DATA.pl index 724c07f..fdbbc75 100644 --- a/tests/testSQL_Export_Import_To_CNF_DATA.pl +++ b/tests/testSQL_Export_Import_To_CNF_DATA.pl @@ -1,18 +1,14 @@ #!/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."); @@ -55,7 +51,7 @@ select * from LOG where aflag == 2 order by DATE DESC; $test->done(); # } -catch{ - $test -> dumpTermination($@); +catch($e){ + $test -> dumpTermination($e); $test -> doneFailed(); } diff --git a/tests/testSQL_TaskList.pl b/tests/testSQL_TaskList.pl index a2d94d2..7ca2d62 100644 --- a/tests/testSQL_TaskList.pl +++ b/tests/testSQL_TaskList.pl @@ -1,19 +1,17 @@ #!/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 $/;}; $cnf = CNFParser->new(undef,{DO_ENABLED=>1,DEBUG=>1,'%LOG'=>{console=>1},TZ=>"Australia/Sydney"}); $cnf->parse(undef,$content); @@ -34,8 +32,8 @@ try{ $test->done(); # } -catch{ - $test -> dumpTermination($@); +catch($e){ + $test -> dumpTermination($e); $test -> doneFailed(); } @@ -43,7 +41,7 @@ __DATA__ !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 __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~ >>< __SQL_TABLE__ diff --git a/tests/testSQL_map_macro.pl b/tests/testSQL_map_macro.pl index 048383c..c1a6097 100644 --- a/tests/testSQL_map_macro.pl +++ b/tests/testSQL_map_macro.pl @@ -1,6 +1,8 @@ #!/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'); @@ -13,7 +15,7 @@ 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."); @@ -103,7 +105,7 @@ ID _INT_`NAME _TEXT_~ $test->done(); # } -catch{ - $test -> dumpTermination($@); +catch($e){ + $test -> dumpTermination($e); $test -> doneFailed(); } diff --git a/tests/testShortLinks.pl b/tests/testShortLinks.pl index 38910db..5d75944 100644 --- a/tests/testShortLinks.pl +++ b/tests/testShortLinks.pl @@ -1,12 +1,13 @@ -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."); @@ -68,7 +69,7 @@ $test->done(); # say "dcp[".length($xdecomp)."]:".$xdecomp; } -catch{ - $test -> dumpTermination($@); +catch($e){ + $test -> dumpTermination($e); $test->doneFailed(); } \ No newline at end of file diff --git a/tests/testTree.pl b/tests/testTree.pl index d4e72ec..5dddc1e 100644 --- a/tests/testTree.pl +++ b/tests/testTree.pl @@ -1,16 +1,12 @@ #!/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( @@ -218,7 +214,7 @@ $test->evaluate("\$TEST/test",$nada,'me too'); } -catch { +catch($e) { $test -> dumpTermination($@); $test -> doneFailed(); } diff --git a/tests/testTreeToHTML.pl b/tests/testTreeToHTML.pl index c8a56e2..7a93740 100644 --- a/tests/testTreeToHTML.pl +++ b/tests/testTreeToHTML.pl @@ -1,16 +1,12 @@ #!/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."); @@ -132,7 +128,7 @@ PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" } -catch { - $test -> dumpTermination($@); +catch($e) { + $test -> dumpTermination($e); $test -> doneFailed(); } diff --git a/tests/testWorldCitiesDataHandling.pl b/tests/testWorldCitiesDataHandling.pl index 548fd32..b04d3c0 100644 --- a/tests/testWorldCitiesDataHandling.pl +++ b/tests/testWorldCitiesDataHandling.pl @@ -1,15 +1,12 @@ #!/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. @@ -61,7 +58,7 @@ try{ $test->done(); # } -catch{ - $test -> dumpTermination($@); +catch($e){ + $test -> dumpTermination($e); $test -> doneFailed(); }