467 lines
15 KiB
Perl
Executable File
467 lines
15 KiB
Perl
Executable File
#!/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);
|
|
$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);
|
|
$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);
|
|
$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 "<meta name='viewport' content='width=device-width, initial-scale=1' />\n";
|
|
print "<link rel='stylesheet' type='text/css' href='rss2html.css'/>\n";
|
|
print "<h1>RSS 2 HTML</h1>\n";
|
|
print "<div class='lastupdate'>", strftime("%Y-%m-%d %H:%M:%S%z", localtime()), "</div>\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, 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 @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}, 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) {
|
|
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 "<div class='itemlist'>\n";
|
|
print "<form action='./'>\n";
|
|
print "<select name='fis'>\n";
|
|
print "<option value=''>\n";
|
|
for my $f (@$feeds) {
|
|
print "<option value='" . $q->escapeHTML($f->{id}) . "' " . ($f->{selected} ? "selected='selected'" : "") .">" . $q->escapeHTML($f->{title}) . "</option>\n";
|
|
}
|
|
print "</select>\n";
|
|
print "<label><input type='checkbox' name='sl'" . ($q->param('sl') ? " checked" : "") . "> Show later</label>\n";
|
|
my $fls = $q->param('fls');
|
|
print "<input type='hidden' name='fls' value='" . $q->escapeHTML($fls) . "'>\n" if defined $fls;
|
|
print "<input type='hidden' name='sr' value='10'>\n";
|
|
print "<input type='submit' value='»'>\n";
|
|
print "</form>\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 .= "<div class='$item_class' $langattr>\n";
|
|
$html .= "<span class='itemno'>" . $item->{item_id} . "</span>\n";
|
|
$html .= "<span class='issued'>" . strftime('%Y-%m-%d %H:%M:%S', localtime($item->{issued})) . "</span>\n";
|
|
my $mark_read_button = "";
|
|
my $mark_later_button = "";
|
|
unless ($is_read) {
|
|
$mark_read_button = "<div class='op'><a href='" . $q->escapeHTML($q1->self_url) . "'>Mark read</a></div>\n";
|
|
$mark_later_button = "<div class='op'><a href='" . $q->escapeHTML($q_later->self_url) . "'>Show later</a></div>\n";
|
|
}
|
|
$html .= $mark_read_button;
|
|
$html .= $mark_later_button;
|
|
$html .= "<div class='feed'>" . $q->escapeHTML($item->{feed_title}) . "</div>\n";
|
|
$html .= "<h2><a href='./?redir=" . $q->escapeHTML($item->{item_id}) . "'>" . $q->escapeHTML($item->{item_title}) . "</a></h2>\n";
|
|
$html .= "<div class='content'>" . $scrubbed_content . "</div>\n";
|
|
$html .= $mark_read_button;
|
|
$html .= $mark_later_button;
|
|
$html .= "<div class='end'></div>\n";
|
|
$html .= "</div\n>";
|
|
print $html;
|
|
|
|
}
|
|
print "</div>\n";
|
|
print_log("itemlist: $n_items items ($n_html_mcd html cached, $n_scrub_mcd scrubbed content cached, $n_scrub scrubbed)");
|
|
}
|
|
|
|
sub remix {
|
|
my ($items) = @_;
|
|
|
|
my $queues = {};
|
|
for my $item (@$items) {
|
|
if (!defined $item->{feed_id}) {
|
|
local $Data::Dumper::Indent = 0;
|
|
print_log("item w/o feed_id: " . Dumper($item));
|
|
}
|
|
$queues->{$item->{feed_id}} //= [];
|
|
push $queues->{$item->{feed_id}}->@*, $item;
|
|
}
|
|
my @ordered_feeds = sort { $queues->{$a}[0]{issued} <=> $queues->{$b}[0]{issued} } keys $queues->%*;
|
|
my $new_items = [];
|
|
my $found;
|
|
do {
|
|
$found = 0;
|
|
for my $feed (@ordered_feeds) {
|
|
my $item = shift $queues->{$feed}->@*;
|
|
if ($item) {
|
|
push $new_items->@*, $item;
|
|
$found++;
|
|
print_log("found an item in feed $feed. " . scalar(@{$queues->{$feed}}) . " items left")
|
|
}
|
|
}
|
|
} while ($found);
|
|
|
|
return $new_items;
|
|
}
|
|
|
|
sub list_feeds {
|
|
my ($dbh, $feed_list_show, $show_old) = @_;
|
|
|
|
no autovivification qw(fetch);
|
|
|
|
my $q1 = CGI->new($q);
|
|
my $other = $feed_list_show eq 'all' ? 'unread' : 'all';
|
|
$q1->param('fls', $other);
|
|
print "<div><a href='", $q->escapeHTML($q1->self_url), "'>$other</a></div>\n";
|
|
print "<div class='feedlist'>\n";
|
|
$dbh->begin_work;
|
|
|
|
my $feeds = $dbh->selectall_arrayref("select * from feeds where active", { Slice => {} });
|
|
my $seconds_per_week = 86400 * 7;
|
|
for my $feed (@$feeds) {
|
|
$feed->{title} //= "-";
|
|
print_item_info($dbh, $feed, $feed_list_show, $show_old);
|
|
|
|
}
|
|
$dbh->commit;
|
|
|
|
print "</div>\n";
|
|
}
|
|
|
|
|
|
sub print_item_info {
|
|
my ($dbh, $feed, $feed_list_show, $show_old) = @_;
|
|
|
|
my $item_info_key = item_info_key($q->remote_user, $feed->{id});
|
|
my $item_info = $mcd->get($item_info_key);
|
|
my $cmd
|
|
= "select count(i.id) as nr_items, max(i.issued) as last_issued, max(i.seen) as last_seen, count(r.item_id) as nr_read
|
|
from items i left outer join (select item_id from read where username=?) r on i.id=r.item_id
|
|
where i.feed_id=?";
|
|
unless ($show_old) {
|
|
$cmd .= " and (old is null or old = 0)";
|
|
}
|
|
unless ($item_info) {
|
|
$item_info
|
|
= $dbh->selectrow_hashref(
|
|
$cmd,
|
|
{},
|
|
$q->remote_user, $feed->{id}
|
|
);
|
|
$mcd->set($item_info_key, $item_info, 3600);
|
|
}
|
|
my $now = time();
|
|
my $unread = $item_info->{nr_items} - $item_info->{nr_read};
|
|
print_log("print_item_info: feed $feed->{id}, nr_items=$item_info->{nr_items}, read=$item_info->{nr_read}, unread=$unread");
|
|
return unless ($unread || $feed_list_show eq 'all');
|
|
|
|
my $q1 = CGI->new($q);
|
|
$q1->param('fis', $feed->{id});
|
|
$q1->param('sr', 10);
|
|
print "<span class='feed_info'>\n";
|
|
print "<span class='feed_id'>", $q->escapeHTML($feed->{id}), "</span>\n";
|
|
print "<span class='feed_title'>",
|
|
"<a href='", $q1->escapeHTML($q1->self_url), "'>",
|
|
$q->escapeHTML($feed->{title}),
|
|
"</a>",
|
|
"</span>\n";
|
|
print "<span class='feed_items'>", $item_info->{nr_items}, "</span>\n";
|
|
print "<span class='feed_unread'>", $unread, "</span>\n";
|
|
print "<span class='feed_lastissued'>", delta_t($item_info->{last_issued}, $now), "</span>\n";
|
|
print "<span class='feed_lastseen'>", delta_t($item_info->{last_seen}, $now), "</span>\n";
|
|
print "</span>\n";
|
|
}
|
|
|
|
|
|
sub print_log {
|
|
my $msg = "@_";
|
|
my $now = time();
|
|
printf STDERR "%s: %s.%06d %f: %s\n", $0, strftime("%H:%M:%S", localtime($now)), ($now - int($now)) * 1E6, $now - $start, $msg;
|
|
}
|
|
|
|
sub delta_t {
|
|
my ($t1, $t2) = @_;
|
|
return "N/A" unless defined $t1 && defined $t2;
|
|
my $dt = $t2 - $t1;
|
|
my $s = "";
|
|
if ($dt < 0) {
|
|
$s .= "-";
|
|
$dt = -$dt;
|
|
}
|
|
given ($dt) {
|
|
when ($_ >= 86400 * 10) {
|
|
$s .= sprintf("%.0fd", $_ / 86400);
|
|
}
|
|
when ($_ >= 86400) {
|
|
$s .= sprintf("%.1fd", $_ / 86400);
|
|
}
|
|
when ($_ >= 3600 * 10) {
|
|
$s .= sprintf("%.0fh", $_ / 3600);
|
|
}
|
|
when ($_ >= 3600) {
|
|
$s .= sprintf("%.1fh", $_ / 3600);
|
|
}
|
|
when ($_ >= 60 * 10) {
|
|
$s .= sprintf("%.0fm", $_ / 60);
|
|
}
|
|
when ($_ >= 60) {
|
|
$s .= sprintf("%.1fm", $_ / 60);
|
|
}
|
|
when ($_ >= 10) {
|
|
$s .= sprintf("%.0fs", $_);
|
|
}
|
|
default {
|
|
$s .= sprintf("%.1fs", $_);
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
sub item_info_key {
|
|
my ($user, $feed_id) = @_;
|
|
$user //= "anonymous";
|
|
return "rss2html/item_info/$user/$feed_id";
|
|
}
|
|
|
|
|
|
sub scrubbed_content_key {
|
|
my ($item_id) = @_;
|
|
return "rss2html/scrubbed_content/$item_id";
|
|
}
|
|
|
|
sub item_html_key {
|
|
my ($item_id, $is_read) = @_;
|
|
return "rss2html/item_html/$item_id/$is_read";
|
|
}
|
|
|
|
|
|
# vim: tw=132 expandtab
|