Simple tools to query the CD contents database

Two tools:

 * find_file_db.pl is a command-line interface
 * find_file.cgi is a simple web interface.

diff --git a/find_file.cgi b/find_file.cgi
new file mode 100755 (executable)
index 0000000..8824704
--- /dev/null
+++ b/find_file.cgi
@@ -0,0 +1,204 @@
+#!/usr/bin/perl -w
+
+use strict;
+use DB_File;
+use CGI;
+
+my $dbdir = "/home/steve/debian/debian-cd/search/search-db";
+my $cdimage_url = "http://cdimage.debian.org/cdimage/";
+my @AREAS;
+my %num_files;
+my %fileinfo;
+my %imageinfo;
+my %labels;
+my $query_term;
+my @results;
+my @chosen_areas;
+my $l = "";
+my $max_count = 1000;
+
+my $version = "0.2";
+my $title_base = "Debian CD search engine";
+
+my $q = new CGI;
+my $mode = "none";
+
+sub print_footer () {
+    print
+        $q->hr,
+        $q->address("$title_base version $version"),
+        $q->address("Steve McIntyre <93sam\@debian.org>");
+}
+
+# Borrowed from Ikiwiki.pm
+sub glob2re ($) {
+    my $re=quotemeta(shift);
+    $re=~s/\\\*/.*/g;
+    $re=~s/\\\?/./g;
+    return qr/^$re$/i;
+}
+
+sub read_text ($) {
+    my $filename = shift;
+    my $text = "no description";
+    if (-f $filename) {
+        open INFILE, "<", "$filename" || return $text;
+        $text = "";
+        while (<INFILE>) {
+            chomp;
+            $text .= $_;
+        }
+        close INFILE;
+    }
+    return $text;
+}
+
+sub log_error ($$) {
+    my $errornum = shift;
+    my $errortext = shift;
+
+    print $q->header,
+    $q->start_html($title_base),
+    $q->h1($title_base),
+    $q->p("Error: $errortext"),
+    $q->p("<a href=\"" . $q->url . "\">Search again.</a>");
+    print_footer();
+    print $q->end_html;
+    exit 0;
+}
+
+sub blank_form ($) {
+    my $error = shift;
+    print
+        $q->header,
+        $q->start_html($title_base),
+        $q->h1("$title_base"), "\n";
+    print $q->p("This tool searches for specified file names contained in Debian CD/DVD images."), "\n";
+    print $q->p("Select which set(s) of images you wish to search:"), "\n";
+    print $q->start_form(-method=>"GET");
+    print $q->checkbox_group(-name=>'search_area',
+                             -values=>\@AREAS,
+                             -defaults=>['release'],
+                             -linebreak=>'true',
+                             -labels=>\%labels);
+    print $q->textfield(-name=>'query',
+                        -value=>'',
+                        -size=>50,
+                        -maxlength=>100);
+    print $q->submit(-name=>'Search',
+                     value=>'Search');
+    if (length($error)) {
+        print $q->p({-style=>'color: red'}, "ERROR: $error"), "\n";
+    }
+    print $q->p("Search terms should be in the form of shell globs (i.e. \"<i>cvs*deb</i>\" will match all files that start with <i>cvs</i> and end with <i>deb</i>.");
+    print $q->end_form;
+    print_footer();
+    print $q->end_html;
+    exit 0;
+}
+
+sub list_link ($) {
+    my $link = $cdimage_url . shift;
+    return $link;
+}
+
+sub iso_link ($) {
+    my $link = $cdimage_url . shift;
+    $link =~ s/list-/iso-/g;
+    $link =~ s/list\.gz$/iso/g;
+    return $link;
+}
+
+sub jigdo_link ($) {
+    my $link = $cdimage_url . shift;
+    $link =~ s/list-/jigdo-/g;
+    $link =~ s/list\.gz$/jigdo/g;
+    return $link;
+}
+
+sub pretty_name ($) {
+    my $name = shift;
+    $name =~ s/^.*\///g;
+    $name =~ s/\.list\.gz$//g;
+    return $name;
+}    
+
+chdir($dbdir) || log_error(500, "Failed to cd to $dbdir: $!\n");
+opendir(my $dh, ".") || log_error(500, "Failed to open $dbdir: $!\n");
+while (defined($_ = readdir($dh))) {
+    m/(.*)\.db$/ and push(@AREAS, "$1");
+}
+closedir($dh);
+
+foreach my $area(@AREAS) {
+    $labels{$area} = "$area (" . read_text("$area.text") . ")";
+}
+
+@chosen_areas = $q->param('search_area');
+$query_term = $q->param('query');
+
+# Check what we've been given, if anything
+if ( (!@chosen_areas) && 
+     (!defined($query_term) || length($query_term) == 0)) {
+    blank_form("");
+}
+
+if (!(@chosen_areas) && defined($query_term)) {
+    blank_form("No search areas chosen");
+}
+
+if (@chosen_areas && 
+    (!defined($query_term) || length($query_term) == 0)) {
+    blank_form("No search terms entered");
+}
+
+my $count = 0;
+my $re_search = glob2re($query_term);
+
+# If we get here, we have stuff to work with. Yay!
+foreach my $area (@chosen_areas) {
+    my $db_file_name = "$dbdir/$area.db";
+    $l .= "Looking in area $area, file $db_file_name<br>\n";
+    dbmopen(%fileinfo, "$db_file_name", 0000) ||
+        log_error(500, "Failed to open db file: $!\n");
+    foreach my $file (keys %fileinfo) {
+        if ($file =~ $re_search) {
+            $count++;
+            push(@results, "$file $fileinfo{$file}");
+            if ($count >= $max_count) {
+                last;
+            }
+        }
+    }
+    if ($count >= $max_count) {
+        last;
+    }
+    dbmclose %fileinfo;
+}
+
+print $q->header,
+    $q->start_html("$title_base: $count results"),
+    $q->h1($title_base), "\n";
+if ($count >= $max_count) {
+    print $q->p("More than $max_count results for \"$query_term\", showing the first $count only\n");
+} else {   
+    print $q->p("$count results for \"$query_term\"\n");
+}
+if ($count > 0) {
+    print "<ol>\n";
+    foreach my $result (sort (@results)) {
+        my($found, @list) = split(' ', $result);
+        print "<li> $found appears in:\n";
+        print "<ul>";
+        foreach my $image (sort(@list)) {
+            print "<li>" . pretty_name($image);
+            print " (<a href=\"" . list_link($image) . "\">list.gz</a> |";
+            print " <a href=\"" . jigdo_link($image) . "\">jigdo</a> |";
+            print " <a href=\"" . iso_link($image) . "\">iso</a>)";
+        }
+        print "</ul>";
+    }
+    print "</ol>";
+}
+print_footer();
+print $q->end_html;

diff --git a/find_file_db.pl b/find_file_db.pl
new file mode 100755 (executable)
index 0000000..8e199cc
--- /dev/null
+++ b/find_file_db.pl
@@ -0,0 +1,57 @@
+#!/usr/bin/perl -w
+
+use strict;
+use DB_File;
+
+my $dbdir = "/home/steve/debian/debian-cd/search/search-db";
+my @AREAS;
+my %num_files;
+my %fileinfo;
+my %imageinfo;
+my @results;
+
+# Borrowed from Ikiwiki.pm
+sub glob2re ($) {
+    my $re=quotemeta(shift);
+    $re=~s/\\\*/.*/g;
+    $re=~s/\\\?/./g;
+    return qr/^$re$/i;
+}
+
+chdir($dbdir) || die "Failed to cd to $dbdir: $!\n";
+opendir(my $dh, ".") || die "Failed to open $dbdir: $!\n";
+while (defined($_ = readdir($dh))) {
+    m/(.*)\.db$/ and push (@AREAS, $1);
+}
+closedir($dh);
+
+my $query_term = shift;
+
+if (!defined($query_term) || !length($query_term)) {
+    die "No query term specified!\n";
+}
+
+my $re_search = glob2re($query_term);
+
+foreach my $area (@AREAS) {
+    print "Looking in area $area\n";
+    my $db_file_name = "$dbdir/$area.db";
+    dbmopen(%fileinfo, "$db_file_name", 0000) || 
+        die "Failed to open db file: $!\n";
+    foreach my $file (keys %fileinfo) {
+        if ($file =~ $re_search) {
+            push(@results, "$file $fileinfo{$file}");
+        }
+    }
+    dbmclose %fileinfo;
+}
+
+my $count = scalar(@results);
+print "$count results for \"$query_term\":\n";
+foreach my $result (sort (@results)) {
+    my($found, @list) = split(' ', $result);
+    print "  $found:\n";
+    foreach my $image (sort(@list)) {
+       print "    $image\n";
+    }
+}