1 package Packages::DoSearch;
6 use Benchmark ':hireswallclock';
11 our @ISA = qw( Exporter );
12 our @EXPORT = qw( do_search );
15 use Packages::Search qw( :all );
18 use Packages::HTML qw(marker);
19 use Packages::Config qw( $DBDIR $SEARCH_URL $SEARCH_PAGE
20 @SUITES @ARCHIVES $ROOT );
23 my ($params, $opts, $html_header, $menu, $page_content) = @_;
25 $Params::Search::too_many_hits = 0;
27 if ($params->{errors}{keywords}) {
28 fatal_error( "keyword not valid or missing" );
29 } elsif (length($opts->{keywords}) < 2) {
30 fatal_error( "keyword too short (keywords need to have at least two characters)" );
35 my $keyword = $opts->{keywords};
36 my $searchon = $opts->{searchon};
38 # for URL construction
39 my $keyword_esc = uri_escape( $keyword );
40 my $suites_param = join ',', @{$params->{values}{suite}{no_replace}};
41 my $sections_param = join ',', @{$params->{values}{section}{no_replace}};
42 my $archs_param = join ',', @{$params->{values}{arch}{no_replace}};
43 $opts->{common_params} = "suite=$suites_param§ion=$sections_param&keywords=$keyword_esc&searchon=$searchon&arch=$archs_param";
46 my $keyword_enc = encode_entities $keyword || '';
47 my $searchon_enc = encode_entities $searchon;
48 my $suites_enc = encode_entities( join( ', ', @{$params->{values}{suite}{no_replace}} ) );
49 my $sections_enc = encode_entities( join( ', ', @{$params->{values}{section}{no_replace}} ) );
50 my $archs_enc = encode_entities( join( ', ', @{$params->{values}{arch}{no_replace}} ) );
52 my $st0 = new Benchmark;
53 my (@results, @non_results);
55 unless (@Packages::CGI::fatal_errors) {
57 if ($searchon eq 'names') {
58 if ($opts->{source}) {
59 do_names_search( $keyword, \%sources, $sp_obj,
60 \&read_src_entry_all, $opts,
61 \@results, \@non_results );
63 do_names_search( $keyword, \%packages, $p_obj,
64 \&read_entry_all, $opts,
65 \@results, \@non_results );
67 # } elsif ($searchon eq 'contents') {
68 # require "./search_contents.pl";
71 do_names_search( $keyword, \%packages, $p_obj,
72 \&read_entry_all, $opts,
73 \@results, \@non_results );
74 do_fulltext_search( $keyword, "$DBDIR/descriptions.txt",
75 \%did2pkg, \%packages,
76 \&read_entry_all, $opts,
77 \@results, \@non_results );
82 # debug( join( "", Dumper( \@results, \@non_results )) );
83 my $st1 = new Benchmark;
84 my $std = timediff($st1, $st0);
85 debug( "Search took ".timestr($std) );
87 my $suite_wording = $suites_enc eq "all" ? "all suites"
88 : "suite(s) <em>$suites_enc</em>";
89 my $section_wording = $sections_enc eq 'all' ? "all sections"
90 : "section(s) <em>$sections_enc</em>";
91 my $arch_wording = $archs_enc eq 'any' ? "all architectures"
92 : "architecture(s) <em>$archs_enc</em>";
93 if ($searchon eq "names") {
94 my $source_wording = $opts->{source} ? "source " : "";
95 my $exact_wording = $opts->{exact} ? "named" : "that names contain";
96 msg( "You have searched for ${source_wording}packages $exact_wording <em>$keyword_enc</em> in $suite_wording, $section_wording, and $arch_wording." );
98 my $exact_wording = $opts->{exact} ? "" : " (including subword matching)";
99 msg( "You have searched for <em>$keyword_enc</em> in packages names and descriptions in $suite_wording, $section_wording, and $arch_wording$exact_wording." );
102 if ($Packages::Search::too_many_hits) {
103 error( "Your search was too wide so we will only display exact matches. At least <em>$Packages::Search::too_many_hits</em> results have been omitted and will not be displayed. Please consider using a longer keyword or more keywords." );
106 if (!@Packages::CGI::fatal_errors && !@results) {
108 if ($searchon eq "names") {
109 unless (@non_results) {
110 error( "Can't find that package." );
112 hint( "Can't find that package. ".
113 "<a href=\"$SEARCH_URL/$keyword_esc\">".
114 ($#non_results+1)."</a>".
115 " results have not been displayed due to the".
116 " search parameters." );
120 if (($suites_enc eq 'all')
121 && ($archs_enc eq 'any')
122 && ($sections_enc eq 'all')) {
123 error( "Can't find that string." );
125 error( "Can't find that string, at least not in that suite ($suites_enc, section $sections_enc) and on that architecture ($archs_enc)." );
128 if ($opts->{exact}) {
130 hint( "You have searched only for words exactly matching your
131 keywords. You can try to search <a href=\"".
132 encode_entities("$SEARCH_URL?exact=0&$opts->{common_params}")."\">allowing
133 subword matching</a>." );
136 hint( ( $printed ? "Or you" : "You" )." can try a different search on the <a href=\"$SEARCH_PAGE#search_packages\">Packages search page</a>." );
140 %$html_header = ( title => 'Package Search Results' ,
142 title_tag => 'Debian Package Search Results',
144 print_search_field => 'packages',
145 search_field_values => {
146 keywords => $keyword_enc,
147 searchon => $opts->{searchon_form},
149 suite => $suites_enc,
150 section => $sections_enc,
151 exact => $opts->{exact},
152 debug => $opts->{debug},
158 my (%pkgs, %subsect, %sect, %archives, %desc, %binaries, %provided_by);
160 unless ($opts->{source}) {
162 my ($pkg_t, $archive, $suite, $arch, $section, $subsection,
163 $priority, $version, $desc) = @$_;
165 my ($pkg) = $pkg_t =~ m/^(.+)/; # untaint
166 if ($arch ne 'virtual') {
168 if ($archive =~ /^(security|non-US)$/) {
169 $real_archive = $archive;
173 $pkgs{$pkg}{$suite}{$archive}{$version}{$arch} = 1;
174 $subsect{$pkg}{$suite}{$archive}{$version} = $subsection;
175 $sect{$pkg}{$suite}{$archive}{$version} = $section
176 unless $section eq 'main';
177 $archives{$pkg}{$suite}{$archive}{$version} = $real_archive
180 $desc{$pkg}{$suite}{$archive}{$version} = $desc;
182 $provided_by{$pkg}{$suite}{$archive} = [ split /\s+/, $desc ];
186 my @pkgs = sort(keys %pkgs, keys %provided_by);
187 $$page_content .= print_packages( \%pkgs, \@pkgs, $opts, $keyword,
188 \&print_package, \%provided_by,
189 \%archives, \%sect, \%subsect,
192 } else { # unless $opts->{source}
194 my ($pkg, $archive, $suite, $section, $subsection, $priority,
197 my $real_archive = '';
198 if ($archive =~ /^(security|non-US)$/) {
199 $real_archive = $archive;
202 if (($real_archive eq $archive) &&
203 $pkgs{$pkg}{$suite}{$archive} &&
204 (version_cmp( $pkgs{$pkg}{$suite}{$archive}, $version ) >= 0)) {
207 $pkgs{$pkg}{$suite}{$archive} = $version;
208 $subsect{$pkg}{$suite}{$archive}{source} = $subsection;
209 $sect{$pkg}{$suite}{$archive}{source} = $section
210 unless $section eq 'main';
211 $archives{$pkg}{$suite}{$archive}{source} = $real_archive
214 $binaries{$pkg}{$suite}{$archive} = find_binaries( $pkg, $archive, $suite, \%src2bin );
217 my @pkgs = sort keys %pkgs;
218 $$page_content .= print_packages( \%pkgs, \@pkgs, $opts, $keyword,
219 \&print_src_package, \%archives,
220 \%sect, \%subsect, \%binaries );
221 } # else unless $opts->{source}
226 my ($pkgs, $pkgs_list, $opts, $keyword, $print_func, @func_args) = @_;
228 #my ($start, $end) = multipageheader( $input, scalar @pkgs, \%opts );
229 my $str = '<div id="psearchres">';
230 $str .= "<p>Found <em>".(scalar @$pkgs_list)."</em> matching packages.";
234 if (grep { $_ eq $keyword } @$pkgs_list) {
236 $str .= '<h2>Exact hits</h2>';
237 $str .= &$print_func( $keyword, $pkgs->{$keyword}||{},
238 map { $_->{$keyword}||{} } @func_args );
239 @$pkgs_list = grep { $_ ne $keyword } @$pkgs_list;
242 if (@$pkgs_list && (($opts->{searchon} ne 'names') || !$opts->{exact})) {
243 $str .= '<h2>Other hits</h2>'
246 foreach my $pkg (@$pkgs_list) {
248 #next if $count < $start or $count > $end;
249 $str .= &$print_func( $pkg, $pkgs->{$pkg}||{},
250 map { $_->{$pkg}||{} } @func_args );
252 } elsif (@$pkgs_list) {
253 $str .= "<p><a href=\"".encode_entities("$SEARCH_URL?exact=0&$opts->{common_params}")."\">".
254 ($#{$pkgs_list}+1)."</a> results have not been displayed because you requested only exact matches.</p>";
262 my ($pkg, $pkgs, $provided_by, $archives, $sect, $subsect, $desc) = @_;
264 my $str = sprintf "<h3>Package %s</h3>\n", $pkg;
266 foreach my $suite (@SUITES) {
267 foreach my $archive (@ARCHIVES) {
268 next if $archive eq 'security';
269 next if $archive eq 'non-US';
270 my $path = $suite.(($archive ne 'us')?"/$archive":'');
271 if (exists $pkgs->{$suite}{$archive}) {
273 my @versions = version_sort keys %{$pkgs->{$suite}{$archive}};
275 if ($sect->{$suite}{$archive}{$versions[0]}) {
276 $origin_str .= " ".marker($sect->{$suite}{$archive}{$versions[0]});
278 $str .= sprintf( "<li><a href=\"$ROOT/%s/%s\">%s</a> (%s): %s %s\n",
279 $path, $pkg, $path, $subsect->{$suite}{$archive}{$versions[0]},
280 $desc->{$suite}{$archive}{$versions[0]}, $origin_str );
282 foreach my $v (@versions) {
283 my $archive_str = "";
284 if ($archives->{$suite}{$archive}{$v}) {
285 $archive_str .= " ".marker($archives->{$suite}{$archive}{$v});
288 my @archs_to_print = grep { !$archs_printed{$_} } sort keys %{$pkgs->{$suite}{$archive}{$v}};
289 $str .= sprintf( "<br>%s$archive_str: %s\n",
290 $v, join (" ", @archs_to_print ))
292 $archs_printed{$_}++ foreach @archs_to_print;
294 if (my $p = $provided_by->{$suite}{$archive}) {
295 $str .= '<br>also provided by: '.
296 join( ', ', map { "<a href=\"$ROOT/$path/$_\">$_</a>" } @$p);
299 } elsif (my $p = $provided_by->{$suite}{$archive}) {
300 $str .= sprintf( "<li><a href=\"$ROOT/%s/%s\">%s</a>: Virtual package<br>",
301 $path, $pkg, $path );
302 $str .= 'provided by: '.
303 join( ', ', map { "<a href=\"$ROOT/$path/$_\">$_</a>" } @$p);
311 sub print_src_package {
312 my ($pkg, $pkgs, $archives, $sect, $subsect, $binaries) = @_;
314 my $str = sprintf "<h3>Source package %s</h3>\n", $pkg;
316 foreach my $suite (@SUITES) {
317 foreach my $archive (@ARCHIVES) {
318 if (exists $pkgs->{$suite}{$archive}) {
320 if ($sect->{$suite}{$archive}{source}) {
321 $origin_str .= " ".marker($sect->{$suite}{$archive}{source});
323 if ($archives->{$suite}{$archive}{source}) {
324 $origin_str .= " ".marker($archives->{$suite}{$archive}{source});
326 $str .= sprintf( "<li><a href=\"$ROOT/%s/source/%s\">%s</a> (%s): %s %s",
327 $suite.(($archive ne 'us')?"/$archive":''), $pkg, $suite.(($archive ne 'us')?"/$archive":''), $subsect->{$suite}{$archive}{source},
328 $pkgs->{$suite}{$archive}, $origin_str );
330 $str .= "<br>Binary packages: ";
332 foreach my $bp (@{$binaries->{$suite}{$archive}}) {
333 my $bp_link = sprintf( "<a href=\"$ROOT/%s/%s\">%s</a>",
334 $suite.(($archive ne 'us')?"/$archive":''), uri_escape( $bp ), $bp );
335 push @bp_links, $bp_link;
337 $str .= join( ", ", @bp_links );