+++ /dev/null
-added to test mods to lifelog.hopto.org
+###
# SQL Processing part for the Configuration Network File Format.
-# Programed by : Will Budic
-# Source Origin : https://github.com/wbudic/PerlCNF.git
-# Open Source License -> https://choosealicense.com/licenses/isc/
-#
+###
package CNFJSON;
use strict;use warnings;#use warnings::unused;
return $ret;
}
-1;
\ No newline at end of file
+1;
+
+=begin copyright
+Programed by : Will Budic
+EContactHash : 990MWWLWM8C2MI8K (https://github.com/wbudic/EContactHash.md)
+Source : https://github.com/wbudic/PerlCNF.git
+Documentation : Specifications_For_CNF_ReadMe.md
+ This source file is copied and usually placed in a local directory, outside of its repository project.
+ So it could not be the actual or current version, can vary or has been modiefied for what ever purpose in another project.
+ Please leave source of origin in this file for future references.
+Open Source Code License -> https://github.com/wbudic/PerlCNF/blob/master/ISC_License.md
+=cut copyright
\ No newline at end of file
*{"${caller}::meta_on_demand"} = sub {return _meta("ON_DEMAND")};
# Process or load last (includes0.
*{"${caller}::meta_process_last"} = sub {return _meta("PROCESS_LAST")};
+ *{"${caller}::meta_const"} = sub {return _meta("CONST")};
###
# Tree instruction has been scripted in collapsed nodes shorthand format.
# Shortife is parsed faster and with less recursion, but can be prone to script errors,
$self->{CNF_VERSION} = VERSION;
$self->{__DATA__} = {};
undef $SQL;
- bless $self, $class; $self->parse($path, undef, $del_keys) if($path);
+ bless $self, $class; $self -> parse($path, undef, $del_keys) if($path);
return $self;
}
#
our $meta_priority = meta_priority();
our $meta_on_demand = meta_on_demand();
our $meta_process_last = meta_process_last();
+our $meta_const = meta_const();
###
# Returns undef if it doesn't exist, and exception if constance required is set;
sub const { my ($self,$c)=@_;
return $self->{$c} if exists $self->{$c};
- CNFParserException->throw("Required constants variable ' $c ' not defined in config!") if $CONSTREQ;
+ 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.
+ $c = '$'.$c;
+ return $self->{$c} if exists $self->{$c};
return;
}
$anons = $self->{'__ANONS__'};
}
- # We control from here the constances, as we need to unlock them if previous parse was run.
+ # We control from here the constances, as we need to unlock them if a previous parse was run.
unlock_hash(%$self);
if(not $content){
if(isReservedWord($self,$t)){
my $isVar = ($t eq 'VARIABLE' || $t eq 'VAR');
if($t eq 'CONST' or $isVar){ #constant multiple properties.
- foreach my $line(split '\n', $v) {
- $line =~ s/^\s+|\s+$//; # strip unwanted spaces
- $line =~ s/\s*>$//;
- $line =~ m/([\$\w]*)(\s*=\s*)(.*)/g;
- my $name = $1;
- $line = $3; $line =~ s/^\s*(['"])(.*)\g{1}$/$2/ if $line;#strip quotes
- if(defined $name){
- if($isVar){
- $anons ->{$name} = $line if $line
- }else{
- if($line and not $self->{$name}){# Not allowed to overwrite constant.
- $self->{$name} = $line;
- }else{
- warn "Skipping and keeping previously set constance -> [$name] the new value ".
- ($line eq $self->{$name})?"matches it":"dosean't match -> $line."
- }
+ foreach my $line(split '\n', $v) {
+ my $isMETAConst = $line =~ s/$meta_const//se;
+ $line =~ s/^\s+|\s+$//; # strip unwanted spaces
+ $line =~ s/\s*>$//;
+ $line =~ m/([\$\w]*)(\s*=\s*)(.*)/g;
+ my $name = $1;
+ $line = $3; $line =~ s/^\s*(['"])(.*)\g{1}$/$2/ if $line;#strip quotes
+ if(defined $name){
+ if($isVar && not $isMETAConst){
+ $anons ->{$name} = $line if $line
+ }else{
+ $name =~ s/^\$// if $isMETAConst;
+ # 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{
doInstruction($self,$v,$t,undef);
}
# $t = $1;
# $v = $2;
# }
+ my $IsConstant = ($v =~ s/$meta_const/""/sexi);
my @lst = ($isArray?split(/[,\n]/, $v):split('\n', $v)); $_="";
my @props = map {
s/^\s+|\s+$//; # strip unwanted spaces
my $macro = 0;
if(exists($properties{$t})){
if($self->isReservedWord($t)){
- $self->warn("Skipped overwritting reserved property -> $t.");
+ $self->warn("Skipped a try to overwrite a reserved property -> $t.");
next
}else{
%hsh = %{$properties{$t}}
next if (@pair != 2 || $pair[0] =~ m/^[#\\\/]+/m);#skip, it is a comment or not '=' delimited line.
my $name = $pair[0];
my $value = $pair[1]; $value =~ s/^\s*["']|['"]$//g;#strip quotes
+ if($IsConstant && $p =~ m/\$[A-Z]+/){# if meta constant we check $p if signified to transfer into a CNF constance.
+ if(not exists $self->{$name}){
+ $self->{$name} = $value;
+ next;
+ }
+ }
if($macro){
my @arr = ($value =~ m/(\$\$\$.+?\$\$\$)/gm);
foreach my $find(@arr) {
delete $self->{$k} if exists $self->{$k}
}
my $runProcessors = $self->{RUN_PROCESSORS} ? 1: 0;
- lock_hash(%$self);#Make repository finally immutable.
+ $self = lock_hash(%$self);#Make repository finally immutable.
runPostParseProcessors($self) if $runProcessors;
if ($LOG_TRIM_SUB){
$LOG_TRIM_SUB->();
$message = "$type $message" if $isWarning;
- if($message =~ /^ERROR/ || $isWarning){
+ if($message =~ /^ERROR/ || ($isWarning && $self->{ENABLE_WARNINGS})){
warn $time . " " .$message;
}
elsif(%log && $log{console}){
--- /dev/null
+package DataProcessorPlugin;
+
+use strict;
+use warnings;
+
+use feature qw(signatures);
+use Scalar::Util qw(looks_like_number);
+use Clone qw(clone);
+use Date::Manip;
+
+use constant VERSION => '1.0';
+
+sub new ($class, $plugin){
+ my $settings;
+ if($plugin){
+ $settings = clone $plugin; #clone otherwise will get hijacked with blessings.
+ }
+ return bless $settings, $class
+}
+
+###
+# Process config data to contain expected fields and data.
+###
+sub process ($self, $parser, $property) {
+ my @data = $parser->data()->{$property};
+#
+# The sometime unwanted side of perl is that when dereferencing arrays,
+# modification only is visible withing the scope of the block.
+# Following processes and creates new references on modified data.
+# And is the reason why it might look ugly or has some unecessary relooping.
+#
+ for my $did (0 .. $#data){
+ my @entry = @{$data[$did]};
+ my $ID_Spec_Size = 0;
+ my @SPEC;
+ my $mod = 0;
+ foreach (@entry){
+ my @row = @$_;
+ $ID_Spec_Size = scalar @row;
+ for my $i (0..$ID_Spec_Size-1){
+ if($row[$i] =~ /^#/){
+ $SPEC[$i] = 1;
+ }
+ elsif($row[$i] =~ /^@/){
+ $SPEC[$i] = 2;
+ }
+ else{
+ $SPEC[$i] = 3;
+ }
+ }#rof
+ if($row[0]){
+ # Cleanup header label row for the columns, if present.
+ shift @entry;
+ #we are done spec obtained from header just before.
+ last
+ }
+ }
+ my $size = $#entry;
+ my $padding = length($size);
+ for my $eid (0 .. $size){
+ my @row = @{$entry[$eid]};
+ if ($ID_Spec_Size){
+ # If zero it is presumed ID field, corresponding to row number + 1 is our assumed autonumber.
+ if($row[0] == 0){
+ my $times = $padding - length($eid+1);
+ $row[0] = zero_prefix($times,$eid+1);
+ $mod = 1
+ }
+ if(@row!=$ID_Spec_Size){
+ warn "Row data[$eid] doesn't match expect column count: $ID_Spec_Size\n @row";
+ }else{
+ for my $i (1..$ID_Spec_Size-1){
+ if(not matchType($SPEC[$i], $row[$i])){
+ warn "Row in row[$i]='$row[$i]' doesn't match expect data type, contents: @row";
+ }
+ elsif($SPEC[$i]==2){
+ my $dts = $row[$i];
+ my $dt = UnixDate(ParseDateString($dts), "%Y-%m-%d %T");
+ if($dt){ $row[$i] = $dt; $mod = 1 }else{
+ warn "Row in row[$i]='$dts' has imporper date format, contents: @row";
+ }
+ }else{
+ my $v = $row[$i];
+ $v =~ s/^\s+|\s+$//gs;
+ $row[$i] =$v;
+ }
+ }
+ }
+ $entry[$eid]=\@row if $mod; #<-- re-reference as we changed the row. Something hard to understand.
+ }
+ }
+ $data[$did]=\@entry if $mod;
+ }
+ $parser->data()->{$property} = \@data;
+}
+sub zero_prefix ($times, $val) {
+ if($times>0){
+ return '0'x$times.$val;
+ }else{
+ return $val;
+ }
+}
+sub matchType($type, $val, @rows) {
+ if ($type==1 && looks_like_number($val)){return 1}
+ elsif($type==2){
+ if($val=~/\d*\/\d*\/\d*/){return 1}
+ else{
+ return 1;
+ }
+ }
+ elsif($type==3){return 1}
+ return 0;
+}
+
+1;
+
+=begin copyright
+Programed by : Will Budic
+EContactHash : 990MWWLWM8C2MI8K (https://github.com/wbudic/EContactHash.md)
+Source : https://github.com/wbudic/PerlCNF.git
+Documentation : Specifications_For_CNF_ReadMe.md
+ This source file is copied and usually placed in a local directory, outside of its repository project.
+ So it could not be the actual or current version, can vary or has been modiefied for what ever purpose in another project.
+ Please leave source of origin in this file for future references.
+Open Source Code License -> https://github.com/wbudic/PerlCNF/blob/master/ISC_License.md
+=cut copyright
\ No newline at end of file
--- /dev/null
+package DataProcessorWorldCitiesPlugin;
+
+use strict;
+use warnings;
+
+use feature qw(signatures);
+use Scalar::Util qw(looks_like_number);
+
+
+sub new ($class,$plugin){
+ return bless {}, $class
+}
+
+###
+# Process config data to contain expected fields and data.
+###
+sub process ($self, $parser, $property) {
+
+ my @data = $parser->data()->{$property};
+
+ for my $did (0 .. $#data){
+ my @entry = @{$data[$did]};
+ my $Spec_Size = 0;
+ my $mod = 0;
+ # Cleanup header labels row.
+ shift @entry;
+ }
+ $parser->data()->{$property} = \@data;
+}
+
+###
+# Process config data directly from a raw data file containing no Perl CNF tags.
+# This is prefered way if your data is over, let's say 10 000 rows.
+###
+
+sub loadAndProcess ($self, $parser, $property) {
+
+ my @data;
+ local $/ = undef;
+ my $file = $parser->anon($property);
+ open my $fh, '<', $file or die ("$!");
+ foreach(split(/~\n/,<$fh>)){
+ my @a;
+ $_ =~ s/\\`/\\f/g;#We escape to form feed the found 'escaped' backtick so can be used as text.
+ foreach my $d (split /`/, $_){
+ $d =~ s/\\f/`/g; #escape back form feed to backtick.
+ $d =~ s/~$//; #strip dangling ~ if there was no \n
+ my $t = substr $d, 0, 1;
+ if($t eq '$'){
+ my $v = $d; #capture spected value.
+ $d =~ s/\$$|\s*$//g; #trim any space and system or constant '$' end marker.
+ if($v=~m/\$$/){
+ $v = $self->{$d}; $v="" if not $v;
+ }
+ else{
+ $v = $d;
+ }
+ push @a, $v;
+ }
+ else{
+ if($t =~ /^\#(.*)/) {#First is usually ID a number and also '#' signifies number.
+ $d = $1;#substr $d, 1;
+ $d=0 if !$d; #default to 0 if not specified.
+ push @a, $d
+ }
+ else{
+ push @a, $d;
+ }
+ }
+ }
+ $data[@data]= \@a;
+ }
+ close $fh;
+ $parser->data()->{$property} = \@data;
+}
+
+1;
+
+=begin copyright
+Programed by : Will Budic
+EContactHash : 990MWWLWM8C2MI8K (https://github.com/wbudic/EContactHash.md)
+Source : https://github.com/wbudic/PerlCNF.git
+Documentation : Specifications_For_CNF_ReadMe.md
+ This source file is copied and usually placed in a local directory, outside of its repository project.
+ So it could not be the actual or current version, can vary or has been modiefied for what ever purpose in another project.
+ Please leave source of origin in this file for future references.
+Open Source Code License -> https://github.com/wbudic/PerlCNF/blob/master/ISC_License.md
+=cut copyright
\ No newline at end of file
###
# Process config data to contain expected fields and data.
###
-sub convert ($self, $parser, $property) {
+sub convert ($self, $parser, $property) {
my ($buffer,$title, $link, $body_attrs, $body_on_load, $give_me);
my $cgi = CGI -> new();
- my $cgi_action = $cgi-> param('action');
- my $cgi_doc = $cgi-> param('doc');
+ my $cgi_action = $cgi-> param('action');
+ my $cgi_doc = $cgi-> param('doc');
my $tree = $parser-> anon($property);
- die "Tree property '$property' is not available!" if(!$tree or ref($tree) ne 'CNFNode');
+ die "Tree property '$property' is not available!" if(!$tree or ref($tree) ne 'CNFNode');
+
try{
- #TODO 20231002 Move -> %WEBAPP_SETTINGS into utility.
- my %THEME;
- my %wsettings = $parser -> collection('%WEBAPP_SETTINGS');
- if(%wsettings){
- my $theme = $wsettings{THEME};
- my @els = split(/, /, $theme);
- foreach (@els) {
- my ($key,$val) = split(/\s*=>\s*/, $_);
- $THEME{$key} = $val;
- last if $key eq 'css'
- }
- my $theme_file = $wsettings{LOG_PATH}.'current_theme';
- $theme_file =~ /^\.\.\/\.\.\// if(-e $theme_file);
- if(-e $theme_file){
- open my $fh, '<', $theme_file;
- my $theme = <$fh>;
- close($fh);
- if($theme =~ m/standard/i){
- $THEME{css} = "wsrc/main.css"
- }elsif($theme =~ m/moon/i){
- $THEME{css} = "wsrc/main_moon.css"
- }
- elsif($theme =~ m/sun/i){
- $THEME{css} = "wsrc/main_sun.css"
- }
- elsif($theme =~ m/earth/i){
- $THEME{css} = "wsrc/main_earth.css"
- }
- }
- }
- if (exists $parser->{'HTTP_HEADER'}){
+
+ if (exists $parser->{'HTTP_HEADER'}){
$buffer .= $parser-> {'HTTP_HEADER'};
- }else{
+ }else{
if(exists $parser -> collections()->{'%HTTP_HEADER'}){
my %http_hdr = $parser -> collection('%HTTP_HEADER');
$buffer = $cgi->header(%http_hdr);
}
}
- if ($cgi_action and $cgi_action eq 'load'){
- $buffer .= $cgi->start_html(); my
+
+ if ($cgi_action and $cgi_action eq 'load'){
+ $buffer .= $cgi->start_html(); my
$load = loadDocument($parser, $cgi_doc);
if($load){
- $buffer .= $$load if $load;
+ $buffer .= $$load if $load;
}else{
$buffer .= "Document is empty: $cgi_doc\n"
- }
+ }
}else{
$title = $tree -> {'Title'} if exists $tree->{'Title'};
$link = $tree -> {'HEADER'};
if($link){
if(ref($link) eq 'CNFNode'){
my $arr = $link->find('CSS/@@');
- foreach (@$arr){
- if($THEME{css} && $_->val() =~ /main.css$/){
- push @hhshCSS, {-type => 'text/css', -src => $THEME{css}};
- }else{
- push @hhshCSS, {-type => 'text/css', -src => $_->val()};
- }
+ foreach (@$arr){
+ push @hhshCSS, {-type => 'text/css', -src => $_->val()};
}
$arr = $link->find('JS/@@');
- foreach (@$arr){
- push @hhshJS, {-type => 'text/javascript', -src => $_->val()};
- }
+ foreach (@$arr){
+ push @hhshJS, {-type => 'text/javascript', -src => $_->val()};
+ }
$arr = $link -> find('STYLE');
if(ref($arr) eq 'ARRAY'){
foreach (@$arr){
}
$arr = $link -> find('SCRIPT');
if(ref($arr) eq 'ARRAY'){
- foreach (@$arr){
- my $attributes = _nodeHTMLAtrributes($_);
- $give_me .= "\n<script$attributes>\n".$_ -> val()."\n</script>\n"
+ foreach (@$arr){
+ $give_me .= "\n<script>\n".$_ -> val()."\n</script>\n"
}}else{
- my $attributes = _nodeHTMLAtrributes($arr);
- $give_me .= "\n<script$attributes>\n".$arr -> val()."\n</script>\n";
-
+ $give_me .= "\n<script>\n".$arr -> val()."\n</script>\n"
}
- }
- delete $tree -> {'HEADER'};
- }
+ }
+ delete $tree -> {'HEADER'};
+ }
$buffer .= $cgi->start_html(
-title => $title,
-onload => $body_on_load,
- # -BGCOLOR => $colBG,
+ # -BGCOLOR => $colBG,
-style => \@hhshCSS,
-script => \@hhshJS,
-head=>$give_me,
$body_attrs
);
- foreach my $node($tree->nodes()){
+ foreach my $node($tree->nodes()){
$buffer .= build($parser, $node) if $node;
}
$buffer .= $cgi->end_html();
}
$parser->data()->{$property} = \$buffer;
}catch($e){
- HTMLIndexProcessorPluginException->throw(error=>$e);
+ HTMLIndexProcessorPluginException->throw(error=>$e ,show_trace=>1);
}
}
-
-sub _nodeHTMLAtrributes {
- my $node = shift;
- my $attributes =" ";
- my @attrs = $node -> attributes();
- foreach my $a(@attrs){
- $attributes .= @$a[0] . " = \"" .@$a[1]."\""
- }
- $attributes = "" if $attributes eq " ";
- return $attributes
-}
#
sub loadDocument($parser, $doc) {
my $slurp = do {
- open my $fh, '<:encoding(UTF-8)', $doc or HTMLIndexProcessorPluginException->throw(error=>"Document not avaliable -> \"$doc\" ", show_trace=>1);
+ open my $fh, '<:encoding(UTF-8)', $doc or HTMLIndexProcessorPluginException->throw("Document not avaliable: $doc");
local $/;
- <$fh>;
+ <$fh>;
};
if($doc =~/\.md$/){
- require MarkdownPlugin;
- my @r = @{MarkdownPlugin->new(undef)->parse($slurp)};
+ require MarkdownPlugin;
+ my @r = @{MarkdownPlugin->new()->parse($slurp)};
return $r[0];
}
- return \$slurp
+ return \$slurp
}
###
# Builds the html version out of a CNFNode.
-# CNFNode with specific tags here are converted also here,
+# CNFNode with specific tags here are converted also here,
# those that are out of the scope for normal standard HTML tags.
# i.e. HTML doesn't have row and cell tags. Neither has meta links syntax.
###
$bf .= "\t"x$tabs."<div".placeAttributes($node).">\n"."\t"x$tabs."<div>";
foreach my $n($node->nodes()){
if($n->{'_'} ne '#'){
- my $b = build($parser, $n, $tabs+1);
+ my $b = build($parser, $n, $tabs+1);
$bf .= "$b\n" if $b;
}
}
if($node->{'#'}){
my $v = $node->val();
$v =~ s/\n\n+/\<\/br>\n/gs;
- $bf .= "\t<div>\n\t<p>\n".$v."</p>\n\t</div>\n";
+ $bf .= "\t<div>\n\t<p>\n".$v."</p>\n\t</div>\n";
}
$bf .= "\t</div>\t</div>\n"
}elsif( $name eq 'row' || $name eq 'cell' ){
$bf .= "$b\n" if $b;
}
}
- $bf .= $node->val()."\n" if $node->{'#'};
+ $bf .= $node->val()."\n" if $node->{'#'};
$bf .= "\t"x$tabs."</div>"
}elsif( $name eq 'img' ){
$bf .= "\t\t<img".placeAttributes($node)."/>\n";
}elsif($name eq 'list_images'){
my $paths = $node->{'@@'};
- foreach my $ndp (@$paths){
+ foreach my $ndp (@$paths){
my $path = $ndp -> val();
my @ext = split(',',"jpg,jpeg,png,gif");
my $exp = " ".$path."/*.". join (" ".$path."/*.", @ext);
$bf .= qq(\t<div class='row'><div class='cell'>);
$bf .= qq(\t<a href="$enc"><img src="$enc" with='120' height='120'><br>$fn</a>\n</div></div>\n);
}
- }
+ }
}elsif($name eq '!'){
return "<!--".$node->val()."-->\n";
-
+
}elsif($node->{'*'}){ #Links are already captured, in future this might be needed as a relink from here for dynamic stuff?
my $lval = $node->{'*'};
- if($name eq 'file_list_html'){ #Special case where html links are provided.
+ if($name eq 'file_list_html'){ #Special case where html links are provided.
foreach(split(/\n/,$lval)){
$bf .= qq( [ $_ ] |) if $_
}
$bf =~ s/\|$//g;
}else{ #Generic included link value.
#is there property data for it?
- my $prop = $parser->data()->{$node->name()};
+ my $prop = $parser->data()->{$node->name()};
#if not has it been passed as an page constance?
- $prop = $parser -> {$node->name()} if !$prop;
+ $prop = $parser -> {$node->name()} if !$prop;
if ( !$prop ) {
if ( $parser->{STRICT} ) { die "Not found as property link -> " . $node->name()}
else { warn "Not found as property link -> " . $node->name()}
}
else{
my $spaced = 1;
- $bf .= "\t"x$tabs."<".$node->name().placeAttributes($node).">";
- foreach my $n($node->nodes()){
- my $b = build($parser, $n,$tabs+1);
- if ($b){
+ $bf .= "\t"x$tabs."<".$node->name().placeAttributes($node).">";
+ foreach my $n($node->nodes()){
+ my $b = build($parser, $n,$tabs+1);
+ if ($b){
if($b =~/\n/){
$bf =~ s/\n$//gs;
$bf .= "\n$b\n"
}else{
- $spaced=0;
- $bf .= $b;
+ $spaced=0;
+ $bf .= $b;
}
- }
+ }
}
-
+
if ($node->{'#'}){
$bf .= $node->val();
$bf .= "</".$node->name().">";
if(@$_[0] ne '#' && @$_[0] ne '_'){
if(@$_[1]){
$ret .= " ".@$_[0]."=\"".@$_[1]."\"";
- }else{
+ }else{
$ret .= " ".@$_[0]." ";
}
}
###
# HTML converter Plugin from PerlCNF to HTML from TREE instucted properties.
# Processing of these is placed in the data parsers data.
-# Programed by : Will Budic
-# Notice - This source file is copied and usually placed in a local directory, outside of its project.
-# So it could not be the actual or current version, can vary or has been modiefied for what ever purpose in another project.
-# Please leave source of origin in this file for future references.
-# Source of Origin : https://github.com/wbudic/PerlCNF.git
-# Documentation : Specifications_For_CNF_ReadMe.md
-# Open Source Code License -> https://choosealicense.com/licenses/isc/
-#
+###
package HTMLProcessorPlugin;
use strict;
use Exception::Class ('HTMLProcessorPluginException');
use feature qw(signatures);
use Scalar::Util qw(looks_like_number);
-use Date::Manip;
+use Clone qw(clone);
use constant VERSION => '1.0';
-sub new ($class, $fields={Language=>'English',DateFormat=>'US'}){
-
- if(ref($fields) eq 'REF'){
- warn "Hash reference required as argument for fields!"
+sub new ($class, $plugin){
+ my $settings;
+ if($plugin){
+ $settings = clone $plugin; #clone otherwise will get hijacked with blessings.
}
- my $lang = $fields->{'Language'};
- my $frmt = $fields->{'DateFormat'};
- Date_Init("Language=$lang","DateFormat=$frmt");
-
- return bless $fields, $class
+ return bless $settings, $class
}
###
my $v = $_->val();
$bfHDR .= qq(\t<script src="$v"></script>\n);
}
- my $ps = $link -> find('STYLE');
- $style = "\n<style>\n". $ps -> val()."</style>" if($ps);
- $ps = $link -> find('JAVASCRIPT');
- $jscript = "\n<script>\n". $ps -> val()."</script>" if($ps);
+ # Glob find '/*' now has guaranteed array cast derefence return. Even if nothing found. Some folks will cringe on that. Ahahaha!
+ $arr = $link -> find('STYLE/*');
+ foreach (@$arr){
+ $style = "\n<style>\n". $_ -> val()."</style>"
+ }
+ $arr = $link -> find('JAVASCRIPT/*');
+ foreach (@$arr){
+ $jscript = "\n<script>\n". $_ -> val()."</script>"
+ }
}
delete $tree -> {'HEADER'};
-1;
\ No newline at end of file
+1;
+
+=begin copyright
+Programed by : Will Budic
+EContactHash : 990MWWLWM8C2MI8K (https://github.com/wbudic/EContactHash.md)
+Source : https://github.com/wbudic/PerlCNF.git
+Documentation : Specifications_For_CNF_ReadMe.md
+ This source file is copied and usually placed in a local directory, outside of its repository project.
+ So it could not be the actual or current version, can vary or has been modiefied for what ever purpose in another project.
+ Please leave source of origin in this file for future references.
+Open Source Code License -> https://github.com/wbudic/PerlCNF/blob/master/ISC_License.md
+=cut copyright
\ No newline at end of file
lifelog.hopto.org / LifeLog.git / commitdiff