241a563fe8bd9d2de15c8613af439f3fb549d136
[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 $cdimage_url = "http://cdimage.debian.org/cdimage/";
30 my @AREAS;
31 my %num_files;
32 my %fileinfo;
33 my %imageinfo;
34 my %labels;
35 my $query_term;
36 my @results;
37 my @chosen_areas;
38 my $l = "";
39 my $max_count = 1000;
40
41 my $version = "0.2";
42 my $title_base = "Debian CD search engine";
43
44 my $q = new CGI;
45 my $mode = "none";
46
47 sub print_footer () {
48     print
49         $q->hr,
50         $q->address("$title_base version $version"),
51         $q->address("Steve McIntyre <93sam\@debian.org>");
52 }
53
54 # Borrowed from Ikiwiki.pm
55 sub glob2re ($) {
56     my $re=quotemeta(shift);
57     $re=~s/\\\*/.*/g;
58     $re=~s/\\\?/./g;
59     return qr/^$re$/i;
60 }
61
62 sub read_text ($) {
63     my $filename = shift;
64     my $text = "no description";
65     if (-f $filename) {
66         open INFILE, "<", "$filename" || return $text;
67         $text = "";
68         while (<INFILE>) {
69             chomp;
70             $text .= $_;
71         }
72         close INFILE;
73     }
74     return $text;
75 }
76
77 sub log_error ($$) {
78     my $errornum = shift;
79     my $errortext = shift;
80
81     print $q->header,
82     $q->start_html($title_base),
83     $q->h1($title_base),
84     $q->p("Error: $errortext"),
85     $q->p("<a href=\"" . $q->url . "\">Search again.</a>");
86     print_footer();
87     print $q->end_html;
88     exit 0;
89 }
90
91 sub blank_form ($) {
92     my $error = shift;
93     print
94         $q->header,
95         $q->start_html($title_base),
96         $q->h1("$title_base"), "\n";
97     print $q->p("This tool searches for specified file names contained in Debian CD/DVD images."), "\n";
98     print $q->p("Select which set(s) of images you wish to search:"), "\n";
99     print $q->start_form(-method=>"GET");
100     print $q->checkbox_group(-name=>'search_area',
101                              -values=>\@AREAS,
102                              -defaults=>['release'],
103                              -linebreak=>'true',
104                              -labels=>\%labels);
105     print $q->textfield(-name=>'query',
106                         -value=>'',
107                         -size=>50,
108                         -maxlength=>100);
109     print $q->submit(-name=>'Search',
110                      value=>'Search');
111     if (length($error)) {
112         print $q->p({-style=>'color: red'}, "ERROR: $error"), "\n";
113     }
114     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>.");
115     print $q->end_form;
116     print_footer();
117     print $q->end_html;
118     exit 0;
119 }
120
121 sub list_link ($) {
122     my $link = $cdimage_url . shift;
123     return $link;
124 }
125
126 sub iso_link ($) {
127     my $link = $cdimage_url . shift;
128     $link =~ s/list-/iso-/g;
129     $link =~ s/list\.gz$/iso/g;
130     return $link;
131 }
132
133 sub jigdo_link ($) {
134     my $link = $cdimage_url . shift;
135     $link =~ s/list-/jigdo-/g;
136     $link =~ s/list\.gz$/jigdo/g;
137     return $link;
138 }
139
140 sub pretty_name ($) {
141     my $name = shift;
142     $name =~ s/^.*\///g;
143     $name =~ s/\.list\.gz$//g;
144     return $name;
145 }    
146
147 chdir($dbdir) || log_error(500, "Failed to cd to $dbdir: $!\n");
148 opendir(my $dh, ".") || log_error(500, "Failed to open $dbdir: $!\n");
149 while (defined($_ = readdir($dh))) {
150     m/(.*)\.db$/ and push(@AREAS, "$1");
151 }
152 closedir($dh);
153
154 foreach my $area(@AREAS) {
155     $labels{$area} = "$area (" . read_text("$area.text") . ")";
156 }
157
158 @chosen_areas = $q->param('search_area');
159 $query_term = $q->param('query');
160
161 # Check what we've been given, if anything
162 if ( (!@chosen_areas) && 
163      (!defined($query_term) || length($query_term) == 0)) {
164     blank_form("");
165 }
166
167 if (!(@chosen_areas) && defined($query_term)) {
168     blank_form("No search areas chosen");
169 }
170
171 if (@chosen_areas && 
172     (!defined($query_term) || length($query_term) == 0)) {
173     blank_form("No search terms entered");
174 }
175
176 my $count = 0;
177 my $re_search = glob2re($query_term);
178
179 # If we get here, we have stuff to work with. Yay!
180 foreach my $area (@chosen_areas) {
181     my $db_file_name = "$dbdir/$area.db";
182     $l .= "Looking in area $area, file $db_file_name<br>\n";
183     dbmopen(%fileinfo, "$db_file_name", 0000) ||
184         log_error(500, "Failed to open db file: $!\n");
185     foreach my $file (keys %fileinfo) {
186         if ($file =~ $re_search) {
187             $count++;
188             push(@results, "$file $fileinfo{$file}");
189             if ($count >= $max_count) {
190                 last;
191             }
192         }
193     }
194     if ($count >= $max_count) {
195         last;
196     }
197     dbmclose %fileinfo;
198 }
199
200 print $q->header,
201     $q->start_html("$title_base: $count results"),
202     $q->h1($title_base), "\n";
203 if ($count >= $max_count) {
204     print $q->p("More than $max_count results for \"$query_term\", showing the first $count only\n");
205 } else {   
206     print $q->p("$count results for \"$query_term\"\n");
207 }
208 if ($count > 0) {
209     print "<ol>\n";
210     foreach my $result (sort (@results)) {
211         my($found, @list) = split(' ', $result);
212         print "<li> $found appears in:\n";
213         print "<ul>";
214         foreach my $image (sort(@list)) {
215             print "<li>" . pretty_name($image);
216             print " (<a href=\"" . list_link($image) . "\">list.gz</a> |";
217             print " <a href=\"" . jigdo_link($image) . "\">jigdo</a> |";
218             print " <a href=\"" . iso_link($image) . "\">iso</a>)";
219         }
220         print "</ul>";
221     }
222     print "</ol>";
223 }
224 print_footer();
225 print $q->end_html;