#!/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 "

RSS 2 HTML

\n"; print "
", strftime("%Y-%m-%d %H:%M:%S%z", localtime()), "
\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"; print "\n"; my $fls = $q->param('fls'); print "\n" if defined $fls; print "\n"; 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 .= "
\n"; $html .= "" . $item->{item_id} . "\n"; $html .= "" . strftime('%Y-%m-%d %H:%M:%S', localtime($item->{issued})) . "\n"; unless ($is_read) { print_log("print_itemlist: \$q1=" . $q1->self_url . " (in loop)"); $html .= "\n"; } $html .= "
" . $q->escapeHTML($item->{feed_title}) . "
\n"; $html .= "

" . $q->escapeHTML($item->{item_title}) . "

\n"; $html .= "
" . $scrubbed_content . "
\n"; unless ($is_read) { $html .= "\n"; } $html .= "
\n"; $html .= ""; print $html; } print "
\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 "
$other
\n"; print "
\n"; $dbh->begin_work; my $feeds = $dbh->selectall_arrayref("select * from feeds where update_frequency is not null", { 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 "
\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 user=?) 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 "\n"; print "", $q->escapeHTML($feed->{id}), "\n"; print "", "", $q->escapeHTML($feed->{title}), "", "\n"; print "", $item_info->{nr_items}, "\n"; print "", $unread, "\n"; print "", delta_t($item_info->{last_issued}, $now), "\n"; print "", delta_t($item_info->{last_seen}, $now), "\n"; print "\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) = @_; 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