#!/usr/bin/perl # Parameters # # s=string # search string use v5.24; use warnings; use utf8; 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']); search(); sub search { 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($db_conn, "", ""); $dbh->{sqlite_unicode} = 1; 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; my $search_expr = $q->param('s'); print_searchform(); if ($search_expr) { my @terms = split(' ', $search_expr); # XXX - quotes? for my $t (@terms) { my $t2 = $t; my $not = ""; if ($t2 =~ /^-/) { $not = "not "; $t2 = substr($t2, 1); } $t2 =~ s/_/\\_/g; $t2 =~ s/%/\\%/g; $t2 =~ s/\?/_/g; $t2 =~ s/\*/%/g; $t2 = "%$t2%"; push @where, "$not(items.title ilike ? or items.link ilike ? or items.content ilike ?)"; push @params, ($t2, $t2, $t2) } my $where = join(" and ", @where); my $cmd = "select $fields from $tables where $where order by issued desc"; print_log("$cmd"); my $items = $dbh->selectall_arrayref($cmd, { Slice => {} }, @params); print_itemlist($items, []); } print_log("search done"); } sub print_searchform { print "
\n"; print "\n"; print "\n"; print "
\n"; } sub print_itemlist { my ($items, $feeds, $show_form, $remix) = @_; # Optionally show form to select feeds, show later, etc. # This should probably be outside of this function if ($show_form) { print "
\n"; print "\n"; print "\n"; my $fls = $q->param('fls'); print "\n" if defined $fls; print "\n"; 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)"); my $q_later = CGI->new($q); # Optional remix. Does that have to be here or can we do it before # calling print_itemlist? if ($remix) { 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 .= "
\n"; $html .= "" . $item->{item_id} . "\n"; $html .= "" . strftime('%Y-%m-%d %H:%M:%S', localtime($item->{issued})) . "\n"; my $mark_read_button = ""; my $mark_later_button = ""; unless ($is_read) { $mark_read_button = "\n"; $mark_later_button = "\n"; } $html .= $mark_read_button; $html .= $mark_later_button; $html .= "
" . $q->escapeHTML($item->{feed_title}) . "
\n"; $html .= "

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

\n"; $html .= "
" . $scrubbed_content . "
\n"; #$html .= $mark_read_button; #$html .= $mark_later_button; $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 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 scrubbed_content_key { my ($item_id) = @_; return "rss2html/scrubbed_content/$item_id"; }