Upgrade to v.3.36.+ perl compatibility.

diff --git a/system/modules/CNF.pm b/system/modules/CNF.pm
index 4286a2f361dbaa000da444db00221fd405f63dca..1ac4b552272440c91f6076ab6dc1716f236fdae2 100644 (file)
--- a/system/modules/CNF.pm
+++ b/system/modules/CNF.pm
@@ -1,9 +1,11 @@
 ###
 # Base Class for the Configuration Network File Format.
 ##
 ###
 # 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 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 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)
 # 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){
     }
     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;
             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;
                 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;
         }
         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 = 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{
     }
 
     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);
             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){
         }
     }catch($e){

-        CNFParserException->throw(error=>$e);
+        throw_exception(error=>$e);

     }
     flush($fh);
     }
     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.
 }
 ###
 # 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.
            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 (file)
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 (file)
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 d9f14f6ea846b0f31bd6664beb3b42a66d2a9527..58cbb33181639c66747940f45c247199e65c2b32 100644 (file)
--- 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) =@_;
 
 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;
 }
 
     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.
     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 26ef2a508de9fdb2dc68f9bed50ae886da38f482..97fb0aa9231f7496475656060ebc52852e2447ee 100644 (file)
--- 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;
 # 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.
 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){
 sub _meta {
     my $constance = shift;
     if($constance){

-        return qr/\s*\_+$constance\_+/
+        return qr/\s*\_+$constance\_+\s*/

     }
     $constance;
 }
     }
     $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];
     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 c76de3b4f02a2f3c464b134811c892abe0d34358..e79666fe4fa2ec8c1f56bb09814d2de31b4d2080 100644 (file)
--- a/system/modules/CNFParser.pm
+++ b/system/modules/CNFParser.pm
@@ -2,17 +2,16 @@
 # Main Parser for the Configuration Network File Format.
 ##
 package CNFParser;
 # 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 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 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;
 
 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.
         };
     }
                   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;
 
     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};
 ###
 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};
     # 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(
                             $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;
                                 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;
 #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};
     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;
                 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>>'
             }
                     $self->warn("Module DO_ENABLED library failed to load: $v\n");
                     $anechoic->{$e} = '<<ERROR>>'
             }


@@ -800,6 +800,30 @@ sub doDATAInstructions_{ my ($self,$e,$v,$t,$d)=@_;
 sub parseString{
     return parse(shift,undef,shift)
 }
 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.
 ##
 ###
 # 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;
 
      # 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 ){
     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;
         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'){
         }
     }else{
         my $type = Scalar::Util::reftype($content);
         if($type && $type eq 'ARRAY'){

-           $content = join  "",@$content;
+           $content = join  "", @$content;

            $self->{CNF_CONTENT} = 'ARRAY';
            $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);
         }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]?))
     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){
     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{
                    $lists{$e} = \@array;
                    next;
                 }else{

-                    doInstruction($self,$e,$t,$v)
+                   doInstruction($self,$e,$t,$v)

                 }
 
             }elsif ($e =~ m/^@|%/){#collection processing?
                 }
 
             }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{
             }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){
             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){
             }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;
                   ## 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 ?"}
         }
                }
             }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'){
 
 sub transitionValueFromInstruction { my ($self, $ele, $instruction, $type, $val) = @_;
     if($instruction eq 'int'){

-       return int($val) 
+       return int($val)

     }
     elsif($instruction eq 'date'){
     }
     elsif($instruction eq 'date'){

-       return $self->toCNFDate($val) 
+       return $self->toCNFDate($val)

     }
     elsif($instruction eq 'list'){
        return  split(DELIMITER(), $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. <<instance<do><CONST>PerlPackageName(,..)>>
         if($self->{'DO_ENABLED'}){
            $type = 'DO';    $instruction = InstructedProcessItem->new($ele, $type, $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")
         }
         }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 !~ /::/;
             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;
                  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 @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);
                 }
                           $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")
     }
             }
     }else{
            $self->warn("DO_ENABLED is set to false to do instruction -> ($ele, $instruction, $val) \n")
     }

-    return $val;   
+    return $val;

 }
 #
     sub includeContains{
 }
 #
     sub includeContains{


@@ -1188,9 +1225,9 @@ sub instructPlugin {
         $properties{$struct->{'ele'}} = $plugin;
         $self->log("Plugin instructed -> ".
         $plugin->{element}.'<'.$plugin->{package}.'>.'.$plugin->{subroutine}.'('.$plugin->{property}.')');
         $properties{$struct->{'ele'}} = $plugin;
         $self->log("Plugin instructed -> ".
         $plugin->{element}.'<'.$plugin->{package}.'>.'.$plugin->{subroutine}.'('.$plugin->{property}.')');

-    }catch($e){
+    }catch($eIns){

         if($self->{STRICT}){
         if($self->{STRICT}){

-            CNFParserException->throw(error=>$e);
+            CNFParserException->throw(error=>$eIns);

         }else{
             $self->trace("Error @ ".$struct->{ins}." -> ". $struct->toString() ." Error-> $@")
         }
         }else{
             $self->trace("Error @ ".$struct->{ins}." -> ". $struct->toString() ." Error-> $@")
         }


@@ -1315,6 +1352,7 @@ sub addPostParseProcessor {
     $self->{POSTParseProcessors} = \@arr;
 }
 
     $self->{POSTParseProcessors} = \@arr;
 }
 

+use feature qw(signatures);

 sub runPostParseProcessors {
     my $self = shift;
     my $arr = $self->{POSTParseProcessors} if exists $self->{POSTParseProcessors};
 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};
     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)
     if($instructor eq APP_STS){
         $pck = 'ClassicAppSettings' if ! $pck;
         ## no critic (RequireBarewordIncludes)


@@ -1466,8 +1505,12 @@ sub doPlugin {
         return $plugin;
     }
     elsif($pck && $prp && $sub){
         return $plugin;
     }
     elsif($pck && $prp && $sub){

+       try{

         ## no critic (RequireBarewordIncludes)
         require "$pck.pm" if $pck !~ /::/;
         ## 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){
         #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->{$_}
            } ;
         }
                 $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{
         }
     }
     else{


@@ -1501,6 +1550,7 @@ sub obtainLink {
     ## no critic BuiltinFunctions::ProhibitStringyEval
     no strict 'refs';
     if($link =~/(\w*)::\w+$/){
     ## 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);
         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){
            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
            }
         }
             $ret = $link
            }
         }

diff --git a/system/modules/CNFSQL.pm b/system/modules/CNFSQL.pm
index 67ca696ed94c297e76d8c5a9854cbe2083f7727e..d2b8f5625202ed28ffaf40fa4125ac5331430383 100644 (file)
--- 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;
 # SQL Processing part for the Configuration Network File Format.
 ###
 package CNFSQL;

-

 use strict;use warnings;#use warnings::unused;
 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 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  = ();
 
 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 '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);
                 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();
             }
         }
         $db->commit();


@@ -133,9 +135,13 @@ try{
                     $sqlSEL->execute($key);
                     my @a = $sqlSEL->fetchrow_array();
                     if(@a==0){
                     $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){
                     }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;
 
                 $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{
             }
         }
         else{


@@ -432,13 +438,13 @@ transaction:{
     undef %tables_create_stmts; undef %tables_id_type;
     undef %views;
 }
     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 = ""
   }
   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');
 }
 }
 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});
     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 $@
     }
 }
        die $@
     }
 }


@@ -551,7 +557,7 @@ my @r  = $st->fetchrow_array();
         while(!$r[5]){
             @r  = $st->fetchrow_array();
             if(!@r){
         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]."=?";
             }
         }
         return $r[1]."=?";


@@ -568,8 +574,8 @@ sub selectCNFConfigRecords {
                     $ret{$row[0]} = \[$row[1], $row[2]]
             }
         return \%ret;
                     $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';");
 
     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;
         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
     }
 }
 #@deprecated


@@ -604,7 +610,7 @@ sub tableExists { my ($self, $db, $tbl_stm_name) = @_;
     try{
         $db->do("select count(*) from $tbl_stm_name;");
         return 1;
     try{
         $db->do("select count(*) from $tbl_stm_name;");
         return 1;

-     }catch{}
+     }catch($e){}

      return 0;
 }
 ###
      return 0;
 }
 ###

diff --git a/system/modules/Cocoon.pm b/system/modules/Cocoon.pm
index 52a753ded3de5b69a14544e2bbec93c4d5a44ae6..af33fce2815d803d7719f83fe7424f3729ae88a9 100644 (file)
--- 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(
                     <<COCOON_KEY<$cocoon_key>>>
                 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~
                     >>
                     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 db4239aa9c75c24ecb4c2e456a0f2f344f54ae4c..638231b1842dc7bd1ba3dc2f4f6943b5a54848fa 100644 (file)
--- a/system/modules/DataProcessorPlugin.pm
+++ b/system/modules/DataProcessorPlugin.pm
@@ -1,7 +1,10 @@
 package DataProcessorPlugin;
 package DataProcessorPlugin;

+use feature qw(signatures try);

 use PluginBase;
 use PluginBase;

+use CNFExceptions qw(throw_plugin_error);

 use Date::Manip;
 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;
 
 sub new ($class, $plugin){
     my $settings;


@@ -113,8 +116,8 @@ try{
             shift @rows if($knock_out);
         $$table->{data} = \@rows;
         $$table->{data_processed} = 1;
             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
 }
     }
 return 1

diff --git a/system/modules/DataProcessorWorldCitiesPlugin.pm b/system/modules/DataProcessorWorldCitiesPlugin.pm
index 83249eaffa8c2b6ed8cee80b70c211a18d567b21..fb2f115320b97923cf8a246d1ac77f68ade43262 100644 (file)
--- a/system/modules/DataProcessorWorldCitiesPlugin.pm
+++ b/system/modules/DataProcessorWorldCitiesPlugin.pm
@@ -1,5 +1,9 @@
 package DataProcessorWorldCitiesPlugin;
 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
 # @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 1fea9fdbdce7c816ffa442c76a4e8bcc9f54cab7..48d8fdffa9a1666323b3cea9704e834942b4814d 100644 (file)
--- a/system/modules/DatabaseCentralPlugin.pm
+++ b/system/modules/DatabaseCentralPlugin.pm
@@ -7,14 +7,14 @@
 ###
 package DatabaseCentralPlugin;
 use PluginBase;
 ###
 package DatabaseCentralPlugin;
 use PluginBase;

-use Exception::Class ('DBCentralPluginException');
-
-use Time::Piece;
+use CNFExceptions qw(throw_plugin_error);

 use DBI;
 use DBI;

+use Time::Piece;

 use Date::Manip;
 
 require CNFDateTime; require CNFMeta; require CNFSQL; 
 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.
 
 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
     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>" );

 }
 }
 
 }
 }
 


@@ -153,8 +154,8 @@ sub main ($self, $parser, $property) {
                                              suppress_data_log=>$SUPPRESS_DATA_LOG},
                                                         @update);
         %CNFConfig = %{$parser -> SQL() -> selectCNFConfigRecords($db)};
                                              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.
     }
 
     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;
                 }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");
                 }
                                 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";
 
 }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){
             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());
     }
     }
          "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 504b48cf4699d7c42123f4cdf5d2693017a36c85..3860eb29571e83c83e0e3e30623a1e5bcc900651 100644 (file)
--- a/system/modules/GenericInstructionHandler.pm
+++ b/system/modules/GenericInstructionHandler.pm
@@ -1,5 +1,9 @@
 package GenericInstructionHandler;
 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;
 
 sub new {my ($class, $args) = @_; 
     bless $args, $class;

diff --git a/system/modules/HTMLIndexProcessorPlugin.pm b/system/modules/HTMLIndexProcessorPlugin.pm
index 147d749e9929a9d1748e264b081dd32943048e7c..28c6dab85674757915f0ddb5965baad7939dcc42 100644 (file)
--- a/system/modules/HTMLIndexProcessorPlugin.pm
+++ b/system/modules/HTMLIndexProcessorPlugin.pm
@@ -1,11 +1,14 @@
 package HTMLIndexProcessorPlugin;
 package HTMLIndexProcessorPlugin;

+use feature qw(signatures try);

 use PluginBase;
 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 CGI;
 use CGI::Session '-ip_match';
 

-use constant VERSION => '1.0';
+use constant VERSION => '1.1';

 
 
 sub new ($class, $plugin){
 
 
 sub new ($class, $plugin){


@@ -98,7 +101,7 @@ try{
     }
     $parser->data()->{$property} = \$buffer;
  }catch($e){
     }
     $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 {
 ###
 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>;       
     };
                     local $/;
                     <$fh>;       
     };

diff --git a/system/modules/HTMLProcessorPlugin.pm b/system/modules/HTMLProcessorPlugin.pm
index e1354ef2efd512e654ded9c52e2971620285492f..88ef54cbf4a9fbd198574d03341c576b67cf6f52 100644 (file)
--- 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;
 # 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;
 
 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');
      
     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'};
 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;
 
 
     $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 562c2a454d92f81b5638fc1d3b352b11b468650a..b76aa1c6da0a88693e12d1607a12230a4e825d25 100644 (file)
--- 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;
 # 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';
 ##no critic ControlStructures::ProhibitMutatingListFunctions
 
 use constant VERSION => '1.1';


@@ -32,6 +34,8 @@ sub new ($class, $plugin){
     return bless $settings, $class
 }
 
     return bless $settings, $class
 }
 

+no warnings 'experimental::try'; no warnings 'once'; 
+

 ###
 # Process config data to contain expected fields and data.
 ###
 ###
 # 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 {
     }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>;
        };
         local $/;
         <$fh>;
        };


@@ -98,7 +102,7 @@ try{
     $parser->data()->{$property.'_headings'} = [__PACKAGE__,'toHTML_headings',$doc[1]];
 
 }catch($e){
     $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) {    
 }}
 
 sub toHTML_headings($self,$hdrs) {    


@@ -510,7 +514,7 @@ try{
     $buff .= qq(<p>$para</p>\n) if $para;
 return [\$buff,\@titles]
 }catch($e){
     $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 code2HTML($parser, $val){


@@ -752,7 +756,7 @@ sub propValCNF($v){
 
 
 sub style ($parser, $script){
 
 
 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;
     #Links <https://duckduckgo.com>
     $script =~    s/<(http[:\/\w.]*)>/<a href=\"$1\">$1<\/a>/g;
     $script =~    s/(\*\*([^\*]*)\*\*)/\<em\>$2<\/em\>/gs;

diff --git a/system/modules/PluginBase.pm b/system/modules/PluginBase.pm
index 0a74e2a69f32b698f6d2bdcc25dfe6ac4ba24f84..aa89baa38e48d885e8ff4c32b4a264deb932920f 100644 (file)
--- 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 Scalar::Util qw(looks_like_number);
 use Clone qw(clone);
 use Module::Load;

-use Exception::Class ('PluginException');
-

 
 require Exporter;
 
 require Exporter;

-

 our $TAB = ' 'x4;
 our @ISA = qw(Exporter);
 our @EXPORT = qw($TAB);
 
 use Carp qw(confess);
 BEGIN {
 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 {
 
 }
 
 
 sub import {
 

-    
-  feature->import(':5.36');
+
+  feature->import(':5.38');
+  warnings->import;
+  strict->import;  

   feature->import('signatures');
   feature->import('signatures');

+  feature->import('try');
+  feature->import('say');

   warnings->import;
   warnings->unimport('once');
   warnings->import;
   warnings->unimport('once');

-  strict->import;  
-  Syntax::Keyword::Try->import;  
+  strict->import;
+  #Syntax::Keyword::Try->import;

   Module::Load->import;
   Carp->import('confess');
   Module::Load->import;
   Carp->import('confess');

-  Exception::Class->import('PluginException');
-
+  Clone->import('clone');
+  #Exception::Class->import('CNF_PluginException');

 
   my $caller = caller(0);
 
 
   my $caller = caller(0);
 

diff --git a/system/modules/RSSFeedsPlugin.pm b/system/modules/RSSFeedsPlugin.pm
index dde719e0157905196de5bc15c4be08e3be278e63..1fae30612111df5e3a050710302f986eda20a5d6 100644 (file)
--- a/system/modules/RSSFeedsPlugin.pm
+++ b/system/modules/RSSFeedsPlugin.pm
@@ -1,12 +1,14 @@
 package RSSFeedsPlugin;
 package RSSFeedsPlugin;

-
-use strict;
-use warnings;
-no warnings qw(experimental::signatures);

 use feature qw(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 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 Clone qw(clone);
 use Capture::Tiny 'capture_stdout';
 use FileHandle;


@@ -18,7 +20,9 @@ use LWP::Simple;
 
 use Benchmark;
 
 
 use Benchmark;
 

-use constant VERSION => '1.2';
+
+
+

 
 our %MHDR  = %CNFMeta::TABLE_HEADER;
 our $TZ;
 
 our %MHDR  = %CNFMeta::TABLE_HEADER;
 our $TZ;


@@ -95,7 +99,7 @@ sub collectFeeds($self, $parser) {
   my @lbls   = CNFMeta::_deRefArray($header[$MHDR{COL_NAMES}]);
 
 
   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
   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);
          #$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})){
          $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){
          }
   }
   }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;
     $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);
             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`
                 }
                    $cnf_parser->error("Error<$res>!\n");
                     `curl $url -o $fname`
                 }

-            }catch{
+            }catch($e){

                 $cnf_parser->error( "Error: $@.\n");
                 return;
             }
                 $cnf_parser->error( "Error: $@.\n");
                 return;
             }

diff --git a/system/modules/TestManager.pm b/system/modules/TestManager.pm
index 546b69492061c023581233752eec190af7233859..18700fed31b746f5dc50684a95eb3ff424443326 100644 (file)
--- 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.
 ##
 # 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 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;
 
 
 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.
 
 ###
 #  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) = @_;
 ###
 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 = $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;
 }
 
      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",
     ++$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
 }
 
     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",
     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;
     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'};
     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};
     $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
 }
     $self->{open}=1;
     return $self
 }


@@ -275,7 +281,7 @@ sub dumpTermination {
                         next
                     }else{
                         my $tracing = "\n".RED."tracing ->";
                         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 .= '<'.'-'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;
         ($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");
     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;
         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*(\#.*)/){
                  $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 35b5e25cc0d3c175b1fc14f30cb30124d57d67fa..a82cc50b6e3e5358905ded04091930228f1fe77c 100644 (file)
--- a/tests/TestBase.pm
+++ b/tests/TestBase.pm
@@ -1,18 +1,79 @@
 package TestBase;
 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 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 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 da65815ab3ee392599faadf40dbe8da2c65f668b..37df3fbb60213da8981ead4693d5c4902e5f71bb 100644 (file)
--- 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.
 ##
 # 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 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 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;
     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 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 '-'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, 
          --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." $!";
 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) {
 
 
     foreach my $file(sort @files) {
 

-        $file = "tests/$file";

         my ($in,$output, $warnings);
         my @perl = ('/usr/bin/env','perl');
         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";
         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;
         }
             $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){
 
         if ($warnings){
             for(split "\n", $warnings){

-                $WARN{$CWD."/$file"} = $warnings;
+                $WARN{$file} = $warnings;

             }
         }
         if(@test_ret && $test_ret[1] eq 'SUCCESS'){
             }
         }
         if(@test_ret && $test_ret[1] eq 'SUCCESS'){


@@ -93,7 +89,7 @@ try{
             push @OUT, $output;
         }else{
             $test_fail++;
             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 $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 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",;
         }
         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){
     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 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 "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";
 }
     print "\n",'-'x100, "\n";
 }

-catch{
-   $manager -> dumpTermination($@)
+catch($e){
+   $manager -> dumpTermination($e)

 }
 
 =begin copyright
 }
 
 =begin copyright

diff --git a/tests/testAppSettings.pl b/tests/testAppSettings.pl
index 2f93b526f08b83427bf0a521f635f03097b4557c..4b7f0f3fd01f2d0ead964ea45bc30c68d5eb0a3d 100644 (file)
--- a/tests/testAppSettings.pl
+++ b/tests/testAppSettings.pl
@@ -1,14 +1,12 @@
 #!/usr/bin/env perl
 #!/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);
 
 
 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.");
 
     ###
     $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"
     );
         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->parse(undef,qq(
             <<APP_NAME<CONST>Sample App>>
             <<CONFIG_SETTINGS   <APP_SETTINGS>


@@ -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);
 
         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);
 
         $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();
     #
 
     #
     $test->done();
     #

+    

 }
 }

-catch{
-   $test -> dumpTermination($@);
+catch ($e){
+   $test -> dumpTermination($e);

    $test -> doneFailed();
 }
    $test -> doneFailed();
 }

diff --git a/tests/testCLIArgumentOptions.pl b/tests/testCLIArgumentOptions.pl
index f388c377a30e49fd6eb99bb18e2728a5847a0da1..503615122eb29ae0dfa626e0c4f1ab53f0826cba 100644 (file)
--- a/tests/testCLIArgumentOptions.pl
+++ b/tests/testCLIArgumentOptions.pl
@@ -1,19 +1,13 @@
 #!/usr/bin/env perl
 #!/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;
 
 
 my $test = TestManager -> new($0) -> unsuited();
 
 my $cnf;
 

-try{
+no warnings 'experimental::try'; no warnings 'once'; try{

     ###
     # Test instance creation.
     #
     ###
     # Test instance creation.
     #


@@ -26,7 +20,7 @@ try{
     my $CNF_SCRIPT = qq{
         <<< ARGUMENTS
         -x=0            #  x,y positions.
     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.
         -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;
     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{
 
     }else{

-        $test -> failed("Arguments not have been obtained!")
+       $test -> failed("Arguments not have been obtained!")

     }
 
     #
     }
 
     #


@@ -56,11 +50,7 @@ try{
     $test->done();
     #
 }
     $test->done();
     #
 }

-catch{
-   $test -> dumpTermination($@);
+catch($e){
+   $test -> dumpTermination($e);

    $test -> doneFailed();
 }
    $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 b2f6e9a11fe31e2c24aa71f92a6ee84be0be312b..b1a224d217e4cd442ea18ae56db6f9c8fe7ed4b0 100644 (file)
--- 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);
 
 
 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->case("Test CNF to JSON.");


@@ -82,8 +81,8 @@ use Syntax::Keyword::Try; try {
     $test->done();
     #
 }
     $test->done();
     #
 }

-catch{ 
-   $test -> dumpTermination($@);
+catch($e){ 
+   $test -> dumpTermination($e);

    $test->doneFailed();
 }
 
    $test->doneFailed();
 }
 

diff --git a/tests/testCNFAnons.pl b/tests/testCNFAnons.pl
index 0bacf95bd55b0d946a7296019d1391111bad7e60..fa391c7b162cf9540e823c42cb22c83f725f1e56 100644 (file)
--- a/tests/testCNFAnons.pl
+++ b/tests/testCNFAnons.pl
@@ -1,13 +1,11 @@
 #!/usr/bin/env perl
 #!/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;
 my $test = TestManager -> new($0);
 my $cnf;

-try{  
+no warnings 'experimental::try'; no warnings 'once'; try{  

 
    ###
    # Test instance creation.
 
    ###
    # Test instance creation.


@@ -136,8 +134,8 @@ try{
    $test->done();    
    #
 }
    $test->done();    
    #
 }

-catch{ 
-   $test -> dumpTermination($@);   
+catch($e){ 
+   $test -> dumpTermination($e);   

    $test -> doneFailed();
 }
 
    $test -> doneFailed();
 }
 

diff --git a/tests/testCNFCollections.pl b/tests/testCNFCollections.pl
index ce5cdbe8d22bc496595edb3f07c4229e60f49842..886172cb0f8bb9e84502dc40becb218f35aefabc 100644 (file)
--- a/tests/testCNFCollections.pl
+++ b/tests/testCNFCollections.pl
@@ -1,13 +1,11 @@
 #!/usr/bin/env perl
 #!/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;
 my $test = TestManager -> new($0);
 my $cnf;

-try{
+no warnings 'experimental::try'; no warnings 'once'; try{

 
    ###
    # Test instance creation.
 
    ###
    # Test instance creation.


@@ -63,8 +61,8 @@ ask: How are you today?
    $test->done();
    #
 }
    $test->done();
    #
 }

-catch{
-   $test -> dumpTermination($@);
+catch ($e){
+   $test -> dumpTermination($e);

    $test -> doneFailed();
 }
 
    $test -> doneFailed();
 }
 

diff --git a/tests/testCNFConstant1.pl b/tests/testCNFConstant1.pl
index ca32b3b81b728ca06fccd4fc1a1e52e380de6b5d..3e37486bb3e679615c6cbeacebc9c5bd686bbbdd 100644 (file)
--- a/tests/testCNFConstant1.pl
+++ b/tests/testCNFConstant1.pl
@@ -1,12 +1,11 @@
 #!/usr/bin/env perl
 #!/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;
 my $test = TestManager -> new($0);
 my $cnf;

-
-try{
+no warnings 'experimental::try'; no warnings 'once'; try{

 
    ###
    # Test instance with cnf a file.
 
    ###
    # Test instance with cnf a file.


@@ -21,7 +20,7 @@ try{
        try{
          my $immutable = $cnf->{IMMUTABLE};
          $test->failed("Failed access allowed to undefined constances.")
        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.");
        }
 
          $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);
          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!');
     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!');
        $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->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.
     ###
    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();
     #
 }
     #
     $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 0ae5ca5358b4315176c60dec1058112d63ff2d1f..0328a585fbd0c39672e119c2573a44ddb744813d 100644 (file)
--- a/tests/testCNFConstant2.pl
+++ b/tests/testCNFConstant2.pl
@@ -1,11 +1,11 @@
 #!/usr/bin/env perl
 #!/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 $test = TestManager -> new($0);
 my $cnf;

-try{  
+no warnings 'experimental::try'; no warnings 'once'; try{  

 
    ###
    # Test instance creation.
 
    ###
    # Test instance creation.


@@ -17,14 +17,14 @@ try{
        try{
          $cnf->{MyConstant} = "";
          $test->failed("Constance must not be able to change!");
        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?");
          $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->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);
          
          $test->isDefined('MyConstant',$val);
          $test->evaluate('MyConstant',"Can't be changed!",$val);
          

-       }catch{
+       }catch($e){

          $test->failed("Failed to import methods");
        }
  
          $test->failed("Failed to import methods");
        }
  


@@ -45,7 +45,7 @@ try{
    $test->done();    
    #
 }
    $test->done();    
    #
 }

-catch{ 
-   $test -> dumpTermination($@);   
+catch($e){
+   $test -> dumpTermination($e);

    $test -> doneFailed();
 }
    $test -> doneFailed();
 }

diff --git a/tests/testCNFGlobalFile.pl b/tests/testCNFGlobalFile.pl
index 7bcd58786d8a1d10b8c17553f43aad2f5ef81b32..7412537196188d4d1d0972be6e0ffbce07852042 100644 (file)
--- a/tests/testCNFGlobalFile.pl
+++ b/tests/testCNFGlobalFile.pl
@@ -1,15 +1,11 @@
 #!/usr/bin/env perl
 #!/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);
 
 
 my $test = TestManager->new($0);
 

-use Syntax::Keyword::Try; try {
+no warnings 'experimental::try'; no warnings 'once'; try {

 
     ###
     # Test instance creation.
 
     ###
     # Test instance creation.


@@ -30,7 +26,7 @@ use Syntax::Keyword::Try; try {
     $test->done();
     #
 }
     $test->done();
     #
 }

-catch{
-   $test -> dumpTermination($@);
+catch($e){
+   $test -> dumpTermination($e);

    $test->doneFailed();
 }
    $test->doneFailed();
 }

diff --git a/tests/testCNFMeta.pl b/tests/testCNFMeta.pl
index 763bb675ec738503d43237dadb039f8099620a50..a3e4c26ad622271dfb8d5a1b52b20d2be2b015c0 100644 (file)
--- 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);
 
 
 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->case("Test CNFMeta regexp directly.");


@@ -62,7 +61,7 @@ use Syntax::Keyword::Try; try {
     $test->done();
     #
 }
     $test->done();
     #
 }

-catch{
-   $test -> dumpTermination($@);
+catch($e){
+   $test -> dumpTermination($e);

    $test->doneFailed();
 }
    $test->doneFailed();
 }

diff --git a/tests/testCNFNode.pl b/tests/testCNFNode.pl
index ba509876247f47742d241e6179058270a0107ede..da6fe73b99a96915ac6f78d8b142cb7c14acb47b 100644 (file)
--- a/tests/testCNFNode.pl
+++ b/tests/testCNFNode.pl
@@ -1,15 +1,11 @@
 #!/usr/bin/env perl
 #!/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);
 
 
 my $test = TestManager->new($0);
 

-use Syntax::Keyword::Try; try {
+no warnings 'experimental::try'; no warnings 'once'; try {

 
     ###
     # Test instance creation.
 
     ###
     # Test instance creation.


@@ -291,7 +287,7 @@ __/
     $test->done();
     #
 }
     $test->done();
     #
 }

-catch{
-   $test -> dumpTermination($@);
+catch($e){
+   $test -> dumpTermination($e);

    $test->doneFailed();
 }
    $test->doneFailed();
 }

diff --git a/tests/testCNFNodeShortiefs.pl b/tests/testCNFNodeShortiefs.pl
index a5809a6f10149b32dc88ab198a9f9bbd0ee46424..a6fb1086165dededf32a2ad46d16f9fed4a00027 100644 (file)
--- a/tests/testCNFNodeShortiefs.pl
+++ b/tests/testCNFNodeShortiefs.pl
@@ -1,16 +1,7 @@
 #!/usr/bin/env perl
 #!/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;
 
 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;
 # 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();
 
 
     my $parser = CNFParser->new();


@@ -256,7 +247,7 @@ Giving no advice.
     $test->done();
     #
 }
     $test->done();
     #
 }

-catch{
+catch($e){

    $test -> dumpTermination($@);
    $test -> doneFailed();
 }
    $test -> dumpTermination($@);
    $test -> doneFailed();
 }

diff --git a/tests/testCNFParserLogging.pl b/tests/testCNFParserLogging.pl
index a4a5936e1fd7d2ea593631fd17a83a1ab818cc8a..f11ccccd4ba92b04cf5467abc72509e047d4504c 100644 (file)
--- a/tests/testCNFParserLogging.pl
+++ b/tests/testCNFParserLogging.pl
@@ -1,21 +1,13 @@
 #!/usr/bin/env perl
 #!/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';
 
 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 instance creation.
     #    


@@ -43,8 +35,8 @@ try{
     $test->done();
     #
 }
     $test->done();
     #
 }

-catch{
-   $test -> dumpTermination($@);
+catch($e){
+   $test -> dumpTermination($e);

    $test -> doneFailed();
 }
 
    $test -> doneFailed();
 }
 

diff --git a/tests/testCNFTypeTranslationSpecifiers.pl b/tests/testCNFTypeTranslationSpecifiers.pl
index d89b244188b92d82768c6f5679c588ad1798b69b..5972e32421967a3c2430852bd371ed5dd3e26967 100644 (file)
--- a/tests/testCNFTypeTranslationSpecifiers.pl
+++ b/tests/testCNFTypeTranslationSpecifiers.pl
@@ -1,13 +1,13 @@
 #!/usr/bin/env perl
 #!/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 $test = TestManager->new($0);
 my $cnf;

-my $base = TestBase::base_path();

 
 

-try {
+
+no warnings 'experimental::try'; no warnings 'once'; try {

     ###
     # Test instance creation.
     ###
     ###
     # Test instance creation.
     ###


@@ -95,7 +95,7 @@ TestINT<int>:1024
 
     
 }catch($e){
 
     
 }catch($e){

-    $test->dumpTermination($@);
+    $test->dumpTermination($e);

     $test->doneFailed();
 }
 
     $test->doneFailed();
 }
 

diff --git a/tests/testCRONSchedular.pl b/tests/testCRONSchedular.pl
index c4201065eda388da01c590daa6b163915d535721..9fb5f727bcd84e598e3a233ad3fe6dd5ba81c548 100644 (file)
--- a/tests/testCRONSchedular.pl
+++ b/tests/testCRONSchedular.pl
@@ -1,19 +1,15 @@
 #!/usr/bin/env perl
 #!/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;
 
 
 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}
    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();
 }
    $test -> doneFailed();
 }

diff --git a/tests/testCartesianProduct.pl b/tests/testCartesianProduct.pl
index 355c51c43dfd1682223e8e94f9822406817bf32a..98a4df486e70e7b89e0c9da24f93e0122b3b7fd1 100644 (file)
--- a/tests/testCartesianProduct.pl
+++ b/tests/testCartesianProduct.pl
@@ -1,19 +1,15 @@
 #!/usr/bin/env perl
 #!/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;
 
 
 
 my $test = TestManager -> new($0);
 my $cnf;
 

-try{
+no warnings 'experimental::try'; no warnings 'once'; try{

 
 
     $test->case("Test Cartesian Product lib.");
 
 
     $test->case("Test Cartesian Product lib.");


@@ -46,8 +42,8 @@ try{
     $test->done();
     #
 }
     $test->done();
     #
 }

-catch {
-   $test -> dumpTermination($@);
+catch($e){
+   $test -> dumpTermination($e);

    $test -> doneFailed();
 }
 
    $test -> doneFailed();
 }
 

diff --git a/tests/testCocoonCodeGeneration.pl b/tests/testCocoonCodeGeneration.pl
index 4b45b81d6c07f2633a1c20f3cfcc85b295f9b8f2..3d252a034ba4bc048f004b6ed1a059cb3abdfbfc 100644 (file)
--- a/tests/testCocoonCodeGeneration.pl
+++ b/tests/testCocoonCodeGeneration.pl
@@ -1,15 +1,14 @@
 #!/usr/bin/env perl
 #!/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 $test = TestManager -> new($0);

+my $cnf;

 our $APP_PASS_KEY = "For now can be anything. Not just 123!";
 
 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");
 
     ###
     $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)){
     $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{
     }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();
     #
 }
     $test->done();
     #
 }

-catch{
-   $test -> dumpTermination($@);
+catch($e){
+   $test -> dumpTermination($e);

    $test -> doneFailed();
 }
    $test -> doneFailed();
 }

diff --git a/tests/testCollections.pl b/tests/testCollections.pl
index 5b9c01916ac14bf0c25356bc9aa970802fc205f1..2360af320aaa3725ce67e094514e757101c245ed 100644 (file)
--- a/tests/testCollections.pl
+++ b/tests/testCollections.pl
@@ -1,15 +1,13 @@
 #!/usr/bin/env perl
 #!/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;
 
 
 my $test = TestManager -> new($0);
 my $cnf;
 

-try{
+no warnings 'experimental::try'; no warnings 'once'; try{

 
    ###
    # Test instance creation.
 
    ###
    # Test instance creation.


@@ -82,8 +80,8 @@ $test->evaluate('@array last element is file2.cnf?', pop @array , 'file2.cnf');
     $test->done();
     #
 }
     $test->done();
     #
 }

-catch{
-   $test -> dumpTermination($@);
+catch($e){
+   $test -> dumpTermination($e);

    $test -> doneFailed();
 }
 
    $test -> doneFailed();
 }
 

diff --git a/tests/testData.pl b/tests/testData.pl
index 12d651256863fe47e88de6894638f8d36c8b8471..0ec056bf76e293b346d45c2830218c062cae688e 100644 (file)
--- a/tests/testData.pl
+++ b/tests/testData.pl
@@ -1,17 +1,12 @@
 #!/usr/bin/env perl
 #!/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;
 
 
 my $test = TestManager -> new($0);
 my $cnf;
 

-try{
+no warnings 'experimental::try'; no warnings 'once'; try{

 
    ###
    # Test instance creation.
 
    ###
    # Test instance creation.


@@ -71,8 +66,8 @@ try{
     $test->done();    
     #
 }
     $test->done();    
     #
 }

-catch{ 
-   $test -> dumpTermination($@);   
+catch($e){
+   $test -> dumpTermination($e);

    $test -> doneFailed();
 }
 
    $test -> doneFailed();
 }
 

diff --git a/tests/testDateInstruction.pl b/tests/testDateInstruction.pl
index dd96f238c94bbb89db7b7c5bc6ea20e03c909936..a3d7a296e45556af373fb4f42f548c2baed57bf5 100644 (file)
--- a/tests/testDateInstruction.pl
+++ b/tests/testDateInstruction.pl
@@ -1,18 +1,13 @@
 #!/usr/bin/env perl
 #!/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;
 
 
 
 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->case("Test TZ settings.");
         $test->subcase("Test list availabe countries.");
         my @countries =  CNFDateTime::_listAvailableCountryCodes();


@@ -114,8 +109,8 @@ try{
     $test->done();
     #
 }
     $test->done();
     #
 }

-catch{
-   $test -> dumpTermination($@);
+catch($e){
+   $test -> dumpTermination($e);

    $test -> doneFailed();
 }
 
    $test -> doneFailed();
 }
 

diff --git a/tests/testDoAndLIb.pl b/tests/testDoAndLIb.pl
index d111a448aa2d44463e8954607f385442af648b68..028ccfc350667c0136b1fb7236ad66d536fc5767 100644 (file)
--- a/tests/testDoAndLIb.pl
+++ b/tests/testDoAndLIb.pl
@@ -1,13 +1,11 @@
 #!/usr/bin/env perl
 #!/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);
 
 
 my $test = TestManager -> new($0);
 

-use Syntax::Keyword::Try; try {
+no warnings 'experimental::try'; no warnings 'once'; try {

 
     ###
     $test->case("Test Do.");
 
     ###
     $test->case("Test Do.");


@@ -64,7 +62,7 @@ use Syntax::Keyword::Try; try {
     $test->done();
     #
 }
     $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 930ff0c3f45f88a8431954d1458cd0db2fffbf88..387a8e18e09bbbb12a4658f789b7fbd43e002ce8 100644 (file)
--- a/tests/testExperimental.pl
+++ b/tests/testExperimental.pl
@@ -1,18 +1,12 @@
 #!/usr/bin/env perl
 #!/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;
 
 
 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.");
 
 #    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);
 
     my $db_synch_date = $cnf ->{DB_SYNCH_DATE};
     $test -> isDefined("\$db_synch_date",$db_synch_date);
 

-#
+

 #
 $test->done();
 #
 
 
 }
 #
 $test->done();
 #
 
 
 }

-catch{
-   $test -> dumpTermination($@);
+catch($e){
+   $test -> dumpTermination($e);

    $test -> doneFailed();
 }
    $test -> doneFailed();
 }

diff --git a/tests/testExtensions.pl b/tests/testExtensions.pl
index 9a7d6641e7789efb399aa3b6ab7008e62ba3dd22..8b3f9085ddd6269cc9cd7bf62e99680556f902cc 100644 (file)
--- a/tests/testExtensions.pl
+++ b/tests/testExtensions.pl
@@ -1,14 +1,14 @@
 #!/usr/bin/env perl
 #!/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'});
 
 
 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 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})
     $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->isDefined("SOME_CONSTANCE",$cnf->{SOME_CONSTANCE});
     }
 


@@ -41,7 +41,7 @@ try{
     $test->done();
     #
 }
     $test->done();
     #
 }

-catch{
+catch($e){

    $test -> dumpTermination($@);
    $test -> doneFailed();
 }
    $test -> dumpTermination($@);
    $test -> doneFailed();
 }

diff --git a/tests/testHTMLConversion.pl b/tests/testHTMLConversion.pl
index 3dca149f2f07ba5d57865b85b2e72b779c309b35..b2d9c32ae5b41b02c78c479e260374c58cf69f0e 100644 (file)
--- 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);
 
 
 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();
     #
 }
     $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 9ef902485bf1a8306a61d1e17ee3e39951620ee2..1342dde0d423e4423a7cf94f1487e0608441b306 100644 (file)
--- 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);
 
 require MarkdownPlugin;
 
 
 my $test = TestManager -> new($0);
 

-use Syntax::Keyword::Try; try {
+no warnings 'experimental::try'; no warnings 'once'; try {

 
 
     my $parser = CNFParser -> new();
 
 
     my $parser = CNFParser -> new();


@@ -75,9 +75,8 @@ use Syntax::Keyword::Try; try {
     $test->done();
     #
 }
     $test->done();
     #
 }

-catch{
-   $test -> dumpTermination($@);
+catch($e){
+   $test -> dumpTermination($e);

    $test -> doneFailed();
 }
 
    $test -> doneFailed();
 }
 

-

diff --git a/tests/testHTMLPossibleTagged.pl b/tests/testHTMLPossibleTagged.pl
index 538fea23cce8534d27f557962bc19efcf5fbacfb..e13e6ef25a5aa2bbe7b9247b89f0d330835c08a7 100644 (file)
--- a/tests/testHTMLPossibleTagged.pl
+++ b/tests/testHTMLPossibleTagged.pl
@@ -1,9 +1,7 @@
 #!/usr/bin/env perl
 #!/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);
 
 
 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.
     ###
     ###
     # Test inside tag/macro in value.
     ###


@@ -113,7 +111,7 @@ ut error itaque eum doloribus sint.`~
     try {
         $cnf->{'$DEBUG'} = 'false'
     }
     try {
         $cnf->{'$DEBUG'} = 'false'
     }

-    catch {
+    catch($e) {

         $test->subcase(
             "Passed keep constant test for \$cnf->DEBUG=$cnf->{DEBUG}");
     }
         $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'
     # 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->subcase("Passed keep constant test for \$cnf->DEBUG=$cnf->{DEBUG}");
     }
 


@@ -183,9 +181,9 @@ ut error itaque eum doloribus sint.`~
     $test->done();
     #
 }
     $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 f1a01bada68d5183f7b8ac46adc11ba536f34415..2d2b37f20a389205cc7adb94dd084a6041e71f60 100644 (file)
--- a/tests/testInclude.pl
+++ b/tests/testInclude.pl
@@ -1,16 +1,13 @@
 #!/usr/bin/env perl
 #!/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;
 
 
 
 my $test = TestManager -> new($0);
 my $cnf;
 
 

-try{
+no warnings 'experimental::try'; no warnings 'once'; try{

     ###
     # Test instance creation.
     #
     ###
     # Test instance creation.
     #


@@ -28,8 +25,8 @@ try{
     $test->done();    
     #
 }
     $test->done();    
     #
 }

-catch { 
-   $test -> dumpTermination($@);   
+catch($e){
+   $test -> dumpTermination($e);

    $test -> doneFailed();
 }
 
    $test -> doneFailed();
 }
 

diff --git a/tests/testInstructor.pl b/tests/testInstructor.pl
index 302672737d4810eb99a78372c0cb37834a54d6f2..f65ce5a089f8d95edae2d9cf48f2db0a7d33446a 100644 (file)
--- a/tests/testInstructor.pl
+++ b/tests/testInstructor.pl
@@ -1,16 +1,13 @@
 #!/usr/bin/env perl
 #!/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;
 
 
 
 my $test = TestManager -> new($0);
 my $cnf;
 
 

-try{
+no warnings 'experimental::try'; no warnings 'once'; try{

     ###
     # Test instance creation.
     #
     ###
     # Test instance creation.
     #


@@ -36,7 +33,7 @@ try{
                 
             ));            
             print $test->failed("Test failed! Passed to overwrite existing instruction, which are global.");
                 
             ));            
             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->passed("Passed fail on trying to overwrite existing instruction, which are global.");            
         }
 


@@ -87,8 +84,8 @@ try{
     $test -> done();
     #
 }
     $test -> done();
     #
 }

-catch{ 
-   $test -> dumpTermination($@);   
+catch($e){
+   $test -> dumpTermination($e);

    $test -> doneFailed();
 }
 
    $test -> doneFailed();
 }
 

diff --git a/tests/testMarkDownPlugin_MD2HTMLConversion.pl b/tests/testMarkDownPlugin_MD2HTMLConversion.pl
index 7c05d5d3ecd797164f34c8a47e06d29a96ecab9e..299c486bff4f36fc5cd9d9c733a563c4394d92ca 100644 (file)
--- 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);
 
 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->case("Test instances of parser and MarkDownPlugin.");
     my $parser = CNFParser -> new();


@@ -98,7 +97,7 @@ use Syntax::Keyword::Try; try {
     $test->done();
     #
 }
     $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 496bcdd80a6138d7ab56f2871729c601c78e912c..c795427cc63b97696e9b71fd6020d4f5156cee37 100644 (file)
--- a/tests/testNewTagParsingForVersion2.8.pl
+++ b/tests/testNewTagParsingForVersion2.8.pl
@@ -1,13 +1,11 @@
 #!/usr/bin/env perl
 #!/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);
 
 
 my $test = TestManager->new($0);
 

-use Syntax::Keyword::Try; try {
+no warnings 'experimental::try'; no warnings 'once'; try {

 
     ###
     # Test instance creation.
 
     ###
     # Test instance creation.


@@ -110,9 +108,9 @@ use Syntax::Keyword::Try; try {
     $test->done();
     #
 }
     $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 2b0273ec944c8d37b6f1953476a8b89223b7bcaf..7552ed1d082c5c526b0d327d749fbd3f2d14a191 100644 (file)
--- a/tests/testPerlKeywords.pl
+++ b/tests/testPerlKeywords.pl
@@ -1,17 +1,14 @@
 #!/usr/bin/env perl
 #!/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 TestManager;
 

-
+use PerlKeywords qw(%KEYWORDS %FUNCTIONS &matchForCSS &CAP &span_to_html);

 
 my $test = TestManager -> new($0);
 my $cnf;
 
 
 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->case("Regex as string.");
     my $regex = qr/\s*#.*$/o;


@@ -59,10 +56,11 @@ try{
     $test->done();    
     #
 }
     $test->done();    
     #
 }

-catch{ 
-   $test -> dumpTermination($@);   
+catch($e){
+   $test -> dumpTermination($e);

    $test -> doneFailed();
 }
 
 
 
    $test -> doneFailed();
 }
 
 
 

+

diff --git a/tests/testPlugin.pl b/tests/testPlugin.pl
index 78f260d9ce7d44268bd312a147c902ae99f81156..298bbff65b862589c0f75365682810b3ec703220 100644 (file)
--- a/tests/testPlugin.pl
+++ b/tests/testPlugin.pl
@@ -1,16 +1,14 @@
 #!/usr/bin/env perl
 #!/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;
 
 
 my $test = TestManager -> new($0);
 my $cnf;
 

-try{
+no warnings 'experimental::try'; no warnings 'once'; try{

     ###
     # Test instance creation.
     #
     ###
     # Test instance creation.
     #


@@ -24,8 +22,8 @@ try{
     $test->done();
     #
 }
     $test->done();
     #
 }

-catch{
-   $test -> dumpTermination($@);
+catch($e){
+   $test -> dumpTermination($e);

    $test -> doneFailed();
 }
 
    $test -> doneFailed();
 }
 

diff --git a/tests/testProcessor.pl b/tests/testProcessor.pl
index f87cb290fe7dfe3b197cb40590453b0de2d136d8..d2f751172df2d67ec6e0f2fc6970ed78b50d23de 100644 (file)
--- a/tests/testProcessor.pl
+++ b/tests/testProcessor.pl
@@ -1,14 +1,13 @@
 #!/usr/bin/env perl
 #!/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);
 
 
 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.");
     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();
     #
 }
     $test -> done();
     #
 }

-catch{ 
-   $test -> dumpTermination($@);   
+catch($e){ 
+   $test -> dumpTermination($e);   

    $test -> doneFailed();
 }
 
    $test -> doneFailed();
 }
 

diff --git a/tests/testSQL.pl b/tests/testSQL.pl
index 6f540d7ce2cdbd934b72634ec6b13b98dbd6b25b..5d08be9856a25cc0d065e2bb050a28dd60c586d1 100644 (file)
--- a/tests/testSQL.pl
+++ b/tests/testSQL.pl
@@ -1,19 +1,17 @@
 #!/usr/bin/env perl
 #!/usr/bin/env perl

-use warnings; use strict;
-use Syntax::Keyword::Try;
+use lib "./system/modules";
+use lib "./tests";
+use TestManager;
+

 use Benchmark;
 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`;
 
 
 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.");
 
    die $test->failed() if not $cnf = CNFParser->new();
        $test->case("Passed new instance CNFParser.");


@@ -135,7 +133,7 @@ ID _INT_`NAME _TEXT_~
 $test->done();
 #
 }
 $test->done();
 #
 }

-catch{
-   $test -> dumpTermination($@);
+catch($e){
+   $test -> dumpTermination($e);

    $test -> doneFailed();
 }
    $test -> doneFailed();
 }

diff --git a/tests/testSQLPostgres.pl b/tests/testSQLPostgres.pl
index 03858f2b721e8c0e58a60a0d8f5abd94acf9efd3..1cda85732eebff5f784f7dbb35287fda2a157c80 100644 (file)
--- a/tests/testSQLPostgres.pl
+++ b/tests/testSQLPostgres.pl
@@ -1,12 +1,8 @@
 #!/usr/bin/env perl
 #!/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;
 
 my $test = TestManager -> new($0);
 my $cnf;


@@ -17,7 +13,7 @@ my $DB_SETTINGS = qq(
    DB_SQL_SOURCE   = DBI:Pg:host=localhost;port=5433;
 >>>
 );
    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.");
 
    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();
     #
 }
     $test->done();
     #
 }

-catch{
-   $test -> dumpTermination($@);
+catch($e){
+   $test -> dumpTermination($e);

    $test -> doneFailed();
 }
 
    $test -> doneFailed();
 }
 

diff --git a/tests/testSQLPostgres_on_elite.pl b/tests/testSQLPostgres_on_elite.pl
index c15e8d7335cd818821f1a477d1ca724a3f35e575..18c9ecf41f8a4157c0012c519872c699858af097 100644 (file)
--- a/tests/testSQLPostgres_on_elite.pl
+++ b/tests/testSQLPostgres_on_elite.pl
@@ -1,14 +1,9 @@
 #!/usr/bin/env perl
 #!/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;
 
 my $test = TestManager -> new($0);
 my $cnf;


@@ -25,7 +20,7 @@ my $DB_SETTINGS = q(
 <<<FILE $0>>>
 );
 
 <<<FILE $0>>>
 );
 

-try{
+no warnings 'experimental::try'; no warnings 'once'; try{

 
    
 die $test->failed()
 
    
 die $test->failed()


@@ -196,8 +191,8 @@ There is:
     $test->done();
     #
 }
     $test->done();
     #
 }

-catch{
-   $test -> dumpTermination($@);
+catch($e){
+   $test -> dumpTermination($e);

    $test -> doneFailed();
 }
 
    $test -> doneFailed();
 }
 

diff --git a/tests/testSQL_Export_Import_To_CNF_DATA.pl b/tests/testSQL_Export_Import_To_CNF_DATA.pl
index 724c07fae665717196f209eb3905e37386e0c9f7..fdbbc75ebd36c469172e36d013cd9b08e7001fce 100644 (file)
--- 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
 #!/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;
 
 
 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.");
 
    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();
 #
 }
 $test->done();
 #
 }

-catch{
-   $test -> dumpTermination($@);
+catch($e){
+   $test -> dumpTermination($e);

    $test -> doneFailed();
 }
    $test -> doneFailed();
 }

diff --git a/tests/testSQL_TaskList.pl b/tests/testSQL_TaskList.pl
index a2d94d28217423ff906b4aa762326a7296d24c00..7ca2d62a684ef50a679d8e6164551731084f954d 100644 (file)
--- a/tests/testSQL_TaskList.pl
+++ b/tests/testSQL_TaskList.pl
@@ -1,19 +1,17 @@
 #!/usr/bin/env perl
 #!/usr/bin/env perl

-use warnings; use strict;
-use Syntax::Keyword::Try;
+use lib "./system/modules";
+use lib "./tests";
+use TestManager;
+

 use Benchmark;
 use Benchmark;

-use lib "system/modules";
-require TestManager;
-require CNFParser;
-require CNFSQL;

 
 my $test = TestManager -> new($0)->unsuited();
 my $cnf;
 
 
 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);
    my $content = do {local $/;<DATA>};
    $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();
    #
 }
       $test->done();
    #
 }

-catch{
-   $test -> dumpTermination($@);
+catch($e){
+   $test -> dumpTermination($e);

    $test -> doneFailed();
 }
 
    $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 <DATA> __SQL_TABLE__
 !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__
 #`2023-10-18`2023-11-22`Write test.`0`1~
 #`2023-10-18`2023-12-01`Implement HSHContact.`0`3~
 >><<PRIORITIES <DATA> __SQL_TABLE__

diff --git a/tests/testSQL_map_macro.pl b/tests/testSQL_map_macro.pl
index 048383c471953380ddf9f3846486e31614824cd4..c1a60979baf58fda5d36ac24bb15fb299a823033 100644 (file)
--- a/tests/testSQL_map_macro.pl
+++ b/tests/testSQL_map_macro.pl
@@ -1,6 +1,8 @@
 #!/usr/bin/env perl
 #!/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');
 
 use Benchmark;
 use lib::relative ('.','../system/modules');
 


@@ -13,7 +15,7 @@ my $cnf;
 
  `rm -f tests/test_db_central.db`;
 
 
  `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.");
 
    die $test->failed() if not $cnf = CNFParser->new();
        $test->case("Passed new instance CNFParser.");


@@ -103,7 +105,7 @@ ID _INT_`NAME _TEXT_~
 $test->done();
 #
 }
 $test->done();
 #
 }

-catch{
-   $test -> dumpTermination($@);
+catch($e){
+   $test -> dumpTermination($e);

    $test -> doneFailed();
 }
    $test -> doneFailed();
 }

diff --git a/tests/testShortLinks.pl b/tests/testShortLinks.pl
index 38910dbd538fa867c21e453d6ff54ee9fb11023d..5d75944d003b067a96f96b5e9e30b71fd5b2e623 100644 (file)
--- 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);
 require ShortLink;
 
 my $test = TestManager->new($0);

-use Syntax::Keyword::Try; try {
+no warnings 'experimental::try'; no warnings 'once'; try {

 
     $test->case("List generation.");
 
 
     $test->case("List generation.");
 


@@ -68,7 +69,7 @@ $test->done();
 # say "dcp[".length($xdecomp)."]:".$xdecomp;
 
 }
 # say "dcp[".length($xdecomp)."]:".$xdecomp;
 
 }

-catch{
-   $test -> dumpTermination($@);
+catch($e){
+   $test -> dumpTermination($e);

    $test->doneFailed();
 }
\ No newline at end of file
    $test->doneFailed();
 }
\ No newline at end of file

diff --git a/tests/testTree.pl b/tests/testTree.pl
index d4e72ece3ef3a228803f21344a5c4bb3f58b6cc4..5dddc1ebf6c021e0d14d9670de082dde57b91dd1 100644 (file)
--- a/tests/testTree.pl
+++ b/tests/testTree.pl
@@ -1,16 +1,12 @@
 #!/usr/bin/env perl
 #!/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;
 
 
 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(
 
    $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();
 }
    $test -> dumpTermination($@);
    $test -> doneFailed();
 }

diff --git a/tests/testTreeToHTML.pl b/tests/testTreeToHTML.pl
index c8a56e200b3c76af9038e00eebdb8b13ef3a555c..7a93740d058caa2ef48514f7d698e5d254751c7f 100644 (file)
--- a/tests/testTreeToHTML.pl
+++ b/tests/testTreeToHTML.pl
@@ -1,16 +1,12 @@
 #!/usr/bin/env perl
 #!/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;
 
 
 my $test = TestManager -> new($0);
 my $cnf;my $err;
 

-try{
+no warnings 'experimental::try'; no warnings 'once'; try{

 
     
   $test->case("Test HTML Conversion.");
 
     
   $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();
 }
    $test -> doneFailed();
 }

diff --git a/tests/testWorldCitiesDataHandling.pl b/tests/testWorldCitiesDataHandling.pl
index 548fd322569e2a56d913d2dba523278a3c0b0c95..b04d3c096328bda604c74de9cb902edbea328d1c 100644 (file)
--- a/tests/testWorldCitiesDataHandling.pl
+++ b/tests/testWorldCitiesDataHandling.pl
@@ -1,15 +1,12 @@
 #!/usr/bin/env perl
 #!/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;
 
 
 my $test = TestManager -> new($0);
 my $cnf;
 

-try{
+no warnings 'experimental::try'; no warnings 'once'; try{

 
    ###
    # Test instance cnf file loading time.
 
    ###
    # Test instance cnf file loading time.


@@ -61,7 +58,7 @@ try{
     $test->done();
     #
 }
     $test->done();
     #
 }

-catch{
-   $test -> dumpTermination($@);
+catch($e){
+   $test -> dumpTermination($e);

    $test -> doneFailed();
 }
    $test -> doneFailed();
 }