/[tokyocabinet-toys]/tctsearch-pl.cgi
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /tctsearch-pl.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3 - (show annotations)
Tue Jul 21 13:09:16 2009 UTC (9 years, 5 months ago) by dpavlin
File size: 2551 byte(s)
search all *.tct */*.tct databases

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

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26