From 17dbe0f1975f164a3d82de332952410f1ad868ee Mon Sep 17 00:00:00 2001 From: Will Budic Date: Sun, 9 Nov 2025 19:54:16 +1100 Subject: [PATCH] imp. constanceRegistryCheck --- system/modules/CNFParser.pm | 34 ++- tests/test_CursesProgressBar.pl | 407 +++++++++++++++++++------------- 2 files changed, 268 insertions(+), 173 deletions(-) diff --git a/system/modules/CNFParser.pm b/system/modules/CNFParser.pm index 7482de8..dd564d2 100644 --- a/system/modules/CNFParser.pm +++ b/system/modules/CNFParser.pm @@ -65,7 +65,7 @@ our $CONSTREQ = 0; ### # Create a new CNFParser instance. # $path - Path to some .cnf_file file, to parse, not compulsory to add now? Make undef. -# $attrs - is reference to hash of constances and settings to dynamically employ. +# $attrs - is reference to hash of constants and settings to dynamically employ. # $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){ @@ -118,7 +118,7 @@ sub new { my ($class, $path, $attrs, $del_keys, $self) = @_; # ### -# Create a blank new repository, allowing for default and new dynamic constances to be set. +# Create a blank new repository, allowing for default and new dynamic constants to be set. ### sub blank{ return new(shift,undef,@_) @@ -339,11 +339,25 @@ sub anon { my ($self, $n, $args)=@_; sub const { my ($self,$c)=@_; return $self->{$c} if exists $self->{$c}; if ($CONSTREQ){CNFParserException->throw("Required constants variable ' $c ' not defined in config!")} - # Let's try to resolve. As old convention makes constances have a '$' prefix all upprercase. + # Let's try to resolve. As old convention makes constants have a '$' prefix all upprercase. $c = '$'.$c; return $self->{$c} if exists $self->{$c}; return; } +### +# Validates if this repository contains expected and required constance. +# Returns 0 if an required constance not found in list. +sub constanceRegistryCheck{ my ($self,@list)=@_; + return 0 if !@list; + my $r = 1; my ($package, $filename, $line) = caller; + foreach(@list){ + if(not exists $self->{$_}){ + $r=0; + $self->warn("Required constance is missing -> [$_] at $filename:$line") + } + } + return $r; +} ### # Collections are global, Reason for this is that any number of subsequent files parsed, @@ -906,11 +920,17 @@ sub doDATAInstructions_{ my ($self,$e,$v,$t,$d)=@_; $self->{__DATA__}{$e} = \$ret } ### +# Parses a CNF from perl string buffer. +## +sub parseString{ + return parse(shift,undef,shift) +} +### # Parses a CNF file or a text content if specified, for this configuration object. ## sub parse { my ($self, $cnf_file, $content, $del_keys) = @_; - # We control from here the constances, as we need to unlock them if a previous parse was run. + # 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 ){ @@ -973,7 +993,7 @@ sub parse { my ($self, $cnf_file, $content, $del_keys) = @_; if($line and not $self->{$name}){ $self->{$name} = $line; }else{ - if($line ne $self->{$name}){ + if(defined $line && $line ne $self->{$name}){ my $w = "Skipping and keeping a previously set constance of -> [$name] in (". $self->{CNF_CONTENT}. ") the new script value dosen't match -> $line."; $self->warn($w) } @@ -1837,7 +1857,7 @@ sub getTree { ## # Conveniently ribs an cnf file for an pl source file to be next to in marriage. # Ribs means the config file is same name next to it. -# @$const - Dynamic instance assignable hash with constances, optional can be undef. +# @$const - Dynamic instance assignable hash with constants, optional can be undef. # @$file - Path to CNF file if missing will be created. # @return a configuration instance per script usually assigned. ## @@ -1895,7 +1915,7 @@ __END__ 1. Reserved words relate to instructions, that are specially treated, and interpreted by the parser to perform extra or specifically processing on the current value. 2. Reserved instructions can't be used for future custom ones, and also not recommended tag or property names. 3. Current Reserved words list is. - - CONST - Concentrated list of constances, or individually tagged name and its value. + - CONST - Concentrated list of constants, or individually tagged name and its value. - VARIABLE - Concentrated list of anons, or individually tagged name and its value. - DATA - CNF scripted delimited data property, having uniform table data rows. - DATE - Translate PerlCNF date representation to DateTime object. Returns now() on empty property value. diff --git a/tests/test_CursesProgressBar.pl b/tests/test_CursesProgressBar.pl index 29f7feb..8ac2865 100644 --- a/tests/test_CursesProgressBar.pl +++ b/tests/test_CursesProgressBar.pl @@ -2,32 +2,43 @@ use strict; use warnings; no warnings qw(experimental::signatures); use Syntax::Keyword::Try; use feature 'signatures'; +use lib "/home/will/dev_new/web_imports_cloned/CPAN/Curses-UI-0.9609/lib"; +use Curses::UI; +use feature 'say'; +use File::Type; +use Time::HiRes qw(usleep); ## -# Disable bellow use lib::relative when debugging -> "perl.perlInc" +# 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"); ## -use CNFParser; +#use lib::relative (".","../system/modules"); +## +use CNFParser; use CNFDateTime; use TestManager; my $test = TestManager -> new($0)-> unsuited(); -my $cnf = CNFParser->blank()->parse(undef,q{ +my $cnf = CNFParser-> blank() -> parseString(q{ +<<>> <<@<@DIRECTORIES> -Documents, Pictures, Public, Music, +Documents, Pictures, Public, Music, dev, dev_new, backups, -.cinnamon, .config, .icons, .local, .vim, -.ssh, .themes, .fzf, .fonts +.cinnamon, .config, .icons, .local, .vim, +.ssh, .themes, .fzf, .fonts >> <<@<@DIRECTORIES> -.themes, .vim, +.themes, .vim, .fzf -.fonts +.fonts >> -<<@<@DIRECTORIES_NON> - .vim +<<@<@DIRECTORIES> + .vim >> <<@<@EXCLUDES> -.local/share/Steam, .local/share/flatpak, .local/share/Trash, .local/lib +.local/share/Steam, .local/share/flatpak, .local/share/Trash, .local/lib *Cache*, .config/session,.config/Signal,.config/libreoffice, *google-chrome*, @@ -35,24 +46,217 @@ dev, dev_new, backups, *cache*, *chromium* localperl -.local/share/Trash -.local/share/pipx +.local/share/Trash +.local/share/pipx *pgadmin4* *.vscode* -.config/Code/logs/* +.config/Code/logs/* >> }); +if( $cnf -> constanceRegistryCheck(qw( + TZ target + prefix +))){ + die "CNF Repository Check Failed" +}; + +my ($target_fname, $target_arindex_file,$target_archive_file); +{ +use POSIX; +my @uname = POSIX::uname(); +my $dtpart = CNFDateTime -> now({TZ=>$cnf->{TZ}}) ->toSquash(); +my $prefix = $cnf->{prefix}; +$target_fname = $uname[1] . '-' .$dtpart.$prefix; +$target_arindex_file = $cnf->{target}.'/'.$target_fname.'.lst.xz'; +$target_archive_file = $cnf->{target}.'/'.$target_fname.'.xz.enc'; +} -use lib "/home/will/dev_new/web_imports_cloned/CPAN/Curses-UI-0.9609/lib"; -use Curses::UI; -use feature 'say'; -use File::Type; - +our @DIRECTORIES = $cnf -> collection('@DIRECTORIES'); +our @EXCLUDES = $cnf -> collection('@EXCLUDES'); +our ($cnt_root_dirs, $cnt_files, $max, $pos) = (0,0, scalar(@DIRECTORIES),0); our $FT = File::Type->new(); -my @FILES; -my %EXCLUDE_RULES; -my @EXCLUDE_KEYS; -my ($title,$editor,$action,$progressbar,$buffer,$other); +our @FILES; +our %EXCLUDE_RULES; +our @EXCLUDE_KEYS; +our ($title,$editor,$action,$progressbar,$buffer,$other); + our $cui; + $SIG{ WINCH } = sub { + $title->text("DON'T DO THAT -> Screen Resize Event Received!"); + $cui->layout (); + }; + +our $stop = 0; + +sub bringUpScreen(){ + + $cui = new Curses::UI ( + -debug => $cnf->{DEBUG}, + -color_support => 1, + -clear_on_exit => 0 + ); + + $cui->status("Examining Files!"); + + + my $end=$cui->{-height}-4; + my $top=$cui->{-height}-8; + my $cur=$top; + my ($x,$y)=(0,0); + my $win = $cui->add('window_id', 'Window'); + + + $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 => 0, + -vscrollbar => 0, + -hscrollbar => 1, + -showhardreturns => 0, + -wrapping => 0, # wrapping slows down the editor :-( + -text => "Fetching..", + ); + $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", + -bfg => "yellow", + -y=>$cui->{-height}-4 + ); + + $cui->keys_to_lowercase(); + $cui->set_binding(sub{$cui->mainloopExit;}, "\cC"); + $cui->set_binding(sub{$cui->mainloopExit} , "\cQ"); + $cui->set_binding(sub{$stop=1; $action->text('Progress has been stopped!')}, "\cS"); + + +} + + +try{ + + $test->case("Process obtained CNF Settings."); + + 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; + + $test->case("Bring up Curses UI, and start Processing."); + + bringUpScreen(); + + foreach(@DIRECTORIES){ + my $dir = $ENV{HOME} .'/'.$_; + $progressbar->pos($pos++); + $progressbar->draw; + $title->text("Listing:".$dir); + $title->draw; + sleep(1); + recurseDir($dir); + $cnt_root_dirs++; + } + $progressbar->pos($max); + $progressbar->draw; + + $action->text("Done Filtering, CTRL+C to continue!"); + $editor->text($buffer.qq( + Following will be created! + Backup index file :$target_arindex_file + Backup archive file :$target_archive_file + Number of files collected :). $FileCollected::total_cnt.qq( + Size of files collected :). _size_bytes($FileCollected::total_bytes).qq( +)); + $editor->draw; + + $cui->status("DONE! ctrl+Q"); + $cui->layout(); + + + my $yes = $cui->dialog( + -message => "Do you Want to continue?", + -buttons => ['yes','no'], + -values => [1,0], + -title => 'Ready To Backup', + ); + + if ($yes) { + $cui->progress( + -max => scalar(@FILES) - 1, + -message => "Backing Up Files", + ); + my $cnt = 0; my $times=0; $stop = 0; + foreach my $file(@FILES){ + + $cui->setprogress($cnt++); + $action->text($file->{path}); + usleep(1000); + if($stop){ + $yes = $cui->dialog( + -message => "Do you Want to stop?", + -buttons => ['yes','no'], + -values => [1,0], + -title => 'Interruption Detected', + ); + last if $yes; + $stop = 0; + + }elsif($times++>500){ + $yes = $cui->dialog( + -message => "Taking to Long, want to stop?", + -buttons => ['yes','no'], + -values => [1,0], + -title => 'Interruption Detected', + ); + last if $yes; + $times = 0; + } + } + } + + $cui->mainloop() if not $stop; + $cui->leave_curses (); + $cui->reset_curses (); + + + $test->case("After processing up Curses UI."); + +} +catch{ + $test -> dumpTermination($@); + $test -> doneFailed(); +} + package FileCollected { @@ -61,21 +265,21 @@ package FileCollected { my $class = shift; my $path = shift; my $mime = $FT->mime_type($path); - my @stat = stat $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, + mime => $mime, content_length => $content_length, - last_modified => $stat[9], + last_modified => $stat[9], }, $class } } -sub isExcluded($path){ +sub isExcluded($path){ foreach my $exclude(@EXCLUDE_KEYS){ if($path =~ m/$exclude/){ return 1 if $EXCLUDE_RULES{$exclude} -> ($path,$exclude) @@ -100,29 +304,29 @@ sub recurseDir{ foreach my $node(@listing){ next if($node eq '..' || $node eq '.'); - my $current = $dir . "/" . $node; + my $current = $dir . "/" . $node; if(!isExcluded($current)){ - $action->text($current); + $action->text($current); $action->draw; if(-d $current){ recurseDir($current) }else{ $FILES[@FILES] = FileCollected -> new($current); - $buffer .= $current."\n" ; + $buffer .= $current."\n" ; } } } - - $editor->focus(); + + $editor->focus(); $editor->text($buffer); - $editor->cursor_to_end(); - + $editor->cursor_to_end(); + $buffer =""; } sub pathStarts{ my $path = shift; - my $name = shift; + my $name = shift; return $path =~ m/^$name.*/m } sub pathEnds{ @@ -136,7 +340,6 @@ sub pathContains{ return $path =~ m/\/$name\// } - sub _size_bytes{ my $size = shift; if ($size < 1024) { @@ -149,131 +352,3 @@ sub _size_bytes{ 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 $max = @DIRECTORIES; - - $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..", - ); - $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", - -bfg => "yellow", - -y=>$cui->{-height}-4 - ); - -foreach(@DIRECTORIES){ - my $dir = $ENV{HOME} .'/'.$_; - $progressbar->pos($pos++); - $progressbar->draw; - $title->text("Listing:".$dir); - $title->draw; - sleep(1); - recurseDir($dir); - $cnt_root_dirs++; -} - - -$progressbar->pos($max); -$progressbar->draw; - -$action->text("Done Filtering, ctrl+q to quit!"); - - - -$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(); - # -} -catch{ - $test -> dumpTermination($@); - $test -> doneFailed(); -} - -# -# TESTING ANY POSSIBLE SUBS ARE FOLLOWING FROM HERE # -# - - -- 2.34.1