| 1 |
dpavlin |
1 |
#! /usr/bin/perl |
| 2 |
|
|
|
| 3 |
|
|
use strict; |
| 4 |
|
|
use warnings; |
| 5 |
|
|
use CGI; |
| 6 |
|
|
use TokyoCabinet; |
| 7 |
|
|
|
| 8 |
dpavlin |
3 |
my @dbs = sort map { my $t = $_; $t =~ s{\.tct$}{}; $t; } glob('*.tct'), glob('*/*.tct'); |
| 9 |
dpavlin |
1 |
|
| 10 |
dpavlin |
3 |
my $DBPATH = $ENV{PATH_INFO} || $dbs[0]; |
| 11 |
|
|
$DBPATH =~ s{^/+}{}; |
| 12 |
|
|
warn "$DBPATH"; |
| 13 |
|
|
|
| 14 |
dpavlin |
1 |
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 |
dpavlin |
3 |
$tdb->open($DBPATH . '.tct') || die "can't open $DBPATH: $!"; |
| 21 |
dpavlin |
1 |
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 |
dpavlin |
3 |
<title>$DBPATH</title> |
| 48 |
dpavlin |
1 |
<style type="text/css"> |
| 49 |
|
|
strong { text-decoration: underline; padding: 0px 2px; } |
| 50 |
|
|
</style> |
| 51 |
|
|
</head> |
| 52 |
|
|
<body> |
| 53 |
dpavlin |
3 |
<form method="get" action="$scriptname/$DBPATH"> |
| 54 |
dpavlin |
1 |
<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 |
dpavlin |
3 |
print "Databases: ", join( " ", map { |
| 86 |
|
|
$_ eq $DBPATH ? qq|<b>$_</b>| : qq|<a href="$scriptname/$_?expr=$xexpr">$_</a>| |
| 87 |
|
|
} @dbs ); |
| 88 |
|
|
|
| 89 |
dpavlin |
1 |
print << "__EOS"; |
| 90 |
|
|
</body> |
| 91 |
|
|
</html> |
| 92 |
|
|
__EOS |
Parent Directory
| 
Revision Log