X-Git-Url: https://git.deb.at/?p=deb%2Fpackages.git;a=blobdiff_plain;f=lib%2FPackages%2FDoSearchContents.pm;h=debbbb2a93e28539aef61f66556ae17871080c85;hp=67d2028dbd7fce371d67e71b44a67b1ebb9887ba;hb=e2881c2279414d845cb0b21b5e2661924194cb77;hpb=47c93cb066364b11f0b216589ddc68671435b060 diff --git a/lib/Packages/DoSearchContents.pm b/lib/Packages/DoSearchContents.pm index 67d2028..debbbb2 100644 --- a/lib/Packages/DoSearchContents.pm +++ b/lib/Packages/DoSearchContents.pm @@ -12,49 +12,41 @@ our @ISA = qw( Exporter ); our @EXPORT = qw( do_search_contents ); use Deb::Versions; +use Packages::I18N::Locale; use Packages::Search qw( :all ); -use Packages::CGI; +use Packages::CGI qw( :DEFAULT error ); use Packages::DB; -use Packages::Config qw( $DBDIR $SEARCH_URL $SEARCH_PAGE - @SUITES @ARCHIVES $ROOT ); +use Packages::Config qw( $DBDIR @SUITES @ARCHIVES @ARCHITECTURES $ROOT ); sub do_search_contents { - my ($params, $opts, $html_header, $menu, $page_content) = @_; + my ($params, $opts, $page_content) = @_; if ($params->{errors}{keywords}) { - fatal_error( "keyword not valid or missing" ); - } elsif (length($opts->{keywords}) < 2) { - fatal_error( "keyword too short (keywords need to have at least two characters)" ); + fatal_error( _g( "keyword not valid or missing" ) ); + $opts->{keywords} = []; + } elsif (grep { length($_) < 2 } @{$opts->{keywords}}) { + fatal_error( _g( "keyword too short (keywords need to have at least two characters)" ) ); } if ($params->{errors}{suite}) { - fatal_error( "suite not valid or not specified" ); + fatal_error( _g( "suite not valid or not specified" ) ); } + + #FIXME: that's extremely hacky atm + if ($params->{values}{suite}{no_replace}[0] eq 'default') { + $params->{values}{suite}{no_replace} = + $params->{values}{suite}{final} = $opts->{suite} = [ 'etch' ]; + } + if (@{$opts->{suite}} > 1) { - fatal_error( "more than one suite specified for contents search (@{$opts->{suite}})" ); + fatal_error( sprintf( _g( "more than one suite specified for contents search (%s)" ), "@{$opts->{suite}}" ) ); } - $$menu = ""; - - my $keyword = $opts->{keywords}; - my $searchon = $opts->{searchon}; - my $exact = $opts->{exact}; + my @keywords = @{$opts->{keywords}}; + my $mode = $opts->{mode} || ''; my $suite = $opts->{suite}[0]; my $archive = $opts->{archive}[0] ||''; $Packages::Search::too_many_hits = 0; - # for URL construction - my $keyword_esc = uri_escape( $keyword ); - my $suites_param = join ',', @{$params->{values}{suite}{no_replace}}; - my $sections_param = join ',', @{$params->{values}{section}{no_replace}}; - my $archs_param = join ',', @{$params->{values}{arch}{no_replace}}; - - # for output - my $keyword_enc = encode_entities $keyword || ''; - my $searchon_enc = encode_entities $searchon; - my $suites_enc = encode_entities( join( ', ', @{$params->{values}{suite}{no_replace}} ) ); - my $sections_enc = encode_entities( join( ', ', @{$params->{values}{section}{no_replace}} ) ); - my $archs_enc = encode_entities( join( ', ', @{$params->{values}{arch}{no_replace}} ) ); - my $st0 = new Benchmark; my (@results); @@ -62,96 +54,107 @@ sub do_search_contents { my $nres = 0; - my $kw = lc $keyword; + my $first_kw = lc shift @keywords; # full filename search is tricky - my $ffn = $searchon eq 'filenames'; + my $ffn = $mode eq 'filename'; my $reverses = tie my %reverses, 'DB_File', "$DBDIR/contents/reverse_$suite.db", O_RDONLY, 0666, $DB_BTREE or die "Failed opening reverse DB: $!"; if ($ffn) { - open FILENAMES, '-|', 'fgrep', '--', $kw, "$DBDIR/contents/filenames_$suite.txt" + open FILENAMES, '-|', 'fgrep', '--', $first_kw, "$DBDIR/contents/filenames_$suite.txt" or die "Failed opening filename table: $!"; - error( "Exact and fullfilenamesearch don't go along" ) - if $ffn and $exact; - + FILENAME: while () { chomp; + foreach my $kw (@keywords) { + next FILENAME unless /\Q$kw\E/; + } &searchfile(\@results, reverse($_)."/", \$nres, $reverses); last if $Packages::Search::too_many_hits; } + while () {}; close FILENAMES or warn "fgrep error: $!\n"; } else { - $kw = reverse $kw; - + error(_g("The search mode you selected doesn't support more than one keyword.")) + if @keywords; + + my $kw = reverse $first_kw; + $kw =~ s{/+$}{}; + # exact filename searching follows trivially: - $kw = "$kw/" if $exact; + $kw = "$kw/" if $mode eq 'exactfilename'; &searchfile(\@results, $kw, \$nres, $reverses); } $reverses = undef; untie %reverses; - + my $st1 = new Benchmark; my $std = timediff($st1, $st0); - debug( "Search took ".timestr($std) ); - } - - my $suite_wording = $suites_enc eq "all" ? "all suites" - : "suite(s) $suites_enc"; - my $section_wording = $sections_enc eq 'all' ? "all sections" - : "section(s) $sections_enc"; - my $arch_wording = $archs_enc eq 'any' ? "all architectures" - : "architecture(s) $archs_enc"; - my $wording = $opts->{exact} ? "exact filenames" : "filenames that contain"; - $wording = "paths that end with" if $searchon eq "contents"; - msg( "You have searched for ${wording} $keyword_enc in $suite_wording, $section_wording, and $arch_wording." ); - - if ($Packages::Search::too_many_hits) { - error( "Your search was too wide so we will only display only the first about 100 matches. Please consider using a longer keyword or more keywords." ); - } - - if (!@Packages::CGI::fatal_errors && !@results) { - error( "Nothing found" ); + debug( "Search took ".timestr($std) ) if DEBUG; } - %$html_header = ( title => 'Package Contents Search Results' , - lang => 'en', - title_tag => 'Debian Package Contents Search Results', - print_title => 1, - print_search_field => 'packages', - search_field_values => { - keywords => $keyword_enc, - searchon => 'contents', - arch => $archs_enc, - suite => $suites_enc, - section => $sections_enc, - exact => $opts->{exact}, - debug => $opts->{debug}, - }, - ); - - $$page_content = ''; - if (@results) { - $$page_content .= "

Found ".scalar(@results)." results

"; - $$page_content .= "
"; - foreach my $result (sort { $a->[0] cmp $b->[0] } @results) { - my $file = shift @$result; - $$page_content .= "'; + push @{$page_content->{results}}, \%result; } - $$page_content .= '' if @results > 20; - $$page_content .= '
FilePackages
$file"; - my %pkgs; - foreach (@$result) { - my ($pkg, $arch) = split /:/, $_; - $pkgs{$pkg}{$arch}++; + my (%results,%archs); + foreach my $result (sort { $a->[0] cmp $b->[0] } @results) { + my $file = shift @$result; + my %pkgs; + foreach (@$result) { + my ($pkg, $arch) = split /:/, $_; + next unless $opts->{h_archs}{$arch}; + $pkgs{$pkg}{$arch}++; + $archs{$arch}++ unless $arch eq 'all'; + } + next unless keys %pkgs; + $results{$file} = \%pkgs; + } + my @all_archs = sort keys %archs; + @all_archs = sort @ARCHITECTURES unless @all_archs; + $page_content->{suite} = $suite; + $page_content->{archive} = $archive; + $page_content->{all_architectures} = \@all_archs; + $page_content->{all_suites} = \@SUITES; + $page_content->{mode} = $mode; + $page_content->{search_architectures} = $opts->{arch}; + $page_content->{search_keywords} = $opts->{keywords}; + $page_content->{sections} = $opts->{section}; + $page_content->{too_many_hits} = $Packages::Search::too_many_hits; + + debug( "all_archs = @all_archs", 1 ) if DEBUG; + + if (keys %results) { + my $sort_func = sub { $_[0] cmp $_[1] }; + $sort_func = sub { (sort keys %{$results{$_[0]}})[0] + cmp + (sort keys %{$results{$_[1]}})[0] + } if $opts->{sort_by} eq 'pkg'; + + $page_content->{results} = []; + foreach my $file (sort {&$sort_func($a,$b)} keys %results) { + my %result; + $result{file} = "/$file"; + $result{packages} = []; + foreach my $pkg (sort keys %{$results{$file}}) { + my $arch_str = ''; + my @archs = keys %{$results{$file}{$pkg}}; + my $arch_neg = 0; + unless ($results{$file}{$pkg}{all} || + (@archs == @all_archs)) { + if (@archs >= @all_archs/2) { + @archs = grep { !$results{$file}{$pkg}{$_} } @all_archs; + $arch_neg = 1; + } + } else { + @archs = (); + } + push @{$result{packages}}, { pkg => $pkg, architectures => \@archs, architectures_are_rev => $arch_neg }; } - $$page_content .= join( ", ", map { "$_" } sort keys %pkgs); - $$page_content .= '
FilePackages
'; } } # sub do_search_contents @@ -160,18 +163,25 @@ sub searchfile my ($results, $kw, $nres, $reverses) = @_; my ($key, $value) = ($kw, ""); - debug( "searchfile: kw=$kw", 1 ); + debug( "searchfile: kw=$kw", 1 ) if DEBUG; for (my $status = $reverses->seq($key, $value, R_CURSOR); $status == 0; - $status = $reverses->seq( $key, $value, R_NEXT)) { + $status = $reverses->seq( $key, $value, R_NEXT)) { # FIXME: what's the most efficient "is prefix of" thingy? We only want to know # whether $kw is or is not a prefix of $key last unless index($key, $kw) == 0; - debug( "found $key", 2 ); - - my @hits = split /\0/o, $value; - push @$results, [ scalar reverse($key), @hits ]; + debug( "found $key", 2 ) if DEBUG; + + my @files = split /\001/o, $value; + foreach my $f (@files) { + my @hits = split /\0/o, $f; + my $file = shift @hits; + if ($file eq '-') { + $file = reverse($key); + } + push @$results, [ $file, @hits ]; + } last if ($$nres)++ > 100; }