1 |
dpavlin |
1 |
#! /usr/bin/perl |
2 |
|
|
|
3 |
|
|
use strict; |
4 |
|
|
use warnings; |
5 |
|
|
use CGI; |
6 |
|
|
use TokyoCabinet; |
7 |
|
|
|
8 |
|
|
use constant { |
9 |
|
|
DBPATH => "/home/mikio/casket.tct", |
10 |
|
|
}; |
11 |
|
|
|
12 |
|
|
my $cgi = CGI->new(); |
13 |
|
|
my $scriptname = $cgi->script_name(); |
14 |
|
|
my $expr = $cgi->param("expr"); |
15 |
|
|
my @docs; |
16 |
|
|
if(defined($expr) && length($expr) > 0){ |
17 |
|
|
my $tdb = TokyoCabinet::TDB->new(); |
18 |
|
|
$tdb->open(DBPATH); |
19 |
|
|
my $tqry = TokyoCabinet::TDBQRY->new($tdb); |
20 |
|
|
$tqry->addcond("title", $tqry->QCFTSEX, $expr); |
21 |
|
|
$tqry->setorder("title", $tqry->QOSTRASC); |
22 |
|
|
$tqry->setlimit(30, 0); |
23 |
|
|
my $bqry = TokyoCabinet::TDBQRY->new($tdb); |
24 |
|
|
$bqry->addcond("body", $bqry->QCFTSEX, $expr); |
25 |
|
|
$bqry->setorder("title", $bqry->QOSTRASC); |
26 |
|
|
$bqry->setlimit(30, 0); |
27 |
|
|
my $res = $tqry->metasearch([ $bqry ], $tqry->MSUNION); |
28 |
|
|
foreach my $pkey (@$res){ |
29 |
|
|
last if(@docs >= 30); |
30 |
|
|
my $cols = $tdb->get($pkey); |
31 |
|
|
if(defined($cols)){ |
32 |
|
|
my $kwic = $bqry->kwic($cols, undef, 20, $bqry->KWMUCTRL); |
33 |
|
|
$cols->{kwic} = $kwic; |
34 |
|
|
push(@docs, $cols); |
35 |
|
|
} |
36 |
|
|
} |
37 |
|
|
$tdb->close(); |
38 |
|
|
} |
39 |
|
|
|
40 |
|
|
my $xexpr = defined($expr) ? $cgi->escapeHTML($expr) : ""; |
41 |
|
|
print($cgi->header(-charset => "UTF-8")); |
42 |
|
|
print << "__EOS"; |
43 |
|
|
<html> |
44 |
|
|
<head> |
45 |
|
|
<title>Tiny Search by Perl</title> |
46 |
|
|
<style type="text/css"> |
47 |
|
|
strong { text-decoration: underline; padding: 0px 2px; } |
48 |
|
|
</style> |
49 |
|
|
</head> |
50 |
|
|
<body> |
51 |
|
|
<h1>Tiny Search by Perl</h1> |
52 |
|
|
<form method="get" action="$scriptname"> |
53 |
|
|
<div> |
54 |
|
|
<input type="text" name="expr" value="$xexpr"> |
55 |
|
|
<input type="submit" value="search"> |
56 |
|
|
</div> |
57 |
|
|
</form> |
58 |
|
|
__EOS |
59 |
|
|
|
60 |
|
|
if(scalar(@docs) > 0){ |
61 |
|
|
printf("<dl>\n"); |
62 |
|
|
foreach my $cols (@docs){ |
63 |
|
|
my $url = $cols->{url}; |
64 |
|
|
$url = "." if(!defined($url)); |
65 |
|
|
my $title = $cols->{title}; |
66 |
|
|
$title = "(untitled)" if(!defined($title)); |
67 |
|
|
printf("<dt><a href=\"%s\">%s</a></dt>\n", |
68 |
|
|
$cgi->escapeHTML($url), $cgi->escapeHTML($title)); |
69 |
|
|
my $kwic = $cols->{kwic}; |
70 |
|
|
if(defined($kwic)){ |
71 |
|
|
my $cnt = 0; |
72 |
|
|
foreach my $text (@$kwic){ |
73 |
|
|
last if($cnt++ >= 3); |
74 |
|
|
$text = $cgi->escapeHTML($text); |
75 |
|
|
$text =~ s/\x02/<strong>/g; |
76 |
|
|
$text =~ s/\x03/<\/strong>/g; |
77 |
|
|
printf("<dd>%s</dd>\n", $text); |
78 |
|
|
} |
79 |
|
|
} |
80 |
|
|
} |
81 |
|
|
printf("</dl>\n"); |
82 |
|
|
} |
83 |
|
|
|
84 |
|
|
print << "__EOS"; |
85 |
|
|
</body> |
86 |
|
|
</html> |
87 |
|
|
__EOS |