5 # Look through a provided database to find which CD/DVD image(s)
6 # contain a specified Debian package or source file.
8 # Copyright (c) 2011 Steve McIntyre <93sam@debian.org>
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.
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.
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
28 my $dbdir = "/home/steve/debian/debian-cd/search/search-db";
29 my $htmldir = "/home/steve/debian/debian-cd/html";
30 my $cdimage_url = "http://cdimage.debian.org/cdimage/";
47 my $title_base = "Debian CD search engine";
51 my $authorname = "Steve McIntyre";
52 my $authormail = '93sam@debian.org';
57 open IN, "<", "$htmldir/header1.$lang.html";
58 while(<IN>) { $header1 .= $_; }
60 open IN, "<", "$htmldir/header2.$lang.html";
61 while(<IN>) { $header2 .= $_; }
63 open IN, "<", "$htmldir/footer1.$lang.html";
64 while(<IN>) { $footer1 .= $_; }
66 open IN, "<", "$htmldir/footer2.$lang.html";
67 while(<IN>) { $footer2 .= $_; }
75 sub print_html_header ($) {
79 -author=>"$authormail",
80 -style=>{'src'=>'http://www.debian.org/debian.css'},
83 print '<p id="breadcrumbs">cdimage-search.debian.org</p>';
85 print '<div id="maincol">';
91 $q->address("$title_base version $version\n"),
92 $q->address("$authorname <$authormail>\n"),
95 print '</div> <!-- end footer -->';
98 # Borrowed from Ikiwiki.pm
100 my $re=quotemeta(shift);
107 my $filename = shift;
108 my $text = "no description";
110 open INFILE, "<", "$filename" || return $text;
122 my $errornum = shift;
123 my $errortext = shift;
126 print_html_header("$title_base");
129 $q->p("Error: $errortext"),
130 $q->p("<a href=\"" . $q->url . "\">Search again.</a>");
140 print_html_header("$title_base");
141 $q->autoEscape(undef);
142 print $q->h1("$title_base"), "\n";
143 print $q->p("This tool searches for files contained in Debian CD/DVD images, such as:"), "\n";
146 $q->li("package files (.deb, .udeb)"), "\n",
147 $q->li("source files (.tar.gz, .tar.bz2, .diff.gz, etc.)"), "\n",
149 print $q->p("Select which set(s) of images you wish to look in:"), "\n";
150 print $q->start_form(-method=>"GET");
151 print $q->checkbox_group(-name=>'search_area',
153 -defaults=>['release'],
156 print $q->textfield(-name=>'query',
160 print $q->submit(-name=>'Search',
162 if (length($error)) {
163 print $q->p({-style=>'color: red'}, "ERROR: $error"), "\n";
165 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>. Exact lookups with no globbing will give much faster results!");
173 my $link = $cdimage_url . shift;
178 my $link = $cdimage_url . shift;
179 $link =~ s/list-/iso-/g;
180 $link =~ s/list\.gz$/iso/g;
185 my $link = $cdimage_url . shift;
186 $link =~ s/list-/jigdo-/g;
187 $link =~ s/list\.gz$/jigdo/g;
191 sub pretty_name ($) {
194 $name =~ s/\.list\.gz$//g;
199 chdir($dbdir) || log_error(500, "Failed to cd to $dbdir: $!\n");
200 opendir(my $dh, ".") || log_error(500, "Failed to open $dbdir: $!\n");
201 while (defined($_ = readdir($dh))) {
202 m/(.*)\.db$/ and push(@AREAS, "$1");
206 foreach my $area(@AREAS) {
207 $labels{$area} = "$area (" . read_text("$area.text") . ")";
210 @chosen_areas = $q->param('search_area');
211 $query_term = $q->param('query');
213 # Check what we've been given, if anything
214 if ( (!@chosen_areas) &&
215 (!defined($query_term) || length($query_term) == 0)) {
219 if (!(@chosen_areas) && defined($query_term)) {
220 blank_form("No search areas chosen");
224 (!defined($query_term) || length($query_term) == 0)) {
225 blank_form("No search terms entered");
229 my $re_search = glob2re($query_term);
231 # If we get here, we have stuff to work with. Yay!
232 foreach my $area (@chosen_areas) {
233 my $db_file_name = "$dbdir/$area.db";
234 $l .= "Looking in area $area, file $db_file_name<br>\n";
235 dbmopen(%fileinfo, "$db_file_name", 0000) ||
236 log_error(500, "Failed to open db file: $!\n");
238 if ($query_term =~ /[\*\?]/) {
239 # Will need to search through all the keys to allow for glob
240 foreach my $file (keys %fileinfo) {
241 if ($file =~ $re_search) {
243 push(@results, "$file $fileinfo{$file}");
244 if ($count >= $max_count) {
250 # We've been given an exact name - do the exact key lookup \o/
251 if (defined($fileinfo{$query_term})) {
252 push (@results, "$query_term $fileinfo{$query_term}");
256 if ($count >= $max_count) {
263 print_html_header("$title_base: $count results");
265 $q->start_html("$title_base: $count results"),
266 $q->h1($title_base), "\n";
267 if ($count >= $max_count) {
268 print $q->p("More than $max_count results for \"$query_term\", showing the first $count only\n");
270 print $q->p("$count result(s) for \"$query_term\"\n");
274 foreach my $result (sort (@results)) {
275 my($found, @list) = split(' ', $result);
276 print "<li> $found appears in:\n";
278 foreach my $image (sort(@list)) {
279 print "<li>" . pretty_name($image);
280 print " (<a href=\"" . list_link($image) . "\">list.gz</a> |";
281 print " <a href=\"" . jigdo_link($image) . "\">jigdo</a> |";
282 print " <a href=\"" . iso_link($image) . "\">iso</a>)\n";
288 print $q->p("<a href=\"" . $q->url . "\">Search again.</a>");