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