find_file_db.pl

   1 #!/usr/bin/perl -w
   2 #
   3 # find_file_db.pl
   4 #
   5 # Look through a provided database to find which CD/DVD image(s)
   6 # contain a specified Debian package or source file.
   7 #
   8 # Copyright (c) 2011 Steve McIntyre <93sam@debian.org>
   9 #
  10 # This program is free software; you can redistribute it and/or modify
  11 # it under the terms of the GNU General Public License as published by
  12 # the Free Software Foundation; either version 2 of the License, or
  13 # (at your option) any later version.
  14 #
  15 # This program is distributed in the hope that it will be useful,
  16 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 # GNU General Public License for more details.
  19 #
  20 # You should have received a copy of the GNU General Public License
  21 # along with this program; if not, write to the Free Software
  22 # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
  23
  24 use strict;
  25 use DB_File;
  26
  27 my $dbdir = "/home/steve/debian/debian-cd/search/search-db";
  28 my @AREAS;
  29 my %num_files;
  30 my %fileinfo;
  31 my %imageinfo;
  32 my @results;
  33 my $max_count = 1000;
  34
  35 # Borrowed from Ikiwiki.pm
  36 sub glob2re ($) {
  37     my $re=quotemeta(shift);
  38     $re=~s/\\\*/.*/g;
  39     $re=~s/\\\?/./g;
  40     return qr/^$re$/i;
  41 }
  42
  43 chdir($dbdir) || die "Failed to cd to $dbdir: $!\n";
  44 opendir(my $dh, ".") || die "Failed to open $dbdir: $!\n";
  45 while (defined($_ = readdir($dh))) {
  46     m/(.*)\.db$/ and push (@AREAS, $1);
  47 }
  48 closedir($dh);
  49
  50 my $query_term = shift;
  51
  52 if (!defined($query_term) || !length($query_term)) {
  53     die "No query term specified!\n";
  54 }
  55
  56 my $count = 0;
  57 my $re_search = glob2re($query_term);
  58
  59 foreach my $area (@AREAS) {
  60     print "Looking in area $area\n";
  61     my $db_file_name = "$dbdir/$area.db";
  62     dbmopen(%fileinfo, "$db_file_name", 0000) ||
  63         die "Failed to open db file: $!\n";
  64
  65     if ($query_term =~ /[\*\?]/) {
  66         # Will need to search through all the keys to allow for glob
  67         foreach my $file (keys %fileinfo) {
  68             if ($file =~ $re_search) {
  69                 $count++;
  70                 push(@results, "$file $fileinfo{$file}");
  71                 if ($count >= $max_count) {
  72                     last;
  73                 }
  74             }
  75         }
  76     } else {
  77         # We've been given an exact name - do the exact key lookup \o/
  78         push (@results, "$query_term $fileinfo{$query_term}");
  79     }
  80     if ($count >= $max_count) {
  81         last;
  82     }
  83     dbmclose %fileinfo;
  84 }
  85
  86 if ($count >= $max_count) {
  87     print "More than $max_count results for \"$query_term\", showing the first $count only\n";
  88 } else {
  89     print "$count results for \"$query_term\":\n";
  90 }
  91
  92 foreach my $result (sort (@results)) {
  93     my($found, @list) = split(' ', $result);
  94     print "  $found:\n";
  95     foreach my $image (sort(@list)) {
  96         print "    $image\n";
  97     }
  98 }