#!/usr/bin/perl
# Parameters:
#
# mark=id
# mark item id as read
#
# later=id
# mark item id as "later"
#
# 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.24;
use utf8;
use experimental 'smartmatch'; # for given/when
use experimental 'postderef';
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);
my $db_conn = "dbi:Pg:dbname=rss2html";
$| = 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('later')) {
mark_later();
} elsif ($q->param('redir')) {
redirect();
} else {
list();
}
sub redirect {
my $dbh = DBI->connect($db_conn);
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(username, item_id) values(?, ?)", {}, $q->remote_user, $item_id);
$dbh->do("delete from later where username=? and item_id=?", {}, $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($db_conn, "", "");
$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(username, item_id) values(?, ?)", {}, $q->remote_user, $item_id);
$dbh->do("delete from later where username=? and item_id=?", {}, $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 mark_later {
print_log("mark_later start");
my $dbh = DBI->connect($db_conn, "", "");
$dbh->{sqlite_unicode} = 1;
my $item_id = $q->param('later');
my $item = $dbh->selectrow_hashref("select * from items where id=?", {}, $item_id);
if ($item) {
my $q1 = CGI->new($q);
$q1->delete('later');
print "Status: 302\n";
print "Location: ", $q1->self_url, "\n";
print "\n";
$dbh->do("insert into later(username, item_id) values(?, ?)", {}, $q->remote_user, $item_id);
$dbh->do("delete from read where username=? and item_id=?", {}, $q->remote_user, $item_id);
$mcd->delete(item_info_key($q->remote_user, $item->{feed_id}));
print_log("mark_later 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_later 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($db_conn, "", "");
$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, read.username, lang";
my $tables = "items
join feeds on items.feed_id=feeds.id
left outer join read on (items.id=read.item_id and username=?)";
my @params = ($q->remote_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);
if ($show_later) {
$tables .= " left outer join later on (items.id=later.item_id and later.username=?)";
push @params, $q->remote_user;
$where .= " or (later.username is not null)"
}
my $cmd = "select $fields from $tables $where order by issued";
print_log("$cmd");
my $items1 = $dbh->selectall_arrayref($cmd, { Slice => {} }, @params);
my $nrd = 0;
while (@$items1) {
my $item = pop @$items1;
{
no warnings 'uninitialized';
print_log("id=$item->{item_id}, username=$item->{username}");
}
if (!$item->{username}) {
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 = ("read.username is null");
if (!$show_later) {
push @where, "later.username is null"
}
if (!$show_old) {
if ($show_later) {
push @where, "(later.username is not null or items.old is null or items.old = 0)"
} else {
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 read.username=?)
left outer join later on (items.id=later.item_id and later.username=?)
$where
order by issued",
{ Slice => {} }, $q->remote_user, $q->remote_user);
}
my $feeds = $dbh->selectall_arrayref(
"select id, title from feeds where active 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)");
my $q_later = CGI->new($q);
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->{username});
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});
$q_later->param('later', $item->{item_id});
my $item_class = 'item' . ($is_read ? ' read' : '');
my $langattr = defined $item->{lang} ? "lang='$item->{lang}'" : "";
my $html = "";
$html .= "