cgi-bin/search_contents.pl

   1 #!/usr/bin/perl -wT
   2 # $Id$
   3 # search_contents.pl -- CGI interface to the Contents files on packages.debian.org
   4 #
   5 # Copyright (C) 2006 Jeroen van Wolffelaar
   6 #
   7 # use is allowed under the terms of the GNU Public License (GPL)
   8 # see http://www.fsf.org/copyleft/gpl.html for a copy of the license
   9
  10 sub contents() {
  11     my $nres = 0;
  12
  13     my ($cgi) = @_;
  14
  15     print "Extremely blunt ends-with search results:<br><pre>";
  16 # only thing implemented yet: ends-with search
  17     my $kw = lc $cgi->param("keywords");
  18     # full filename search is tricky
  19     my $ffn = $cgi->param("fullfilename");
  20     $ffn = $ffn ? 1 : 0;
  21
  22
  23 my $suite = 'stable'; #fixme
  24
  25     my $reverses = tie my %reverses, 'DB_File', "$DBDIR/contents/reverse_$suite.db",
  26         O_RDONLY, 0666, $DB_BTREE
  27         or die "Failed opening reverse DB: $!";
  28
  29     if ($ffn) {
  30         open FILENAMES, "$DBDIR/contents/filenames_$suite.txt"
  31             or die "Failed opening filename table";
  32         while (<FILENAMES>) {
  33             next if index($_, $kw)<0;
  34             chomp;
  35             last unless &dosearch(reverse($_)."/", \$nres, $reverses);
  36         }
  37         close FILENAMES;
  38     } else {
  39
  40         $kw = reverse $kw;
  41
  42         # exact filename searching follows trivially:
  43         my $exact = $cgi->param("exact");
  44         $kw = "$kw/" if $exact;
  45
  46         print "ERROR: Exact and fullfilenamesearch don't go along" if $ffn and $exact;
  47
  48         &dosearch($kw, \$nres, $reverses);
  49     }
  50     print "</pre>$nres results displayed";
  51     $reverses = undef;
  52     untie %reverses;
  53
  54 }
  55
  56 sub dosearch
  57 {
  58     my ($kw, $nres, $reverses) = @_;
  59
  60     my ($key, $rest) = ($kw, "");
  61     for (my $status = $reverses->seq($key, $value, R_CURSOR);
  62         $status == 0;
  63         $status =  $reverses->seq( $key, $value, R_NEXT)) {
  64
  65         # FIXME: what's the most efficient "is prefix of" thingy? We only want to know
  66         # whether $kw is or is not a prefix of $key
  67         last unless index($key, $kw) == 0;
  68
  69         @hits = split /\0/o, $value;
  70         print reverse($key)." is found in @hits\n";
  71         last if ($$nres)++ > 100;
  72     }
  73
  74     return $$nres<100;
  75 }
  76
  77 1;
  78 # vim: ts=8 sw=4