From ad0771ab34d232410a04b5c2a73d6f22d67e9ebe Mon Sep 17 00:00:00 2001 From: Will Budic Date: Sat, 8 Nov 2025 20:21:35 +1100 Subject: [PATCH] Moved TestManger to be part of system/modules from now on. --- apps/sql.pl | 1 - old/databaseAnonsTest.cnf | 2 +- system/modules/CNFNode.pm | 10 +- system/modules/CNFParser.pm | 10 +- system/modules/DatabaseCentralPlugin.pm | 1 + {tests => system/modules}/TestManager.pm | 0 tests/ExtensionSamplePlugin.pm | 4 +- tests/testAll.pl | 2 +- tests/testAppSettings.pl | 8 +- tests/testCLIArgumentOptions.pl | 1 - tests/testCNF2JSON.pl | 1 - tests/testCNFAnons.pl | 16 +- tests/testCNFConstances.pl | 2 - tests/testCNFGlobalFile.pl | 1 - tests/testCNFMeta.pl | 1 - tests/testCNFNode.pl | 1 - tests/testCNFNodeShortiefs.pl | 1 - tests/testCNFParserLogging.pl | 1 - tests/testCRONSchedular.pl | 1 - tests/testCartesianProduct.pl | 1 - tests/testCollections.pl | 2 - tests/testData.pl | 2 - tests/testDateInstruction.pl | 2 - tests/testDoAndLIb.pl | 5 +- tests/testExperimental.pl | 2 - tests/{extensions.cnf => testExtensions.cnf} | 0 tests/testExtensions.pl | 19 +- tests/testHTMLConversion.pl | 1 - tests/testHTMLMarkdown.pl | 4 - tests/testHTMLPossibleTagged.pl | 1 - tests/testInclude.pl | 2 - tests/testInstructor.pl | 2 - tests/testMarkDownPlugin_MD2HTMLConversion.pl | 2 - tests/testNewTagParsingForVersion2.8.pl | 1 - tests/testPerlKeywords.pl | 2 - tests/testPlugin.pl | 2 - tests/testProcessor.pl | 2 - tests/testSQL.pl | 6 - tests/testSQLPostgres.pl | 1 - tests/testSQLPostgres_on_elite.pl | 1 - tests/testSQL_Export_Import_To_CNF_DATA.pl | 9 +- tests/testSQL_TaskList.pl | 4 - ...tSQL map_macro.pl => testSQL_map_macro.pl} | 6 +- tests/testShortLinks.pl | 2 - tests/testTree.pl | 4 - tests/testTreeToHTML.pl | 3 - tests/testWorldCitiesDataHandling.pl | 2 - tests/test_CursesProgressBar.pl | 345 ++++++++++++------ tests/test_DATA_FILE_Instruction.pl | 5 +- tests/test_DATA_Instruction.pl | 1 - tests/test_DATA_NEW_Instruction.pl | 1 - tests/test_Threads.pl | 1 - 52 files changed, 271 insertions(+), 236 deletions(-) rename {tests => system/modules}/TestManager.pm (100%) rename tests/{extensions.cnf => testExtensions.cnf} (100%) rename tests/{testSQL map_macro.pl => testSQL_map_macro.pl} (97%) diff --git a/apps/sql.pl b/apps/sql.pl index 948c412..dbcc113 100644 --- a/apps/sql.pl +++ b/apps/sql.pl @@ -4,7 +4,6 @@ use warnings; use strict; no warnings('once'); use Syntax::Keyword::Try; use Benchmark; -use lib "tests"; use lib "system/modules"; require CNFParser; diff --git a/old/databaseAnonsTest.cnf b/old/databaseAnonsTest.cnf index 0de8711..2ac53a0 100644 --- a/old/databaseAnonsTest.cnf +++ b/old/databaseAnonsTest.cnf @@ -45,7 +45,7 @@ very much too! >> -<data()->{$link} if !$ret; if($ret && ref($ret) eq 'ARRAY'){ - my $pkg = @$ret[0]; + my $pkg = @$ret[0]; my $sub = @$ret[1]; use Module::Loaded qw(is_loaded); if(is_loaded($pkg)){ - my $obj = $pkg->new(undef); + my $obj = $pkg->new(undef); $ret = $obj->$sub(@$ret[2]); } - + } #Let's anything else next. $ret = $parser->obtainLink($link) if !$ret; diff --git a/system/modules/CNFParser.pm b/system/modules/CNFParser.pm index 7bf5892..c5c2520 100644 --- a/system/modules/CNFParser.pm +++ b/system/modules/CNFParser.pm @@ -69,7 +69,7 @@ our $CONSTREQ = 0; # $del_keys - is a reference to an array of constance attributes to dynamically remove. sub new { my ($class, $path, $attrs, $del_keys, $self) = @_; if ($attrs){ - $self = \%$attrs; + $self = \%$attrs; $self->{'ANONS_ARE_PUBLIC'} = 1 if not exists $self->{'ANONS_ARE_PUBLIC'} }else{ $self = { DO_ENABLED => 0, # Enable/Disable DO instruction. Which could evaluated potentially be an doom execute destruction. @@ -1297,8 +1297,10 @@ sub doInclude { my ($self, $prp_file) = @_; sub instructPlugin { my ($self, $struct) = @_; try{ - $properties{$struct->{'ele'}} = doPlugin($self, $struct); - $self->log("Plugin instructed -> ". $struct->{'ele'}); + my $plugin = doPlugin($self, $struct); + $properties{$struct->{'ele'}} = $plugin; + $self->log("Plugin instructed -> ". + $plugin->{element}.'<'.$plugin->{package}.'>.'.$plugin->{subroutine}.'('.$plugin->{property}.')'); }catch($e){ if($self->{STRICT}){ CNFParserException->throw(error=>$e); @@ -1538,7 +1540,9 @@ sub doPlugin { $sub = 'setup_with' if !$sub; $obj-> $sub($self); $plugin->setPlugin($obj); + $plugin->{property} = $instructor; $plugin->{instructor} = $instructor; + $plugin->{subroutine} = $sub; return $plugin; } elsif($instructor eq APP_ARGS){ diff --git a/system/modules/DatabaseCentralPlugin.pm b/system/modules/DatabaseCentralPlugin.pm index e14b6d3..6dd6605 100644 --- a/system/modules/DatabaseCentralPlugin.pm +++ b/system/modules/DatabaseCentralPlugin.pm @@ -98,6 +98,7 @@ sub executePropertyStatement($self,$parser,$db,$key,$sql){ provider=> 'DatabaseCentralPlugin' }; + $db ->disconnect(); $parser -> data() ->{$key} = \$table if @data; } } diff --git a/tests/TestManager.pm b/system/modules/TestManager.pm similarity index 100% rename from tests/TestManager.pm rename to system/modules/TestManager.pm diff --git a/tests/ExtensionSamplePlugin.pm b/tests/ExtensionSamplePlugin.pm index 94ee880..919028b 100644 --- a/tests/ExtensionSamplePlugin.pm +++ b/tests/ExtensionSamplePlugin.pm @@ -27,8 +27,10 @@ sub process ($self, $parser, $property) { for my $id (0 .. $#list){ my $entry = $list[$id]; my $type = ref($entry); - if($type eq 'InstructedDataItem'){ + if($type eq 'InstructedProcessItem'){ $parser->data()->{$entry->{ele}.'.'.$entry->{aid}} = doInstruction($parser, $entry) + }else{ + $parser -> warn(__PACKAGE__." ->process($property): Unknown Type[$id]: $type") } } return $property; diff --git a/tests/testAll.pl b/tests/testAll.pl index 30b4424..da65815 100644 --- a/tests/testAll.pl +++ b/tests/testAll.pl @@ -13,7 +13,7 @@ use IPC::Run qw( run timeout ); use Cwd qw(getcwd); my $CWD = getcwd; -use lib "./local"; +use lib "system/modules"; use lib "./tests"; try{ diff --git a/tests/testAppSettings.pl b/tests/testAppSettings.pl index 2058208..2f93b52 100644 --- a/tests/testAppSettings.pl +++ b/tests/testAppSettings.pl @@ -1,6 +1,6 @@ +#!/usr/bin/env perl use warnings; use strict; -use lib "tests"; -use lib "system/modules"; +use lib::relative ('.','../system/modules'); require TestManager; require CNFParser; @@ -16,9 +16,9 @@ use Syntax::Keyword::Try; try { ClassicAppSettings::_set_defaults( APP_NAME => "Test Example Application", SAMPLE_SETTING_1 => "This will be overwritten", - NEW_SETTING => "New setting not expexted in configuration, APP_SETTINGS_SYNC == 1" + NEW_SETTING => "New setting not expected in configuration, APP_SETTINGS_SYNC == 1" ); - my $parser = CNFParser -> new(undef,{DO_ENABLED=>0}); + my $parser = CNFParser -> new(undef,{DO_ENABLED=>0,'%LOG'=>{enabled=>1, console=>1}}); $parser->parse(undef,qq( <Sample App>> < diff --git a/tests/testCLIArgumentOptions.pl b/tests/testCLIArgumentOptions.pl index c915286..f388c37 100644 --- a/tests/testCLIArgumentOptions.pl +++ b/tests/testCLIArgumentOptions.pl @@ -3,7 +3,6 @@ use warnings; use strict; use Syntax::Keyword::Try; #no critic "eval" -use lib "tests"; use lib "system/modules"; # use lib::relative "../system/modules"; diff --git a/tests/testCNF2JSON.pl b/tests/testCNF2JSON.pl index 47bf98f..b2f6e9a 100644 --- a/tests/testCNF2JSON.pl +++ b/tests/testCNF2JSON.pl @@ -1,5 +1,4 @@ use warnings; use strict; -use lib "tests"; use lib "system/modules"; require TestManager; diff --git a/tests/testCNFAnons.pl b/tests/testCNFAnons.pl index bd58d00..0bacf95 100644 --- a/tests/testCNFAnons.pl +++ b/tests/testCNFAnons.pl @@ -1,9 +1,7 @@ #!/usr/bin/env perl use warnings; use strict; use Syntax::Keyword::Try; - -use lib "tests"; -use lib "system/modules"; +use lib::relative ('.','../system/modules'); require CNFParser; require TestManager; @@ -42,7 +40,7 @@ try{ my $newInstance =CNFParser->new(); $test->evaluate('Check $newInstance->anon("Exclusive") == $cnf->anon("Exclusive")?', $newInstance->anon("Exclusive"), $private->anon("Exclusive")); ${$private->anon()}{Exclusive2} = 'yes'; - $test->passed("Passed new private instance of CNFParser."); + $test->passed("Passed new private i, but script only of origin or settable by designnstance of CNFParser."); # $test-> nextCase(); @@ -149,7 +147,7 @@ catch{ sub testAnons { -# Anons are by default global, but script only of origin or settable by design. +# Anons are by default public therefore global. # Not code. Hence their name. CNFParser->new()->parse(undef,qq( @@ -157,10 +155,14 @@ CNFParser->new()->parse(undef,qq( )); -my $cnf = CNFParser->new("./old/databaseAnonsTest.cnf"); +my $cnf = CNFParser->new("./old/databaseAnonsTest.cnf",{ENABLE_WARNINGS=>0}); my $find = $cnf->anon('GET_SUB_URL',CNFParser->META); die "Failed finding GET_SUB_URL" if not $find; -die "Mismatched found in GET_SUB_URL" if $find ne 'https://www.THE_ONE.acme.com/$$$2$$$'; +die "Mismatched found in GET_SUB_URL:$find" if $find ne 'https://www.THE_ONE.acme.com/$$$2$$$'; +die "GET_URL is:".$cnf->anon()->{GET_URL} if $cnf->anon('GET_URL') ne 'https://www.THE_ONE.acme.com/$$$2$$$'; +die "Missing template property" if not $cnf->anon('MyTemplate'); + + # Let's try som JSON crap, lol. $find = $cnf->anon('GET_SUB_URL',CNFParser->META_TO_JSON); diff --git a/tests/testCNFConstances.pl b/tests/testCNFConstances.pl index 73d9627..89b9a76 100644 --- a/tests/testCNFConstances.pl +++ b/tests/testCNFConstances.pl @@ -1,8 +1,6 @@ #!/usr/bin/env perl use warnings; use strict; use Syntax::Keyword::Try; - -use lib "tests"; use lib "system/modules"; diff --git a/tests/testCNFGlobalFile.pl b/tests/testCNFGlobalFile.pl index 2d93a3b..7bcd587 100644 --- a/tests/testCNFGlobalFile.pl +++ b/tests/testCNFGlobalFile.pl @@ -1,7 +1,6 @@ #!/usr/bin/env perl use warnings; use strict; use feature 'say'; -use lib "tests"; use lib "system/modules"; require TestManager; diff --git a/tests/testCNFMeta.pl b/tests/testCNFMeta.pl index 2817e85..d72e9da 100644 --- a/tests/testCNFMeta.pl +++ b/tests/testCNFMeta.pl @@ -1,5 +1,4 @@ use warnings; use strict; -use lib "tests"; use lib "system/modules"; require TestManager; diff --git a/tests/testCNFNode.pl b/tests/testCNFNode.pl index 0dc49b0..ba50987 100644 --- a/tests/testCNFNode.pl +++ b/tests/testCNFNode.pl @@ -1,7 +1,6 @@ #!/usr/bin/env perl use warnings; use strict; use feature 'say'; -use lib "tests"; use lib "system/modules"; require TestManager; diff --git a/tests/testCNFNodeShortiefs.pl b/tests/testCNFNodeShortiefs.pl index 84dba6a..76631e2 100644 --- a/tests/testCNFNodeShortiefs.pl +++ b/tests/testCNFNodeShortiefs.pl @@ -1,7 +1,6 @@ #!/usr/bin/env perl use warnings; use strict; use feature 'say'; -use lib "tests"; use lib "system/modules"; require TestManager; diff --git a/tests/testCNFParserLogging.pl b/tests/testCNFParserLogging.pl index a315832..dce37f3 100644 --- a/tests/testCNFParserLogging.pl +++ b/tests/testCNFParserLogging.pl @@ -3,7 +3,6 @@ use warnings; use strict; use Syntax::Keyword::Try; #no critic "eval" use lib "system/modules"; -use lib "tests"; require CNFParser; require TestManager; diff --git a/tests/testCRONSchedular.pl b/tests/testCRONSchedular.pl index 5b9ed6e..91af1a2 100644 --- a/tests/testCRONSchedular.pl +++ b/tests/testCRONSchedular.pl @@ -4,7 +4,6 @@ use Syntax::Keyword::Try; use Benchmark; use File::stat; -use lib "tests"; use lib "system/modules"; require TestManager; diff --git a/tests/testCartesianProduct.pl b/tests/testCartesianProduct.pl index d3f506c..355c51c 100644 --- a/tests/testCartesianProduct.pl +++ b/tests/testCartesianProduct.pl @@ -3,7 +3,6 @@ use warnings; use strict; use Syntax::Keyword::Try; use Math::Cartesian::Product; -use lib "tests"; use lib "system/modules"; require TestManager; diff --git a/tests/testCollections.pl b/tests/testCollections.pl index 2f00f8b..51e50c5 100644 --- a/tests/testCollections.pl +++ b/tests/testCollections.pl @@ -1,8 +1,6 @@ #!/usr/bin/env perl use warnings; use strict; use Syntax::Keyword::Try; - -use lib "tests"; use lib "system/modules"; diff --git a/tests/testData.pl b/tests/testData.pl index f707565..12d6512 100644 --- a/tests/testData.pl +++ b/tests/testData.pl @@ -1,8 +1,6 @@ #!/usr/bin/env perl use warnings; use strict; use Syntax::Keyword::Try; - -use lib "tests"; use lib "system/modules"; diff --git a/tests/testDateInstruction.pl b/tests/testDateInstruction.pl index 8d6640a..dd96f23 100644 --- a/tests/testDateInstruction.pl +++ b/tests/testDateInstruction.pl @@ -1,8 +1,6 @@ #!/usr/bin/env perl use warnings; use strict; use Syntax::Keyword::Try; - -use lib "tests"; use lib "system/modules"; diff --git a/tests/testDoAndLIb.pl b/tests/testDoAndLIb.pl index cc41a67..d111a44 100644 --- a/tests/testDoAndLIb.pl +++ b/tests/testDoAndLIb.pl @@ -1,7 +1,6 @@ +#!/usr/bin/env perl use warnings; use strict; - -use lib "tests"; -use lib "system/modules"; +use lib::relative ('.','../system/modules'); require TestManager; require CNFParser; diff --git a/tests/testExperimental.pl b/tests/testExperimental.pl index ebd1683..72daa78 100644 --- a/tests/testExperimental.pl +++ b/tests/testExperimental.pl @@ -2,8 +2,6 @@ use warnings; use strict; use Syntax::Keyword::Try; use Benchmark; - -use lib "tests"; use lib "system/modules"; diff --git a/tests/extensions.cnf b/tests/testExtensions.cnf similarity index 100% rename from tests/extensions.cnf rename to tests/testExtensions.cnf diff --git a/tests/testExtensions.pl b/tests/testExtensions.pl index 5fb020f..c2e9af2 100644 --- a/tests/testExtensions.pl +++ b/tests/testExtensions.pl @@ -1,9 +1,7 @@ #!/usr/bin/env perl use warnings; use strict; use Syntax::Keyword::Try; - -use lib "tests"; -use lib "system/modules"; +use lib::relative ('.','../system/modules'); require TestManager; require CNFParser; @@ -12,27 +10,30 @@ require ExtensionSamplePlugin; my $test = TestManager -> new($0); my $cnf; -my $plugin = ExtensionSamplePlugin->new({Language=>'English',DateFormat=>'US'}); +#my $plugin = ExtensionSamplePlugin->new({Language=>'English',DateFormat=>'US'}); try{ ### # Test instance creation. # - die $test->failed() if not $cnf = CNFParser->new('./tests/extensions.cnf',{DO_ENABLED=>1,HAS_EXTENSIONS=>1}); + die $test->failed() if not $cnf = CNFParser->new('./tests/testExtensions.cnf', + {DO_ENABLED=>1,HAS_EXTENSIONS=>1,'%LOG'=>{enabled=>1, console=>1}} + ); $test->case("Passed new instance CNFParser for:".$cnf->{CNF_CONTENT}); # $test-> nextCase(); # my %data = %{$cnf->data()}; - $test->evaluate("Data hash has two keys?", scalar keys %data, 2); - my @table = sort keys %data; - $test->evaluate("First table has 28 entries?", scalar( @{$data{$table[0]}} ), 28); + $test->isDefined("%data is defined?",\%data); + $test->isDefined("@table is defined?",@table); + $test->evaluate("Data hash has two keys?", 2, scalar keys %data); + $test->evaluate("First table has 28 entries?", scalar @{$data{$table[0]}}, 28); $test->evaluate("Second table has 28 entries?", scalar( @{$data{$table[1]}} ), 28); $test->evaluate("First table has 2 as first value?", $data{$table[0]}[0], 2); $test->evaluate("Second table has 9 as first value?", $data{$table[1]}[0], 9); - $test->isDefined("SOME_CONSTANCE",$cnf->{'$SOME_CONSTANCE'}); #<---- Deprecated old convention signifier prefixed upercase as VAR ins. converts. + $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. diff --git a/tests/testHTMLConversion.pl b/tests/testHTMLConversion.pl index f9d92bc..3dca149 100644 --- a/tests/testHTMLConversion.pl +++ b/tests/testHTMLConversion.pl @@ -1,5 +1,4 @@ use warnings; use strict; -use lib "tests"; use lib "system/modules"; require TestManager; diff --git a/tests/testHTMLMarkdown.pl b/tests/testHTMLMarkdown.pl index ecf9efd..9ef9024 100644 --- a/tests/testHTMLMarkdown.pl +++ b/tests/testHTMLMarkdown.pl @@ -1,9 +1,5 @@ use warnings; use strict; - use lib "system/modules"; -use lib "tests"; - - require TestManager; require CNFParser; require MarkdownPlugin; diff --git a/tests/testHTMLPossibleTagged.pl b/tests/testHTMLPossibleTagged.pl index 9cb6408..538fea2 100644 --- a/tests/testHTMLPossibleTagged.pl +++ b/tests/testHTMLPossibleTagged.pl @@ -1,6 +1,5 @@ #!/usr/bin/env perl use warnings; use strict; -use lib "tests"; use lib "system/modules"; require TestManager; diff --git a/tests/testInclude.pl b/tests/testInclude.pl index b888a86..f1a01bad 100644 --- a/tests/testInclude.pl +++ b/tests/testInclude.pl @@ -1,8 +1,6 @@ #!/usr/bin/env perl use warnings; use strict; use Syntax::Keyword::Try; - -use lib "tests"; use lib "system/modules"; require TestManager; diff --git a/tests/testInstructor.pl b/tests/testInstructor.pl index 6e61358..3026727 100644 --- a/tests/testInstructor.pl +++ b/tests/testInstructor.pl @@ -1,8 +1,6 @@ #!/usr/bin/env perl use warnings; use strict; use Syntax::Keyword::Try; - -use lib "tests"; use lib "system/modules"; require TestManager; diff --git a/tests/testMarkDownPlugin_MD2HTMLConversion.pl b/tests/testMarkDownPlugin_MD2HTMLConversion.pl index b5728e8..7c05d5d 100644 --- a/tests/testMarkDownPlugin_MD2HTMLConversion.pl +++ b/tests/testMarkDownPlugin_MD2HTMLConversion.pl @@ -1,6 +1,4 @@ use warnings; use strict; - -use lib "tests"; use lib "system/modules"; require TestManager; diff --git a/tests/testNewTagParsingForVersion2.8.pl b/tests/testNewTagParsingForVersion2.8.pl index 8ba0099..89de324 100644 --- a/tests/testNewTagParsingForVersion2.8.pl +++ b/tests/testNewTagParsingForVersion2.8.pl @@ -1,6 +1,5 @@ #!/usr/bin/env perl use warnings; use strict; -use lib "tests"; use lib "system/modules"; #use lib "system/modules"; diff --git a/tests/testPerlKeywords.pl b/tests/testPerlKeywords.pl index fc6bb14..2b0273e 100644 --- a/tests/testPerlKeywords.pl +++ b/tests/testPerlKeywords.pl @@ -1,8 +1,6 @@ #!/usr/bin/env perl use warnings; use strict; use Syntax::Keyword::Try; - -use lib "tests"; use lib "system/modules"; use PerlKeywords qw(%KEYWORDS %FUNCTIONS &matchForCSS &CAP &span_to_html); diff --git a/tests/testPlugin.pl b/tests/testPlugin.pl index 01a1089..78f260d 100644 --- a/tests/testPlugin.pl +++ b/tests/testPlugin.pl @@ -1,8 +1,6 @@ #!/usr/bin/env perl use warnings; use strict; use Syntax::Keyword::Try; - -use lib "tests"; use lib "system/modules"; use Date::Manip; diff --git a/tests/testProcessor.pl b/tests/testProcessor.pl index 6208e9b..276d531 100644 --- a/tests/testProcessor.pl +++ b/tests/testProcessor.pl @@ -1,8 +1,6 @@ #!/usr/bin/env perl use warnings; use strict; use Syntax::Keyword::Try; - -use lib "tests"; use lib "system/modules"; require TestManager; diff --git a/tests/testSQL.pl b/tests/testSQL.pl index 4966c3b..95c2a48 100644 --- a/tests/testSQL.pl +++ b/tests/testSQL.pl @@ -2,14 +2,8 @@ use warnings; use strict; use Syntax::Keyword::Try; use Benchmark; - -# use lib::relative 'system/modules'; - - -use lib "tests"; use lib "system/modules"; - require TestManager; require CNFParser; require CNFSQL; diff --git a/tests/testSQLPostgres.pl b/tests/testSQLPostgres.pl index d2e7997..03858f2 100644 --- a/tests/testSQLPostgres.pl +++ b/tests/testSQLPostgres.pl @@ -2,7 +2,6 @@ use warnings; use strict; use Syntax::Keyword::Try; use Benchmark; -use lib "tests"; use lib "system/modules"; require TestManager; diff --git a/tests/testSQLPostgres_on_elite.pl b/tests/testSQLPostgres_on_elite.pl index 2b1fd94..aa037bc 100644 --- a/tests/testSQLPostgres_on_elite.pl +++ b/tests/testSQLPostgres_on_elite.pl @@ -3,7 +3,6 @@ use 5.28.0; use warnings; use strict; use Syntax::Keyword::Try; use Benchmark; -use lib "tests"; use lib 'system/modules'; require TestManager; diff --git a/tests/testSQL_Export_Import_To_CNF_DATA.pl b/tests/testSQL_Export_Import_To_CNF_DATA.pl index 171fd13..724c07f 100644 --- a/tests/testSQL_Export_Import_To_CNF_DATA.pl +++ b/tests/testSQL_Export_Import_To_CNF_DATA.pl @@ -3,13 +3,8 @@ use warnings; use strict; use Syntax::Keyword::Try; use Benchmark; -use lib::relative 'system/modules'; - - -use lib "tests"; -use lib "system/modules"; - - +use lib::relative '../system/modules'; +#use lib "system/modules"; require TestManager; require CNFParser; require CNFSQL; diff --git a/tests/testSQL_TaskList.pl b/tests/testSQL_TaskList.pl index b14b1e3..a2d94d2 100644 --- a/tests/testSQL_TaskList.pl +++ b/tests/testSQL_TaskList.pl @@ -2,11 +2,7 @@ use warnings; use strict; use Syntax::Keyword::Try; use Benchmark; - - -use lib "tests"; use lib "system/modules"; - require TestManager; require CNFParser; require CNFSQL; diff --git a/tests/testSQL map_macro.pl b/tests/testSQL_map_macro.pl similarity index 97% rename from tests/testSQL map_macro.pl rename to tests/testSQL_map_macro.pl index 9f7fdaf..048383c 100644 --- a/tests/testSQL map_macro.pl +++ b/tests/testSQL_map_macro.pl @@ -2,11 +2,7 @@ use warnings; use strict; use Syntax::Keyword::Try; use Benchmark; - -use lib "tests"; -use lib 'system/modules'; -# use lib "system/modules"; - +use lib::relative ('.','../system/modules'); require TestManager; require CNFParser; diff --git a/tests/testShortLinks.pl b/tests/testShortLinks.pl index 3ab73ad..38910db 100644 --- a/tests/testShortLinks.pl +++ b/tests/testShortLinks.pl @@ -1,8 +1,6 @@ use warnings; use strict; - use feature 'say'; use lib "system/modules"; -use lib "tests"; require TestManager; require ShortLink; diff --git a/tests/testTree.pl b/tests/testTree.pl index 99aa5ec..d4e72ec 100644 --- a/tests/testTree.pl +++ b/tests/testTree.pl @@ -1,11 +1,7 @@ #!/usr/bin/env perl use warnings; use strict; use Syntax::Keyword::Try; - -use lib "tests"; use lib "system/modules"; -#use lib "system/modules"; - require TestManager; require CNFParser; diff --git a/tests/testTreeToHTML.pl b/tests/testTreeToHTML.pl index addb562..c8a56e2 100644 --- a/tests/testTreeToHTML.pl +++ b/tests/testTreeToHTML.pl @@ -1,11 +1,8 @@ #!/usr/bin/env perl use warnings; use strict; use Syntax::Keyword::Try; - -use lib "tests"; use lib "system/modules"; - require TestManager; require CNFParser; require CNFNode; diff --git a/tests/testWorldCitiesDataHandling.pl b/tests/testWorldCitiesDataHandling.pl index bb1c09d..548fd32 100644 --- a/tests/testWorldCitiesDataHandling.pl +++ b/tests/testWorldCitiesDataHandling.pl @@ -1,8 +1,6 @@ #!/usr/bin/env perl use warnings; use strict; use Syntax::Keyword::Try; - -use lib "tests"; use lib "system/modules"; require TestManager; diff --git a/tests/test_CursesProgressBar.pl b/tests/test_CursesProgressBar.pl index a8dda89..3cfd33e 100644 --- a/tests/test_CursesProgressBar.pl +++ b/tests/test_CursesProgressBar.pl @@ -4,8 +4,7 @@ use Syntax::Keyword::Try; #no critic "eval" ### -use lib "tests"; -use lib "local"; + use lib::relative "../system/modules"; require CNFParser; require CNFDateTime; @@ -16,98 +15,223 @@ use lib "system/modules"; require TestManager; my $test = TestManager -> new($0)-> unsuited(); -my $cnf; - -try{ - ### - # Test instance creation. - # - # die $test->failed() if not $cnf = CNFParser->blank({DEBUG=>1}); - # $test->case("Passed new instance CNFParser."); - # # - # $test-> nextCase(); - # # - $test->case("Initiate Curses UI."); - +my $cnf = CNFParser->blank()->parse(undef,q{ +<<@<@DIRECTORIES> +Documents, Pictures, Public, Music, +dev, dev_new, backups, +.cinnamon, .config, .icons, .local, .vim, +.ssh, .themes, .fzf, .fonts +>> +<<@<@DIRECTORIES> +.themes, .vim, +.fzf +.fonts +>> +<<@<@DIRECTORIES_NON> + .vim +>> +<<@<@EXCLUDES> +.local/share/Steam, .local/share/flatpak, .local/share/Trash, .local/lib +*Cache*, +.config/session,.config/Signal,.config/libreoffice, +*google-chrome*, +*cgisess_*, +*cache*, +*chromium* +localperl +.local/share/Trash +.local/share/pipx +*pgadmin4* +*.vscode* +.config/Code/logs/* +>> +}); use lib "/home/will/dev_new/web_imports_cloned/CPAN/Curses-UI-0.9609/lib"; use Curses::UI; -use Time::HiRes qw(usleep); +#use Time::HiRes qw(usleep); use feature 'say'; +use File::Type; + +our $FT = File::Type->new(); +my @FILES; +my %EXCLUDE_RULES; +my @EXCLUDE_KEYS; +my ($title,$editor,$action,$progressbar,$buffer,$other); + + +package FileCollected { + our ($total_cnt,$total_bytes) = (0,0); + sub new{ + my $class = shift; + my $path = shift; + my $mime = $FT->mime_type($path); + my @stat = stat $path; + my $content_length = $stat[7]; $content_length = 0 if ! $content_length; + $total_cnt++; + $total_bytes += $content_length; + bless { + path => $path, + mime => $mime, + content_length => $content_length, + last_modified => $stat[9], + }, $class + } + +} + +sub isExcluded{ + my $path = shift; + foreach my $exclude(@EXCLUDE_KEYS){ + if($path =~ m/$exclude/){ + return 1 if $EXCLUDE_RULES{$exclude} -> ($path,$exclude) + } + } + return 0 +} +sub recurseDir{ + my $dir = shift; $! = 0; # Reset error variable + my $HNDL_DIR; + if ( ! -d $dir){ + say "Not valid directory or accessible: $dir"; + return + } + opendir ($HNDL_DIR, $dir) or die "Fail to open directory: $dir"; + my @listing = readdir($HNDL_DIR); + if ($!) { + die "Error reading directory: $!"; + } + close ($HNDL_DIR); undef $HNDL_DIR; + foreach my $node(@listing){ + next if($node eq '..' || $node eq '.'); + my $current = $dir . "/" . $node; + if(!isExcluded($current)){ + $action->text($current); + $action->draw; + if(-d $current){ + recurseDir($current) + }else{ + $FILES[@FILES] = FileCollected -> new($current); + $buffer .= $current."\n" ; + } + } + } + + $editor->focus(); + $editor->text($buffer); + $editor->cursor_to_end(); + + $buffer =""; +} - # Create the root object. - my $cui = new Curses::UI ( +sub pathStarts{ + my $path = shift; + my $name = shift; + return $path =~ m/^$name.*/m +} +sub pathEnds{ + my $path = shift; + my $name = shift; + return $path =~ m/.+$name$/m +} +sub pathContains{ + my $path = shift; + my $name = shift; + return $path =~ m/\/$name\// +} + + +sub _size_bytes{ + my $size = shift; + if ($size < 1024) { + return $size . " bytes"; + } + elsif ($size < (1024 * 1024)) { + return sprintf("%.2f KB", $size / 1024); + } + else { + return sprintf("%.2f MB", $size / (1024 * 1024)); + } +} + +try{ + + $test->case("Initiate Curses UI."); + my @DIRECTORIES = $cnf -> collection('@DIRECTORIES'); + my @EXCLUDES = $cnf -> collection('@EXCLUDES'); + my ($cnt_root_dirs,$cnt_files) = (0,0); + + foreach my $exclude(@EXCLUDES){ + my @glob = ($exclude =~ m/(^\*?)(.*?)(\**$)/ms); + my $start = $glob[0]; + my $name = $glob[1]; + my $ends = $glob[2]; + if($start && $ends){ + $EXCLUDE_RULES{$name} = \&pathContains; + }elsif($start && !$ends){ + $EXCLUDE_RULES{$name} = \&pathStarts; + }elsif($ends){ + $EXCLUDE_RULES{$name} = \&pathEnds; + }else{ + $EXCLUDE_RULES{$name} = \&pathStarts; + } + } + @EXCLUDE_KEYS = sort keys %EXCLUDE_RULES; + + +# Create the root object. + our $cui = new Curses::UI ( -debug => $cnf->{DEBUG}, -color_support => 1, -clear_on_exit => 0 ); - + my $end=$cui->{-height}-4; + my $top=$cui->{-height}-8; + my $cur=$top; + $cui->status("Examining Files!"); + $cui->keys_to_lowercase(); + $cui->set_binding(sub{$cui->mainloopExit;}, "\cC"); + $cui->set_binding(sub{$cui->mainloopExit} , "\cQ"); my ($x,$y,$pos)=(0,0,0); my $win = $cui->add('window_id', 'Window'); - my $editor = $win->add( - 'editor', 'TextEditor', - -border => 1, - -padtop => 0, - -padbottom => 3, - -showlines => 0, - -sbborder => 0, - -vscrollbar => 1, - -hscrollbar => 1, - -showhardreturns => 0, - -wrapping => 0, # wrapping slows down the editor :-( - -text => "Fetching..", -); - -# my $progressbar = $win->add( -# 'myprogressbar', 'Progressbar', -# #-max => 250, -# -pos => 0, -# -fg => "blue", -# -bfg => "yellow", -# -y=>$cui->{-height}-4 -# ); -# my $action = $win->add( -# 'myaction', 'Label', -# -fg => "red", -# -text => 'Performing test... ', -# -pos => 0, -# -y=>$cui->{-height}-1 -# ); -# while($pos<101){ -# $action->draw; -# $progressbar->draw; -# $progressbar->pos(++$pos); -# usleep(rand(25000)); -# my $text = "Progress position $pos "; -# $action->text($text); -# } -# sleep(1); + my $max = @DIRECTORIES; - -use File::Type; - my $ft = File::Type->new(); -my $dir = $ENV{HOME}; -opendir DIR,$dir; -my @dir = readdir(DIR); -close DIR; - -my $max = @dir; -my ($buffer,$other); -$pos = 0; - - my $action = $win->add( - 'myaction', 'Label', - -fg => "red", - -text => 'Listing files... ', - -pos => 0, - -y=>$cui->{-height}-1 + $title = $win->add( + 'myaction2', 'Label', + -text => 'Listing files... ', + -width => $cui->{-width}, + -y=>0, + -x=>0, + -border => 1, + ); + + + $editor = $win->add( + 'editor', 'TextEditor', + -border => 1, + -padtop => 3, + -padbottom => 4, + -showlines => 0, + -sbborder => 1, + -vscrollbar => 1, + -hscrollbar => 1, + -showhardreturns => 0, + -wrapping => 0, # wrapping slows down the editor :-( + -text => "Fetching..", ); -my $progressbar = $win->add( - 'myprogressbar2', 'Progressbar', + $action = $win->add( + 'myaction', 'Label', + -fg => "red", + -text => 'Listing files... ', + -width => $cui->{-width}-1, + -y=>$cui->{-height}-1 + ); + $progressbar = $win->add( + 'myprogressbar', 'Progressbar', -max => $max, -pos => 1, -fg => "red", @@ -115,58 +239,35 @@ my $progressbar = $win->add( -y=>$cui->{-height}-4 ); -my $end=$cui->{-height}-4; -my $top=$cui->{-height}-8; -my $cur=$top; -$cui->keys_to_lowercase(); -foreach(@dir){ - usleep(rand(5000)); - $progressbar->draw; - $progressbar->pos($pos); - $action->draw; -if (-f $dir . "/" . $_ ){ - my $file = "$dir/$_"; - $action->text($file); - my $mime_type = $ft->mime_type($file); - if($mime_type eq 'text/script' || $ft->checktype_filename($file) =~ /x-sh$/){ - $buffer .= $file. " type: ". $mime_type . "\n"; - $editor->text($buffer); - # $win->add( - # 'myaction'.$pos, 'Label', - # -fg => "yellow", - # -text => $file, - # -x=>0, - # -y=>$cur++ - # )->draw; - # if($cur>=$end){ - # $cur=$top; - # } - $editor->cursor_to_end(); - }else{ - $other .= $ft->checktype_filename($file)."::$file\n"; - } -} -# elsif(-d $dir . "/" . $_){ -# } -$progressbar->pos(int(++$pos)); +foreach(@DIRECTORIES){ + my $dir = $ENV{HOME} .'/'.$_; + $progressbar->pos($pos++); + $progressbar->draw; + $title->text("Listing:".$dir); + $title->draw; + sleep(1); + recurseDir($dir); + $cnt_root_dirs++; } -$cui->set_binding(sub{$cui->status("DONE! ctrl+Q")}, "\cC"); -$cui->set_binding(sub{$cui->mainloopExit} , "\cQ"); -$editor->focus(); -$cui->mainloop; +$progressbar->pos($max); +$progressbar->draw; +$action->text("Done Filtering, ctrl+q to quit!"); -$cui->leave_curses (); - -say $buffer; -say $other; -$cui->reset_curses (); +$cui->status("DONE! ctrl+Q"); +$cui->mainloop; +$cui->leave_curses (); +$cui->reset_curses (); +{ + say "Number of files collected:" . $FileCollected::total_cnt; + say "Size of files collected:" . _size_bytes($FileCollected::total_bytes); +} # $test->done(); @@ -179,4 +280,6 @@ catch{ # # TESTING ANY POSSIBLE SUBS ARE FOLLOWING FROM HERE # -# \ No newline at end of file +# + + diff --git a/tests/test_DATA_FILE_Instruction.pl b/tests/test_DATA_FILE_Instruction.pl index 2849525..ad9fc84 100644 --- a/tests/test_DATA_FILE_Instruction.pl +++ b/tests/test_DATA_FILE_Instruction.pl @@ -1,8 +1,5 @@ #!/usr/bin/env perl -use warnings; -use strict; - -use lib "tests"; +use warnings; use strict; use lib "system/modules"; require TestManager; diff --git a/tests/test_DATA_Instruction.pl b/tests/test_DATA_Instruction.pl index 3ba23a7..9e394f8 100644 --- a/tests/test_DATA_Instruction.pl +++ b/tests/test_DATA_Instruction.pl @@ -1,7 +1,6 @@ #!/usr/bin/env perl use warnings; use strict; -use lib "tests"; use lib "system/modules"; require TestManager; diff --git a/tests/test_DATA_NEW_Instruction.pl b/tests/test_DATA_NEW_Instruction.pl index 93f9d02..8dbd8c3 100644 --- a/tests/test_DATA_NEW_Instruction.pl +++ b/tests/test_DATA_NEW_Instruction.pl @@ -2,7 +2,6 @@ use warnings; use strict; use Syntax::Keyword::Try; -use lib "tests"; use lib "system/modules"; require TestManager; diff --git a/tests/test_Threads.pl b/tests/test_Threads.pl index 0e690af..3942eef 100644 --- a/tests/test_Threads.pl +++ b/tests/test_Threads.pl @@ -6,7 +6,6 @@ use Syntax::Keyword::Try; #no critic "eval" ### -use lib "tests"; use lib "local"; use Config; $Config{useithreads} or -- 2.34.1