#!/usr/bin/perl
# Parameters:
#
# mark=id
# mark item id as read
#
# redir=id
# redirect to url of item id and mark item as read
#
# fls=(all|unread)
# "feed list show": Show all feeds or only feeds with unread items in feed list
#
# fis= comma separated list of feed ids
# show only listed feeds
# BUG: fis is only effective if sr is non-zero!
#
# sr=n
# show last n read items. Note: Currently these are the n read items with the
# highest ids, which may not be the last items which have been read. Need to
# store the read date for that.
#
# so=1
# also show old items.
#
# sl=1
# show items marked as "later".
use strict;
use warnings;
use v5.14;
use utf8;
use experimental 'smartmatch'; # for given/when
use experimental 'autoderef';
use CGI;
use Cache::Memcached;
use DBI;
use Data::Dumper;
use Encode qw(encode_utf8 decode_utf8);
use POSIX qw(strftime);
use Rss2Html::Scrubber;
use Time::HiRes qw(time);
$| = 1;
my $start = time();
my $q = CGI->new();
binmode STDOUT, ":encoding(UTF-8)";
my $mcd = Cache::Memcached->new(servers => ['127.0.0.1:11211']);
if ($q->param('mark')) {
mark();
} elsif ($q->param('redir')) {
redirect();
} else {
list();
}
sub redirect {
my $dbh = DBI->connect("dbi:SQLite:dbname=rss2html.sqlite", "", "",
{
sqlite_use_immediate_transaction => 1,
});
$dbh->{sqlite_unicode} = 1;
my $item_id = $q->param('redir');
my $item = $dbh->selectrow_hashref("select * from items where id=?", {}, $item_id);
if ($item) {
print "Status: 302\n";
print "Location: $item->{link}\n";
print "\n";
$dbh->do("insert into read(user, item_id) values(?, ?)", {}, $q->remote_user, $item_id);
$mcd->delete(item_info_key($q->remote_user, $item->{feed_id}));
exit(0);
}
print "Status: 404\n";
print "Content-Type: text/html; charset=utf-8\n";
print "\n";
print "not found\n";
}
sub mark {
print_log("mark start");
my $dbh = DBI->connect("dbi:SQLite:dbname=rss2html.sqlite", "", "");
$dbh->{sqlite_unicode} = 1;
my $item_id = $q->param('mark');
my $item = $dbh->selectrow_hashref("select * from items where id=?", {}, $item_id);
if ($item) {
my $q1 = CGI->new($q);
$q1->delete('mark');
print "Status: 302\n";
print "Location: ", $q1->self_url, "\n";
print "\n";
$dbh->do("insert into read(user, item_id) values(?, ?)", {}, $q->remote_user, $item_id);
$mcd->delete(item_info_key($q->remote_user, $item->{feed_id}));
print_log("mark done");
exit(0);
}
print "Status: 404\n";
print "Content-Type: text/html; charset=utf-8\n";
print "\n";
print "not found\n";
print_log("mark failed");
}
sub list {
my $feed_list_show = $q->param('fls') // "all";
my $feed_item_show = $q->param('fis') // '';
my $show_read = $q->param('sr');
my $show_old = $q->param('so');
my $show_later = $q->param('sl');
my %feed_item_show = map(($_+0 => 1), split(/,/, $feed_item_show));
print "Content-Type: text/html; charset=utf-8\n";
print "Refresh: 600\n";
print "\n";
print "\n";
print "\n";
print "
\n";
my $dbh = DBI->connect("dbi:SQLite:dbname=rss2html.sqlite", "", "");
$dbh->{sqlite_unicode} = 1;
print_log("list_feeds start");
list_feeds($dbh, $feed_list_show, $show_old);
print_log("list_feeds done");
my $items;
if ($show_read) {
my $fields = "feeds.id as feed_id, feeds.title as feed_title, allow_img, link, items.title as item_title, content, items.id as item_id, issued, user, lang";
my $tables = "items
join feeds on items.feed_id=feeds.id
left outer join read on (items.id=read.item_id and user=?)";
my @where;
if (%feed_item_show) {
push @where, "feeds.id in (" . join(',', keys %feed_item_show) . ")";
}
if (!$show_old) {
push @where, "(items.old is null or items.old == 0)"
}
my $where = "where " . join(" and ", @where);
my $cmd = "select $fields from $tables $where order by issued";
print_log("$cmd");
my $items1 = $dbh->selectall_arrayref($cmd, { Slice => {} }, $q->remote_user);
my $nrd = 0;
while (@$items1) {
my $item = pop @$items1;
{
no warnings 'uninitialized';
print_log("id=$item->{item_id}, user=$item->{user}");
}
if (!$item->{user}) {
print_log("id=$item->{item_id}: unread");
unshift @$items, $item;
} elsif ($nrd < $show_read) {
print_log("id=$item->{item_id}: $nrd < $show_read");
unshift @$items, $item;
$nrd++;
}
}
} else {
my @where = ("user is null");
if (!$show_old) {
push @where, "(items.old is null or items.old == 0)"
}
my $where = "where " . join(" and ", @where);
$items = $dbh->selectall_arrayref(
"select feeds.id as feed_id, feeds.title as feed_title, allow_img, link, items.title as item_title, content, items.id as item_id, issued, lang
from items
join feeds on items.feed_id=feeds.id
left outer join read on (items.id=read.item_id and user=?)
$where
order by issued",
{ Slice => {} }, $q->remote_user);
}
my $feeds = $dbh->selectall_arrayref(
"select id, title from feeds where update_frequency is not null order by id",
{ Slice => {} }
);
for my $f (@$feeds) {
$f->{selected} = 1 if $feed_item_show{$f->{id}};
}
print_itemlist($items, $feeds);
print_log("list done");
}
sub print_itemlist {
my ($items, $feeds) = @_;
print "
\n";
print "\n";
my $n_items = 0;
my $n_html_mcd = 0;
my $n_scrub_mcd = 0;
my $n_scrub = 0;
print_log("print_itemlist: \$q=" . $q->self_url);
my $q1 = CGI->new($q);
print_log("print_itemlist: \$q1=" . $q1->self_url . " (before loop)");
print_log(scalar @$items . " before remix");
$items = remix($items);
print_log(scalar @$items . " after remix");
for my $item (@$items) {
$n_items++;
my $is_read = defined($item->{user});
my $scrubbed_content = $mcd->get(scrubbed_content_key($item->{item_id}));
if ($scrubbed_content) {
$scrubbed_content = decode_utf8($scrubbed_content);
$n_scrub_mcd++;
} else {
my $scrubber = Rss2Html::Scrubber->new(allow_img => $item->{allow_img});
$scrubbed_content = $scrubber->scrub($item->{content});
$mcd->set(scrubbed_content_key($item->{item_id}), encode_utf8($scrubbed_content), 3600);
$n_scrub++;
}
$q1->param('mark', $item->{item_id});
my $item_class = 'item' . ($is_read ? ' read' : '');
my $langattr = defined $item->{lang} ? "lang='$item->{lang}'" : "";
my $html = "";
$html .= "