#! /usr/bin/perl
use strict;
use warnings;
use CGI;
use TokyoCabinet;
use constant {
DBPATH => "/home/mikio/casket.tct",
};
my $cgi = CGI->new();
my $scriptname = $cgi->script_name();
my $expr = $cgi->param("expr");
my @docs;
if(defined($expr) && length($expr) > 0){
my $tdb = TokyoCabinet::TDB->new();
$tdb->open(DBPATH);
my $tqry = TokyoCabinet::TDBQRY->new($tdb);
$tqry->addcond("title", $tqry->QCFTSEX, $expr);
$tqry->setorder("title", $tqry->QOSTRASC);
$tqry->setlimit(30, 0);
my $bqry = TokyoCabinet::TDBQRY->new($tdb);
$bqry->addcond("body", $bqry->QCFTSEX, $expr);
$bqry->setorder("title", $bqry->QOSTRASC);
$bqry->setlimit(30, 0);
my $res = $tqry->metasearch([ $bqry ], $tqry->MSUNION);
foreach my $pkey (@$res){
last if(@docs >= 30);
my $cols = $tdb->get($pkey);
if(defined($cols)){
my $kwic = $bqry->kwic($cols, undef, 20, $bqry->KWMUCTRL);
$cols->{kwic} = $kwic;
push(@docs, $cols);
}
}
$tdb->close();
}
my $xexpr = defined($expr) ? $cgi->escapeHTML($expr) : "";
print($cgi->header(-charset => "UTF-8"));
print << "__EOS";
Tiny Search by Perl
Tiny Search by Perl
__EOS
if(scalar(@docs) > 0){
printf("\n");
foreach my $cols (@docs){
my $url = $cols->{url};
$url = "." if(!defined($url));
my $title = $cols->{title};
$title = "(untitled)" if(!defined($title));
printf("- %s
\n",
$cgi->escapeHTML($url), $cgi->escapeHTML($title));
my $kwic = $cols->{kwic};
if(defined($kwic)){
my $cnt = 0;
foreach my $text (@$kwic){
last if($cnt++ >= 3);
$text = $cgi->escapeHTML($text);
$text =~ s/\x02//g;
$text =~ s/\x03/<\/strong>/g;
printf("- %s
\n", $text);
}
}
}
printf("
\n");
}
print << "__EOS";
__EOS