cgi-bin/search_contents.pl

   1 #!/usr/bin/perl -wT
   2 # $Id$
   3 # search_packages.pl -- CGI interface to the Packages files on packages.debian.org
   4 #
   5 # Copyright (C) 1998 James Treacy
   6 # Copyright (C) 2000, 2001 Josip Rodin
   7 # Copyright (C) 2001 Adam Heath
   8 # Copyright (C) 2004 Martin Schulze
   9 # Copyright (C) 2004-2006 Frank Lichtenheld
  10 #
  11 # use is allowed under the terms of the GNU Public License (GPL)
  12 # see http://www.fsf.org/copyleft/gpl.html for a copy of the license
  13
  14 sub contents() {
  15
  16     my ($cgi) = @_;
  17
  18     print "Extremely blunt ends-with search results:<br><pre>";
  19 # only thing implemented yet: ends-with search
  20     my $kw = lc $cgi->param("keywords");
  21     $kw = reverse $kw;
  22 # FIXME: ensure $suite is sanitized
  23     my $suite = 'stable';
  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     my ($key, $rest) = ($kw, "");
  30     my $nres = 0;
  31     for (my $status = $reverses->seq($key, $value, R_CURSOR);
  32         $status == 0;
  33         $status =  $reverses->seq( $key, $value, R_NEXT)) {
  34
  35         # FIXME: what's the most efficient "is prefix of" thingy? We only want to know
  36         # whether $kw is or is not a prefix of $key
  37         last unless index($key, $kw) == 0;
  38
  39         @hits = split /\0/o, $value;
  40         print reverse($key)." is found in @hits\n";
  41         last if $nres++ > 100;
  42     }
  43
  44     $reverses = undef;
  45     untie %reverses;
  46     print "</pre>$nres results displayed";
  47 }
  48
  49 1;
  50 # vim: ts=8 sw=4