From 298bb967bf24cd80dfd7a7088b5f134923b3ec08 Mon Sep 17 00:00:00 2001 From: Will Budic Date: Tue, 21 May 2024 17:08:45 +1000 Subject: [PATCH] Fix. merge with LifeLog changes RSSFeedPlugin implemented CONST on data.. --- system/modules/CNFParser.pm | 8 +++++++- system/modules/RSSFeedsPlugin.pm | 27 +++++++++++++++++---------- tests/DatabaseCentralPlugin.pm | 2 +- tests/dbSQLSetup.cnf | 7 ++++--- 4 files changed, 29 insertions(+), 15 deletions(-) diff --git a/system/modules/CNFParser.pm b/system/modules/CNFParser.pm index ad42b2e..b2eee91 100644 --- a/system/modules/CNFParser.pm +++ b/system/modules/CNFParser.pm @@ -643,8 +643,10 @@ sub doDataInstruction_{ my ($self,$e,$v,$t,$d)=@_; my $add_as_SQLTable = $v =~ s/${meta('SQL_TABLE')}/""/sexi; my $isPostgreSQL = $v =~ s/${meta('SQL_PostgreSQL')}/""/sexi; my $isAutonumber = $v =~ s/${meta('AUTO_NUMBERED')}|${meta('AUTONUMBER')}/""/sexi; + my $isConstant = $v =~ s/$meta_const//s; my $isHeader = $v =~ s/${meta('HAS_HEADER')}/""/sexi; $isHeader = 1 if !$isHeader && ($isAutonumber||$add_as_SQLTable||$isPostgreSQL); + my @hdr; my @rows; my $autonumber = 0; my $ref = $self->{__DATA__}{$e}; if($ref){ @@ -701,8 +703,12 @@ sub doDataInstruction_{ my ($self,$e,$v,$t,$d)=@_; } } my $ret = {name=>$e,header=>\@hdr,data=>\@rows,auto=>$autonumber}; + if($isConstant && not exists $self->{$e}){ + $self->{$e} = \$ret + }elsif($isConstant){ + $self->warn("CONST $e has been previously assigned in -> ".$self->{CNF_CONTENT}) + } $self->{__DATA__}{$e} = \$ret - } ### diff --git a/system/modules/RSSFeedsPlugin.pm b/system/modules/RSSFeedsPlugin.pm index a4c2ffc..47051de 100644 --- a/system/modules/RSSFeedsPlugin.pm +++ b/system/modules/RSSFeedsPlugin.pm @@ -51,20 +51,21 @@ sub process ($self, $parser, $property) { } my @header = @$ptr; my @data = @{$$table->{data}}; + #$parser->log("Header size:".scalar(@header) ); for my $idx (0 .. $#data){ my @col = @{$data[$idx]}; if($idx==0){ - $col[4] = 'last_updated'; + $col[5] = 'last_updated'; if(@header){ my @lbls = CNFMeta::_deRefArray($header[0]); my @spec = CNFMeta::_deRefArray($header[3]); - $lbls[4] = $col[4]; - $spec[4] = $CNFMeta::CNF_DATA_TYPES{DATE}; + $lbls[5] = $col[5]; + $spec[5] = $CNFMeta::CNF_DATA_TYPES{DATE}; $$table->{header} = \[\@lbls,$header[1],$header[2],\@spec]; } }else{ $col[0] = $idx+1; - $col[4] = $self-> {date} -> toTimestamp(); + $col[5] = $self-> {date} -> toTimestamp(); } $data[$idx]=\@col; } @@ -74,7 +75,7 @@ sub process ($self, $parser, $property) { my @col = @{$data[$idx]}; $page .= qq|
  • $col[1] -   [ $col[4] ]
    $col[3]
    • \n|; +
    $col[4]
    Feed Refresh Rate: $col[3]
    \n|; } $page .= ''; $parser->data()->{PAGE} = \$page @@ -95,17 +96,20 @@ sub collectFeeds($self, $parser) { } my $page; my @header = @$ptr; - my @data = @{$$table->{data}}; my $cgi = $parser->const('CGI'); my $feed = $cgi->param('feed') if $cgi; my @lbls = CNFMeta::_deRefArray($header[0]); + $ptr = $$table->{data}; + my @data = @$ptr; my %hdr; - 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 - } - $parser->log("Feed request:$feed") if$feed; + 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 + } + $parser->log("Feed request:$feed data.size:" .scalar(@data)." hdr:".scalar(keys %hdr)) if$feed; for my $idx (0 .. $#data){ my @col = @{$data[$idx]}; + #$parser->log("Feed spec: @col"); my $name = $col[$hdr{Name}]; next if($feed && $feed ne $name); my $tree = fetchFeed($self, $name, $col[$hdr{URL}], $col[$hdr{Expires}], $col[$hdr{Description}]); @@ -130,6 +134,9 @@ sub collectFeeds($self, $parser) { $parser-> warn("Feed '$name' bailed to return a CNFNode tree.") } } + }catch{ + $parser-> error("RSSFeedsPlugin\@collectFeeds() Error:$@") + } $parser->data()->{PAGE} = \$page if $page; } ### PerlCNF TREE to HTML Conversion Routine, XML based RSS of various Internet feeds convert to PerlCNF previously. diff --git a/tests/DatabaseCentralPlugin.pm b/tests/DatabaseCentralPlugin.pm index af58e4f..70e13b8 100644 --- a/tests/DatabaseCentralPlugin.pm +++ b/tests/DatabaseCentralPlugin.pm @@ -204,7 +204,7 @@ sub main ($self, $parser, $property) { try { $dbsTblInsert->execute(@insert) }catch{ - PluginException->throw(error=>"

    Error->$@


    property: $property\[".$tbl->{name}."] ->@insert
    ", show_trace=>1); + PluginException->throw(error=>"\n

    Error->$@


    property: $property\[".$tbl->{name}."] ->@insert
    ", show_trace=>1); } } ### diff --git a/tests/dbSQLSetup.cnf b/tests/dbSQLSetup.cnf index db96333..1c7147b 100644 --- a/tests/dbSQLSetup.cnf +++ b/tests/dbSQLSetup.cnf @@ -48,6 +48,7 @@ <@@< name varchar(32) not null >@@> <@@< url varchar(1024) not null >@@> <@@< description text >@@> + <@@< expires varchar(24) not null >@@> <@@< last_updated datetime >@@> ]cols] ]table] @@ -141,11 +142,11 @@ ID`address`state`city`postcode`country~ 35`Income `Significant yearly income.~ >> -< __HAS_HEADER__ -ID`Name`URL`Description~ +< __HAS_HEADER__ _CONST__ +ID`Name`URL`Description`Expires~ #`Perl Weekly`https://perlweekly.com/perlweekly.rss`A free, once a week e-mail round-up of hand-picked news and articles about Perl. The Perl Weekly ( http://perlweekly.com/ ) is a newsletter including links to blog posts and other news items - related to the Perl programming language.~ + related to the Perl programming language.`3 business days~ >> <-- Disabled for now rest of data, to speed up tests --- #`The Perl Foundation RSS Feed`https://news.perlfoundation.org/rss.xml`The Perl Foundation is dedicated to the advancement -- 2.34.1