]> lifelog.hopto.org Git - PerlCNF.git/commitdiff
Fix. merge with LifeLog changes RSSFeedPlugin implemented CONST on data..
authorWill Budic <redacted>
Tue, 21 May 2024 07:08:45 +0000 (17:08 +1000)
committerWill Budic <redacted>
Tue, 21 May 2024 07:08:45 +0000 (17:08 +1000)
system/modules/CNFParser.pm
system/modules/RSSFeedsPlugin.pm
tests/DatabaseCentralPlugin.pm
tests/dbSQLSetup.cnf

index ad42b2ed34f1c94b0a1634b9e114928fa677ff8f..b2eee91f14e2644b240d39291a24e67a87ecc0ae 100644 (file)
@@ -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
-
 }
 
 ###
index a4c2ffcd3e577e61eb5e1a97e0dd7e10fa849ac8..47051de6dbeed747b309b61ad1e222997d7dd825 100644 (file)
@@ -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|<li><span style="border: 1px solid black; padding: 5px; padding-bottom: 0px;">
            <a onclick="return fetchFeed('$col[1]')" style="cursor: pointer;"> <b>$col[1]</b> </a></span>
-            &nbsp;&nbsp;[ $col[4] ]<dt style="padding:10px;">$col[3]</dt></li>\n|;
+           <dt style="padding:5px;">$col[4]</dt><dt style="padding:5px;">Feed Refresh Rate: $col[3]</dt></li>\n|;
        }
        $page .= '</ol></div>';
        $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.
index af58e4f19bba29affaf97580ab05b7adca93d9e2..70e13b8778da657d0636db8821ac5176f99d645e 100644 (file)
@@ -204,7 +204,7 @@ sub main ($self, $parser, $property) {
                     try {
                        $dbsTblInsert->execute(@insert)
                     }catch{
-                        PluginException->throw(error=>"<p>Error->$@</p><br><pre>property: $property\[".$tbl->{name}."] ->@insert</pre>",  show_trace=>1);
+                        PluginException->throw(error=>"\n<p>Error->$@</p><br><pre>property: $property\[".$tbl->{name}."] ->@insert</pre>",  show_trace=>1);
                     }
                 }
                 ###
index db963333d58753f49161d36cad26181a0f0d6599..1c7147b7045905b0330f257c2d8067af9ded8449 100644 (file)
@@ -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.~
 >>
 
-<<RSS_FEEDS<DATA> __HAS_HEADER__
-ID`Name`URL`Description~
+<<RSS_FEEDS<DATA> __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