/[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

Diff of /tctsearch-pl.cgi

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1 by dpavlin, Tue Jul 21 12:32:05 2009 UTC revision 3 by dpavlin, Tue Jul 21 13:09:16 2009 UTC
# Line 5  use warnings; Line 5  use warnings;
5  use CGI;  use CGI;
6  use TokyoCabinet;  use TokyoCabinet;
7    
8  use constant {  my @dbs = sort map { my $t = $_; $t =~ s{\.tct$}{}; $t; } glob('*.tct'), glob('*/*.tct');
9      DBPATH => "/home/mikio/casket.tct",  
10  };  my $DBPATH = $ENV{PATH_INFO} || $dbs[0];
11    $DBPATH =~ s{^/+}{};
12    warn "$DBPATH";
13    
14  my $cgi = CGI->new();  my $cgi = CGI->new();
15  my $scriptname = $cgi->script_name();  my $scriptname = $cgi->script_name();
# Line 15  my $expr = $cgi->param("expr"); Line 17  my $expr = $cgi->param("expr");
17  my @docs;  my @docs;
18  if(defined($expr) && length($expr) > 0){  if(defined($expr) && length($expr) > 0){
19      my $tdb = TokyoCabinet::TDB->new();      my $tdb = TokyoCabinet::TDB->new();
20      $tdb->open(DBPATH);      $tdb->open($DBPATH . '.tct') || die "can't open $DBPATH: $!";
21      my $tqry = TokyoCabinet::TDBQRY->new($tdb);      my $tqry = TokyoCabinet::TDBQRY->new($tdb);
22      $tqry->addcond("title", $tqry->QCFTSEX, $expr);      $tqry->addcond("title", $tqry->QCFTSEX, $expr);
23      $tqry->setorder("title", $tqry->QOSTRASC);      $tqry->setorder("title", $tqry->QOSTRASC);
# Line 42  print($cgi->header(-charset => "UTF-8")) Line 44  print($cgi->header(-charset => "UTF-8"))
44  print << "__EOS";  print << "__EOS";
45  <html>  <html>
46  <head>  <head>
47  <title>Tiny Search by Perl</title>  <title>$DBPATH</title>
48  <style type="text/css">  <style type="text/css">
49  strong { text-decoration: underline; padding: 0px 2px; }  strong { text-decoration: underline; padding: 0px 2px; }
50  </style>  </style>
51  </head>  </head>
52  <body>  <body>
53  <h1>Tiny Search by Perl</h1>  <form method="get" action="$scriptname/$DBPATH">
 <form method="get" action="$scriptname">  
54  <div>  <div>
55  <input type="text" name="expr" value="$xexpr">  <input type="text" name="expr" value="$xexpr">
56  <input type="submit" value="search">  <input type="submit" value="search">
# Line 81  if(scalar(@docs) > 0){ Line 82  if(scalar(@docs) > 0){
82      printf("</dl>\n");      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";  print << "__EOS";
90  </body>  </body>
91  </html>  </html>
Legend:
Removed from v.1  
changed lines
  Added in v.3
  ViewVC Help
Powered by ViewVC 1.1.26