From: Will Budic Date: Mon, 4 Nov 2024 03:43:21 +0000 (+1100) Subject: Enabled local package loading of plugins. X-Git-Url: https://lifelog.hopto.org/gitweb/?a=commitdiff_plain;h=27dd7f7ef6eec4633314db3d8b55e80e73135a3b;p=PerlCNF.git Enabled local package loading of plugins. --- diff --git a/system/modules/CNFParser.pm b/system/modules/CNFParser.pm index e181bec..52d8a95 100644 --- a/system/modules/CNFParser.pm +++ b/system/modules/CNFParser.pm @@ -546,7 +546,7 @@ sub doInstruction { my ($self,$e,$t,$v) = @_; $ANONS->{$e} = $v; }catch{ $self->warn("Module DO_ENABLED library failed to load: $v\n"); - $ANONS->{$e} = '<>'; + $ANONS->{$e} = '<>' } }else{ $self->warn("DO_ENABLED is set to false to process a LIB property: $e\n"); @@ -562,7 +562,7 @@ sub doInstruction { my ($self,$e,$t,$v) = @_; } elsif($t eq 'PROCESSOR'){ if(not $self->registerProcessor($e, $v)){ - CNFParserException->throw("PostParseProcessor Registration Failed for '<<$e<$t>$v>>'!\t"); + CNFParserException->throw("PostParseProcessor Registration Failed for '<<$e<$t>$v>>'!\t") } } elsif($t eq 'INSTRUCTOR'){ @@ -601,6 +601,7 @@ sub doInstruction { my ($self,$e,$t,$v) = @_; # But must convert back and fort via an scalar, since actual arrays returned from an hash are references in perl. my $array = $lists{$e}; if(!$array){$array=();$lists{$e} = \@{$array};} + $v = $t if not $v; push @{$array}, $v; } } @@ -626,7 +627,7 @@ sub loadDataFile { my ($self,$e,$path,$v,$i)=@_; read $fh, my $content, -s $fh; close $fh; # - push @files, $path; + push @files, $path; my @tags = ($content =~ m/<<(\w*<(.*?).*?>>)/gs); if(@tags>0){ foreach my $tag (@tags){ @@ -734,14 +735,6 @@ sub doDATAInstructions_{ my ($self,$e,$v,$t,$d)=@_; $self->{__DATA__}{$e} = \$ret } -sub _fetchScriptStat{ - my $cnf_file = shift; - my @stat = stat($cnf_file); - open(my $fh, "<:perlio", $cnf_file ) or die "Can't open $cnf_file -> $!"; - close $fh; - return \@stat; -} - ### # Parses a CNF file or a text content if specified, for this configuration object. ## @@ -810,9 +803,11 @@ sub parse { my ($self, $cnf_file, $content, $del_keys) = @_; # It is NOT allowed to overwrite a constant, so check an issue warning. if($line and not $self->{$name}){ $self->{$name} = $line; - }else{ my - $w = "Skipping and keeping a previously set constance of -> [$name] in ". $self->{CNF_CONTENT}." the new value "; - $w .= ($line eq $self->{$name})?"matches it":"dosean't match -> $line."; $self->warn($w) + }else{ + if($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) + } } } } @@ -1255,7 +1250,7 @@ sub doPlugin { } elsif($pck && $prp && $sub){ ## no critic (RequireBarewordIncludes) - require "$pck.pm"; + require "$pck.pm" if $pck !~ /::/; #Properties are global, all plugins share a %Settings property if specifed, otherwise the default will be set from here only. my $settings = $properties{'%Settings'}; if($settings){ @@ -1514,6 +1509,38 @@ sub getTree { } return; } +## +# Conviently ribs an cnf file for an pl source file to be next too in marriage. +# @$const - Dynamic instance assaignable hash with constances, optional can be undef. +# @$file - Path to CNF file if missing will be created. +# @return a configuration instance per script usually assigned. +## +sub _configure{ + my ($consts,$file) = @_; CNFParserException->throw("File argument not passed!") if not $file; + $file =~ s/\.pl$|\.cgi$|\.perl/.cnf/g; + if(! -e $file){ + my $bf; + foreach my $key (sort keys %$consts){ + $bf .= "$key = ".%$consts{$key}."\n"; + } + $bf = "<<>>" if $bf; + open(my $FH, ">:perlio", $file ) or die "Can't open $file -> $!"; + print $FH $bf; + close $FH; + }else{ + return CNFParser->new($file,$consts) if $consts + } + return CNFParser->new($file); +} +## +# Return actual cnf file stats and state. +## +sub _fetchScriptStat{ + my $cnf_file = shift; + my @stat = stat($cnf_file); + open(my $fh, "<:perlio", $cnf_file ) or die "Can't open $cnf_file -> $!"; close $fh; + return \@stat; +} sub END { $LOG_TRIM_SUB->() if $LOG_TRIM_SUB; diff --git a/tests/testHTMLPossibleTagged.cnf b/tests/testHTMLPossibleTagged.cnf new file mode 100644 index 0000000..6e19205 --- /dev/null +++ b/tests/testHTMLPossibleTagged.cnf @@ -0,0 +1,3 @@ +<<>> \ No newline at end of file diff --git a/tests/testHTMLPossibleTagged.pl b/tests/testHTMLPossibleTagged.pl index 8e8b048..0a876bc 100644 --- a/tests/testHTMLPossibleTagged.pl +++ b/tests/testHTMLPossibleTagged.pl @@ -8,7 +8,120 @@ require CNFParser; my $test = TestManager->new($0); + +package TestHTMLPlugin { + sub new { bless {}, shift } + + sub process { + my ( $class, $parser, $prp, $config, $meta ) = @_; + if ( my $val = $parser->anon($prp) ) { + if ( $config = $parser->anon('App') ) { + if ( $meta = $config->node('meta') ) { + foreach my $node ( @{ $meta->list() } ) { + if ( $node->{data} ) { + $val = dataPropertyToHTMLParagraphs($parser->data()->{$node->{data}}); + } + else { + # Notice DEBUG constance is not an app package required CNF default. + # Not declaring it init of an instance of parser, the following will fail. + # The{DEBUG=>1} is required, be set to 1 or 0. + print $node->toScript() if $parser->{DEBUG}; + $val = processNodeWithProperty( $node, $val ); + } + $parser->anon()->{$prp} = $val; + } + return 1; + } + else { die "Where is meta node in App property?" } + } + else { die "Where is App property?" } + } + else { die "Don't do that!" } + } + use feature qw(signatures); + + sub processNodeWithProperty( $node, $val ) { + my $tag = '<@<\s*' . $node->{tag} . '\s*>@>'; + my $rep = $node->val(); + $rep =~ s/^\s*|\s*$//gs; + $val =~ s/$tag/$rep/xg; + return $val; + } + + sub dataPropertyToHTMLParagraphs($data_struct) { + my $ret = ""; + foreach my $record (@{$$data_struct->{data}}) { + + my $p = qq(
+

@$record[1]

+

@$record[2]

+
); + $ret .= $p ."\n"; + + } + return $ret; + } +} + use Syntax::Keyword::Try; try { + ### + # Test inside tag/macro in value. + ### + die $test->failed() + if not my $cnf = + CNFParser::_configure( { DO_ENABLED => 1, DEBUG => 1 }, $0 ); + $cnf->parse( + undef, qq/ +< + Please <@< meta_1 >@>, this line is a paragraph. + + <@< dynamic_paragraphs >@> +>> +< +[meta[ + <@@< + tag : meta_1 + <#< Dear Visitor >#> + >@@> + <@@< + tag : dynamic_paragraphs + data: dynamic_paragraphs_data + >@@> +]meta] +>> +<< Processor + package : main::TestHTMLPlugin + subroutine : process + property : property +>> +### +# The following can be in a separate cnf file, +# that on browser submit can update or add new records. +### +< __HAS_HEADER__ +ID~Heading`Content~ +$$`Example Paragraph` +Lorem ipsum dolor sit amet. +Aut enim quidem et facere soluta est molestias odio quo quasi cupiditate +ab sint deserunt vel eveniet adipisci quo accusantium labore. +Eum iusto provident et dolorem saepe eum quos internos et quidem soluta +ut error itaque eum doloribus sint.`~ + +>> +/); + + # CNF Constances can't be modifed anymore, let's test. + try { + $cnf->{'$DEBUG'} = 'false' + } + catch { + $test->subcase( + "Passed keep constant test for \$cnf->DEBUG=$cnf->{DEBUG}"); + } + + # + $test->nextCase(); + # ### # Test instance creation. @@ -63,6 +176,10 @@ use Syntax::Keyword::Try; try { $test->subcase("Passed keep constant test for \$cnf->DEBUG=$cnf->{DEBUG}"); } + # + $test->nextCase(); + # + # $test->done(); #