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     my $nres = 0;
  16
  17     my ($cgi) = @_;
  18
  19     print "Extremely blunt ends-with search results:<br><pre>";
  20 # only thing implemented yet: ends-with search
  21     my $kw = lc $cgi->param("keywords");
  22     # full filename search is tricky
  23     my $ffn = $cgi->param("fullfilename");
  24     $ffn = $ffn ? 1 : 0;
  25
  26
  27 my $suite = 'stable'; #fixme
  28
  29     # fixme: I should open $reverses only once per search
  30     my $reverses = tie my %reverses, 'DB_File', "$DBDIR/contents/reverse_$suite.db",
  31         O_RDONLY, 0666, $DB_BTREE
  32         or die "Failed opening reverse DB: $!";
  33
  34     if ($ffn) {
  35         open FILENAMES, "$DBDIR/contents/filenames_$suite.txt"
  36             or die "Failed opening filename table";
  37         while (<FILENAMES>) {
  38             next if index($_, $kw)<0;
  39             chomp;
  40             last unless &dosearch(reverse($_)."/", \$nres, $reverses);
  41         }
  42         close FILENAMES;
  43     } else {
  44
  45         $kw = reverse $kw;
  46
  47         # exact filename searching follows trivially:
  48         my $exact = $cgi->param("exact");
  49         $kw = "$kw/" if $exact;
  50
  51         print "ERROR: Exact and fullfilenamesearch don't go along" if $ffn and $exact;
  52
  53         &dosearch($kw, \$nres, $reverses);
  54     }
  55     print "</pre>$nres results displayed";
  56     $reverses = undef;
  57     untie %reverses;
  58
  59 }
  60
  61 sub dosearch
  62 {
  63     my ($kw, $nres, $reverses) = @_;
  64
  65     my ($key, $rest) = ($kw, "");
  66     for (my $status = $reverses->seq($key, $value, R_CURSOR);
  67         $status == 0;
  68         $status =  $reverses->seq( $key, $value, R_NEXT)) {
  69
  70         # FIXME: what's the most efficient "is prefix of" thingy? We only want to know
  71         # whether $kw is or is not a prefix of $key
  72         last unless index($key, $kw) == 0;
  73
  74         @hits = split /\0/o, $value;
  75         print reverse($key)." is found in @hits\n";
  76         last if ($$nres)++ > 100;
  77     }
  78
  79     return $$nres<100;
  80 }
  81
  82 1;
  83 # vim: ts=8 sw=4