]> git.deb.at Git - deb/packages.git/blob - lib/Packages/DoSearch.pm
Small adjustments
[deb/packages.git] / lib / Packages / DoSearch.pm
1 package Packages::DoSearch;
2
3 use strict;
4 use warnings;
5
6 use Benchmark ':hireswallclock';
7 use DB_File;
8 use URI::Escape;
9 use HTML::Entities;
10 use Exporter;
11 our @ISA = qw( Exporter );
12 our @EXPORT = qw( do_search );
13
14 use Deb::Versions;
15 use Packages::I18N::Locale;
16 use Packages::Search qw( :all );
17 use Packages::CGI;
18 use Packages::DB;
19 use Packages::HTML qw(marker);
20 use Packages::Config qw( $DBDIR $SEARCH_URL $SEARCH_PAGE
21                          @SUITES @ARCHIVES $ROOT );
22 use Packages::HTML;
23
24 sub do_search {
25     my ($params, $opts, $html_header, $menu, $page_content) = @_;
26
27     $Params::Search::too_many_hits = 0;
28
29     if ($params->{errors}{keywords}) {
30         fatal_error( _g( "keyword not valid or missing" ) );
31     } elsif (length($opts->{keywords}) < 2) {
32         fatal_error( _g( "keyword too short (keywords need to have at least two characters)" ) );
33     }
34
35     $$menu = "";
36     
37     my $keyword = $opts->{keywords};
38     my $searchon = $opts->{searchon};
39
40     # for URL construction
41     my $keyword_esc = uri_escape( $keyword );
42     $opts->{keywords_esc} = $keyword_esc;
43
44     # for output
45     my $keyword_enc = encode_entities $keyword || '';
46     my $searchon_enc = encode_entities $searchon;
47     my $suites_enc = encode_entities( join( ', ', @{$params->{values}{suite}{no_replace}} ) );
48     my $sections_enc = encode_entities( join( ', ', @{$params->{values}{section}{no_replace}} ) );
49     my $archs_enc = encode_entities( join( ', ',  @{$params->{values}{arch}{no_replace}} ) );
50     
51     my $st0 = new Benchmark;
52     my (@results, @non_results);
53
54     unless (@Packages::CGI::fatal_errors) {
55
56         if ($searchon eq 'names') {
57             if ($opts->{source}) {
58                 do_names_search( $keyword, \%sources, $sp_obj,
59                                  \&read_src_entry_all, $opts,
60                                  \@results, \@non_results );
61             } else {
62                 do_names_search( $keyword, \%packages, $p_obj,
63                                  \&read_entry_all, $opts,
64                                  \@results, \@non_results );
65             }
66 #       } elsif ($searchon eq 'contents') {
67 #           require "./search_contents.pl";
68 #           &contents($input);
69         } else {
70             do_names_search( $keyword, \%packages, $p_obj,
71                              \&read_entry_all, $opts,
72                              \@results, \@non_results );
73             do_fulltext_search( $keyword, "$DBDIR/descriptions.txt",
74                                 \%did2pkg, \%packages,
75                                 \&read_entry_all, $opts,
76                                 \@results, \@non_results );
77         }
78     }
79     
80 #    use Data::Dumper;
81 #    debug( join( "", Dumper( \@results, \@non_results )) ) if DEBUG;
82     my $st1 = new Benchmark;
83     my $std = timediff($st1, $st0);
84     debug( "Search took ".timestr($std) ) if DEBUG;
85     
86     my $suite_wording = $suites_enc =~ /^(default|all)$/ ? _g("all suites")
87         : sprintf(_g("suite(s) <em>%s</em>", $suites_enc) );
88     my $section_wording = $sections_enc eq 'all' ? _g("all sections")
89         : sprintf(_g("section(s) <em>%s</em>", $sections_enc) );
90     my $arch_wording = $archs_enc eq 'any' ? _g("all architectures")
91         : sprintf(_g("architecture(s) <em>%s</em>", $archs_enc) );
92     if ($searchon eq "names") {
93         my $source_wording = $opts->{source} ? _g("source packages") : _g("packages");
94         # sorry to all translators for that one... (patches welcome)
95         msg( sprintf( _g( "You have searched for %s that names contain <em>%s</em> in %s, %s, and %s." ),
96                       $source_wording, $keyword_enc,
97                       $suite_wording, $section_wording, $arch_wording ) );
98     } else {
99         my $exact_wording = $opts->{exact} ? "" : _g(" (including subword matching)");
100         msg( sprintf( _g( "You have searched for <em>%s</em> in packages names and descriptions in %s, %s, and %s%s." ),
101                       $keyword_enc,
102                       $suite_wording, $section_wording, $arch_wording,
103                       $exact_wording ) );
104     }
105
106     if ($Packages::Search::too_many_hits) {
107         error( sprintf( _g( "Your search was too wide so we will only display exact matches. At least <em>%s</em> results have been omitted and will not be displayed. Please consider using a longer keyword or more keywords." ), $Packages::Search::too_many_hits ) );
108     }
109     
110     if (!@Packages::CGI::fatal_errors && !@results) {
111         if ($searchon eq "names") {
112             unless (@non_results) {
113                 error( _g( "Can't find that package." ) );
114             } else {
115                 hint( _g( "Can't find that package." )." ".
116                       sprintf( _g( '<a href="%s">%s</a>'.
117                       " results have not been displayed due to the".
118                       " search parameters." ), "$SEARCH_URL/$keyword_esc" ,
119                       $#non_results+1 ) );
120             }
121             
122         } else {
123             if (($suites_enc eq 'all')
124                 && ($archs_enc eq 'any')
125                 && ($sections_enc eq 'all')) {
126                 error( _g( "Can't find that string." ) );
127             } else {
128                 error( sprintf( _g( "Can't find that string, at least not in that suite (%s, section %s) and on that architecture (%s)." ),
129                                 $suites_enc, $sections_enc, $archs_enc ) );
130             }
131             
132             if ($opts->{exact}) {
133                 hint( sprintf( _g( 'You have searched only for words exactly matching your keywords. You can try to search <a href="%s">allowing subword matching</a>.' ),
134                                encode_entities(make_search_url('',"keywords=$keyword_esc",{exact => 0})) ) );
135             }
136         }
137         hint( sprintf( _g( 'You can try a different search on the <a href="%s">Packages search page</a>.' ), "$SEARCH_PAGE#search_packages" ) );
138         
139     }
140
141     %$html_header = ( title => _g( 'Package Search Results' ) ,
142                       lang => $opts->{lang},
143                       title_tag => _g( 'Debian Package Search Results' ),
144                       print_title => 1,
145                       print_search_field => 'packages',
146                       search_field_values => { 
147                           keywords => $keyword_enc,
148                           searchon => $opts->{searchon_form},
149                           arch => $archs_enc,
150                           suite => $suites_enc,
151                           section => $sections_enc,
152                           exact => $opts->{exact},
153                           debug => $opts->{debug},
154                       },
155                       );
156
157     $$page_content = '';
158     if (@results) {
159         my (%pkgs, %subsect, %sect, %archives, %desc, %binaries, %provided_by);
160
161         unless ($opts->{source}) {
162             foreach (@results) {
163                 my ($pkg_t, $archive, $suite, $arch, $section, $subsection,
164                     $priority, $version, $desc) = @$_;
165                 
166                 my ($pkg) = $pkg_t =~ m/^(.+)/; # untaint
167                 if ($arch ne 'virtual') {
168                     $pkgs{$pkg}{$suite}{$version}{$arch} = 1;
169                     $subsect{$pkg}{$suite}{$version} = $subsection;
170                     $sect{$pkg}{$suite}{$version} = $section
171                         unless $section eq 'main';
172                     $archives{$pkg}{$suite}{$version} ||= $archive;
173                     
174                     $desc{$pkg}{$suite}{$version} = $desc;
175                 } else {
176                     $provided_by{$pkg}{$suite} = [ split /\s+/, $desc ];
177                 }
178             }
179
180             my %uniq_pkgs = map { $_ => 1 } (keys %pkgs, keys %provided_by);
181             my @pkgs = sort keys %uniq_pkgs;
182             $$page_content .= print_packages( \%pkgs, \@pkgs, $opts, $keyword,
183                                               \&print_package, \%provided_by,
184                                               \%archives, \%sect, \%subsect,
185                                               \%desc );
186
187         } else { # unless $opts->{source}
188             foreach (@results) {
189                 my ($pkg, $archive, $suite, $section, $subsection, $priority,
190                     $version) = @$_;
191                 
192                 my $real_archive = '';
193                 if ($archive =~ /^(security|non-US)$/) {
194                     $real_archive = $archive;
195                     $archive = 'us';
196                 }
197                 if (($real_archive eq $archive) &&
198                     $pkgs{$pkg}{$suite}{$archive} &&
199                     (version_cmp( $pkgs{$pkg}{$suite}{$archive}, $version ) >= 0)) {
200                     next;
201                 }
202                 $pkgs{$pkg}{$suite}{$archive} = $version;
203                 $subsect{$pkg}{$suite}{$archive}{source} = $subsection;
204                 $sect{$pkg}{$suite}{$archive}{source} = $section
205                     unless $section eq 'main';
206                 $archives{$pkg}{$suite}{$archive}{source} = $real_archive
207                     if $real_archive;
208
209                 $binaries{$pkg}{$suite}{$archive} = find_binaries( $pkg, $archive, $suite, \%src2bin );
210             }
211
212             my @pkgs = sort keys %pkgs;
213             $$page_content .= print_packages( \%pkgs, \@pkgs, $opts, $keyword,
214                                               \&print_src_package, \%archives,
215                                               \%sect, \%subsect, \%binaries );
216         } # else unless $opts->{source}
217     } # if @results
218 } # sub do_search
219
220 sub print_packages {
221     my ($pkgs, $pkgs_list, $opts, $keyword, $print_func, @func_args) = @_;
222
223     #my ($start, $end) = multipageheader( $input, scalar @pkgs, \%opts );
224     my $str = '<div id="psearchres">';
225     $str .= "<p>".sprintf( _g( "Found <em>%s</em> matching packages." ),
226                            scalar @$pkgs_list )."</p>";
227     #my $count = 0;
228             
229     my $have_exact;
230     if (grep { $_ eq $keyword } @$pkgs_list) {
231         $have_exact = 1;
232         $str .= '<h2>'._g( "Exact hits" ).'</h2>';
233         $str .= &$print_func( $keyword, $pkgs->{$keyword}||{},
234                               map { $_->{$keyword}||{} } @func_args );
235         @$pkgs_list = grep { $_ ne $keyword } @$pkgs_list;
236     }
237             
238     if (@$pkgs_list && (($opts->{searchon} ne 'names') || !$opts->{exact})) {
239         $str .= '<h2>'._g( 'Other hits' ).'</h2>'
240             if $have_exact;
241         
242         foreach my $pkg (@$pkgs_list) {
243             #$count++;
244             #next if $count < $start or $count > $end;
245             $str .= &$print_func( $pkg, $pkgs->{$pkg}||{},
246                                   map { $_->{$pkg}||{} } @func_args );
247         }
248     } elsif (@$pkgs_list) {
249         $str .= "<p>".sprintf( _g( '<a href="%s">%s</a> results have not been displayed because you requested only exact matches.' ),
250                                encode_entities(make_search_url('',"keywords=$opts->{keyword_esc}",{exact => 0})),
251                                scalar @$pkgs_list )."</p>";
252     }
253     $str .= '</div>';
254
255     return $str;
256 }
257
258 sub print_package {
259     my ($pkg, $pkgs, $provided_by, $archives, $sect, $subsect, $desc) = @_;
260
261     my $str = '<h3>'.sprintf( _g( 'Package %s' ), $pkg ).'</h3>';
262     $str .= '<ul>';
263     foreach my $suite (@SUITES) {
264             my $override = { suite => $suite };
265             if (exists $pkgs->{$suite}) {
266                 my %archs_printed;
267                 my @versions = version_sort keys %{$pkgs->{$suite}};
268                 my $origin_str = "";
269                 if ($sect->{$suite}{$versions[0]}) {
270                     $origin_str .= " ".marker($sect->{$suite}{$versions[0]});
271                 }
272                 $str .= sprintf( "<li><a href=\"%s\">%s</a> (%s): %s   %s\n",
273                                  make_url($pkg,'',$override), $suite, $subsect->{$suite}{$versions[0]},
274                                  $desc->{$suite}{$versions[0]}, $origin_str );
275                 
276                 foreach my $v (@versions) {
277                     my $archive_str = "";
278                     if ($archives->{$suite}{$v} ne 'us') {
279                         $archive_str .= " ".marker($archives->{$suite}{$v});
280                     }
281                     
282                     my @archs_to_print = grep { !$archs_printed{$_} } sort keys %{$pkgs->{$suite}{$v}};
283                     $str .= sprintf( "<br>%s$archive_str: %s\n",
284                                      $v, join (" ", @archs_to_print ))
285                         if @archs_to_print;
286                     $archs_printed{$_}++ foreach @archs_to_print;
287                 }
288                 if (my $p =  $provided_by->{$suite}) {
289                     $str .= '<br>'._g( 'also provided by: ' ).
290                         join( ', ', map { "<a href=\"".
291                                               make_url($_,'',$override)."\">$_</a>"  } @$p);
292                 }
293                 $str .= "</li>\n";
294             } elsif (my $p =  $provided_by->{$suite}) {
295                 $str .= sprintf( "<li><a href=\"%s\">%s</a>: "._g('Virtual package').'<br>',
296                                  make_url($pkg,'',$override), $suite );
297                 $str .= _g( 'provided by: ' ).
298                     join( ', ', map { "<a href=\"".
299                                           make_url($_,'',$override)."\">$_</a>"  } @$p);
300             }
301     }
302     $str .= "</ul>\n";
303     return $str;
304 }
305
306 sub print_src_package {
307     my ($pkg, $pkgs, $archives, $sect, $subsect, $binaries) = @_;
308
309     my $str = '<h3>'.sprintf( _g( 'Source package %s' ), $pkg ).'</h3>';
310     $str .= "<ul>\n";
311     foreach my $suite (@SUITES) {
312         foreach my $archive (@ARCHIVES) {
313             if (exists $pkgs->{$suite}{$archive}) {
314                 my $origin_str = "";
315                 if ($sect->{$suite}{$archive}{source}) {
316                     $origin_str .= " ".marker($sect->{$suite}{$archive}{source});
317                 }
318                 if ($archives->{$suite}{$archive}{source}) {
319                     $origin_str .= " ".marker($archives->{$suite}{$archive}{source});
320                 }
321                 $str .= sprintf( "<li><a href=\"$ROOT/%s/source/%s\">%s</a> (%s): %s   %s",
322                                  $suite.(($archive ne 'us')?"/$archive":''), $pkg, $suite.(($archive ne 'us')?"/$archive":''), $subsect->{$suite}{$archive}{source},
323                                  $pkgs->{$suite}{$archive}, $origin_str );
324                 
325                 $str .= "<br>"._g( 'Binary packages: ' );
326                 my @bp_links;
327                 foreach my $bp (@{$binaries->{$suite}{$archive}}) {
328                     my $bp_link = sprintf( "<a href=\"$ROOT/%s/%s\">%s</a>",
329                                            $suite.(($archive ne 'us')?"/$archive":''), uri_escape( $bp ),  $bp );
330                     push @bp_links, $bp_link;
331                 }
332                 $str .= join( ", ", @bp_links );
333                 $str .= "</li>\n";
334             }
335         }
336     }
337     $str .= "</ul>\n";
338     return $str;
339 }
340
341 1;