reindent, lose tabs
[debian-cd-search.git] / find_file.cgi
1 #!/usr/bin/perl -w
2 #
3 # find_file.cgi
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 use CGI;
27
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/";
31 my @AREAS;
32 my %num_files;
33 my %fileinfo;
34 my %imageinfo;
35 my %labels;
36 my $query_term;
37 my @results;
38 my @chosen_areas;
39 my $l = "";
40 my $max_count = 1000;
41 my $header1 = "";
42 my $header2 = "";
43 my $footer1 = "";
44 my $footer2 = "";
45
46 my $version = "0.3";
47 my $title_base = "Debian CD search engine";
48
49 my $q = new CGI;
50 my $mode = "none";
51 my $authorname = "Steve McIntyre";
52 my $authormail = '93sam@debian.org';
53
54 sub read_files ($) {
55     my $lang = shift;
56     
57     open IN, "<", "$htmldir/header1.$lang.html";
58     while(<IN>) { $header1 .= $_; }
59     close(IN);
60     open IN, "<", "$htmldir/header2.$lang.html";
61     while(<IN>) { $header2 .= $_; }
62     close(IN);
63     open IN, "<", "$htmldir/footer1.$lang.html";
64     while(<IN>) { $footer1 .= $_; }
65     close(IN);
66     open IN, "<", "$htmldir/footer2.$lang.html";
67     while(<IN>) { $footer2 .= $_; }
68     close(IN);
69 }
70
71 sub print_header () {
72     print $q->header;
73 }
74
75 sub print_html_header ($) {
76     my $title = shift;
77     print $q->start_html(
78         -title=>"$title",
79         -author=>"$authormail",
80         -style=>{'src'=>'http://www.debian.org/debian.css'},
81         );
82     print $header1;
83     print '<p id="breadcrumbs">cdimage-search.debian.org</p>';
84     print $header2;
85     print '<div id="maincol">';
86 }
87
88 sub print_footer () {
89     print $footer1;
90     print
91         $q->address("$title_base version $version\n"),
92         $q->address("$authorname &lt;$authormail&gt;\n"),
93         $q->hr;
94     print $footer2;
95     print '</div> <!-- end footer -->';
96 }
97
98 # Borrowed from Ikiwiki.pm
99 sub glob2re ($) {
100     my $re=quotemeta(shift);
101     $re=~s/\\\*/.*/g;
102     $re=~s/\\\?/./g;
103     return qr/^$re$/i;
104 }
105
106 sub read_text ($) {
107     my $filename = shift;
108     my $text = "no description";
109     if (-f $filename) {
110         open INFILE, "<", "$filename" || return $text;
111         $text = "";
112         while (<INFILE>) {
113             chomp;
114             $text .= $_;
115         }
116         close INFILE;
117     }
118     return $text;
119 }
120
121 sub log_error ($$) {
122     my $errornum = shift;
123     my $errortext = shift;
124
125     print_header();
126     print_html_header("$title_base");
127     print
128         $q->h1($title_base),
129         $q->p("Error: $errortext"),
130         $q->p("<a href=\"" . $q->url . "\">Search again.</a>");
131     print_footer();
132     print $q->end_html;
133     exit 0;
134 }
135
136 sub blank_form ($) {
137     my $error = shift;
138
139     print_header();
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";
144     print
145         "<ul>\n",
146         $q->li("package files (.deb, .udeb)"), "\n",
147         $q->li("source files (.tar.gz, .tar.bz2, .diff.gz, etc.)"), "\n",
148         "</ul>\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',
152                              -values=>\@AREAS,
153                              -defaults=>['release'],
154                              -linebreak=>'true',
155                              -labels=>\%labels);
156     print $q->textfield(-name=>'query',
157                         -value=>'',
158                         -size=>50,
159                         -maxlength=>100);
160     print $q->submit(-name=>'Search',
161                      value=>'Search');
162     if (length($error)) {
163         print $q->p({-style=>'color: red'}, "ERROR: $error"), "\n";
164     }
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!");
166     print $q->end_form;
167     print_footer();
168     print $q->end_html;
169     exit 0;
170 }
171
172 sub list_link ($) {
173     my $link = $cdimage_url . shift;
174     return $link;
175 }
176
177 sub iso_link ($) {
178     my $link = $cdimage_url . shift;
179     $link =~ s/list-/iso-/g;
180     $link =~ s/list\.gz$/iso/g;
181     return $link;
182 }
183
184 sub jigdo_link ($) {
185     my $link = $cdimage_url . shift;
186     $link =~ s/list-/jigdo-/g;
187     $link =~ s/list\.gz$/jigdo/g;
188     return $link;
189 }
190
191 sub pretty_name ($) {
192     my $name = shift;
193     $name =~ s/^.*\///g;
194     $name =~ s/\.list\.gz$//g;
195     return $name;
196 }    
197
198 read_files("en");
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");
203 }
204 closedir($dh);
205
206 foreach my $area(@AREAS) {
207     $labels{$area} = "$area (" . read_text("$area.text") . ")";
208 }
209
210 @chosen_areas = $q->param('search_area');
211 $query_term = $q->param('query');
212
213 # Check what we've been given, if anything
214 if ( (!@chosen_areas) && 
215      (!defined($query_term) || length($query_term) == 0)) {
216     blank_form("");
217 }
218
219 if (!(@chosen_areas) && defined($query_term)) {
220     blank_form("No search areas chosen");
221 }
222
223 if (@chosen_areas && 
224     (!defined($query_term) || length($query_term) == 0)) {
225     blank_form("No search terms entered");
226 }
227
228 my $count = 0;
229 my $re_search = glob2re($query_term);
230
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");
237
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) {
242                 $count++;
243                 push(@results, "$file $fileinfo{$file}");
244                 if ($count >= $max_count) {
245                     last;
246                 }
247             }
248         }
249     } else {
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}");
253             $count++;
254         }
255     }
256     if ($count >= $max_count) {
257         last;
258     }
259     dbmclose %fileinfo;
260 }
261
262 print_header();
263 print_html_header("$title_base: $count results");
264 print
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");
269 } else {   
270     print $q->p("$count result(s) for \"$query_term\"\n");
271 }
272 if ($count > 0) {
273     print "<ol>\n";
274     foreach my $result (sort (@results)) {
275         my($found, @list) = split(' ', $result);
276         print "<li> $found appears in:\n";
277         print "<ul>\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";
283         }
284         print "</ul>\n";
285     }
286     print "</ol>\n";
287 }
288 print $q->p("<a href=\"" . $q->url . "\">Search again.</a>");
289 print_footer();
290 print $q->end_html;