#!/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 "
\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";
}
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";
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 .= "