From: Frank Lichtenheld Date: Thu, 2 Feb 2006 14:40:24 +0000 (+0000) Subject: * Fix display of binary packages in source package search X-Git-Tag: switch-to-templates~187 X-Git-Url: https://git.deb.at/w?a=commitdiff_plain;h=21631587bfdd11886cbaf3b04b423773665bc873;p=deb%2Fpackages.git * Fix display of binary packages in source package search * Completly get rid of global variables in read_* and do_names_search --- diff --git a/cgi-bin/search_packages.pl b/cgi-bin/search_packages.pl index f54efbe..4372d55 100755 --- a/cgi-bin/search_packages.pl +++ b/cgi-bin/search_packages.pl @@ -55,7 +55,7 @@ my $pet0 = new Benchmark; my $debug_allowed = 1; my $debug = $debug_allowed && $input->param("debug"); $debug = 0 if not defined($debug); -$Search::Param::debug = 1 if $debug > 1; +$Packages::Search::debug = 1 if $debug > 1; # If you want, just print out a list of all of the variables and exit. print $input->header if $debug; @@ -79,7 +79,7 @@ if (my $path = $input->param('path')) { } my ( $format, $keyword, $case, $subword, $exact, $searchon, - @suites, @sections, @archs ); + @suites, @sections, @archs ); my %params_def = ( keywords => { default => undef, match => '^\s*([-+\@\w\/.:]+)\s*$', @@ -131,6 +131,9 @@ if ($params{errors}{keywords}) { my $case_bool = ( $case !~ /insensitive/ ); $exact = !$subword unless defined $exact; +$opts{h_suites} = { map { $_ => 1 } @suites }; +$opts{h_sections} = { map { $_ => 1 } @sections }; +$opts{h_archs} = { map { $_ => 1 } @archs }; # for URL construction my $suites_param = join ',', @{$params{values}{suite}{no_replace}}; @@ -188,34 +191,27 @@ if ($searchon eq 'sourcenames') { $search_on_sources = 1; } -my %suites = map { $_ => 1 } @suites; -my %sections = map { $_ => 1 } @sections; -my %archs = map { $_ => 1 } @archs; - -print "DEBUG: suites=@suites, sections=@sections, archs=@archs
" - if $debug > 2; - sub read_entry { - my ($hash, $key, $results) = @_; - my $result = $hash->{$key}; + my ($hash, $key, $results, $opts) = @_; + my $result = $hash->{$key} || ''; foreach (split /\000/, $result) { my @data = split ( /\s/, $_, 7 ); print "DEBUG: Considering entry ".join( ':', @data)."
" if $debug > 2; - if ($suites{$data[0]} && ($archs{$data[1]} || $data[1] eq 'all') - && $sections{$data[2]}) { + if ($opts->{h_suites}{$data[0]} + && ($opts->{h_archs}{$data[1]} || $data[1] eq 'all') + && $opts->{h_sections}{$data[2]}) { print "DEBUG: Using entry ".join( ':', @data)."
" if $debug > 2; push @$results, [ $key, @data ]; } } } sub read_src_entry { - my ($hash, $key, $results) = @_; - my $result = $hash->{$key}; - + my ($hash, $key, $results, $opts) = @_; + my $result = $hash->{$key} || ''; foreach (split /\000/, $result) { my @data = split ( /\s/, $_, 5 ); print "DEBUG: Considering entry ".join( ':', @data)."
" if $debug > 2; - if ($suites{$data[0]} && $sections{$data[1]}) { + if ($opts->{h_suites}{$data[0]} && $opts->{h_sections}{$data[1]}) { print "DEBUG: Using entry ".join( ':', @data)."
" if $debug > 2; push @$results, [ $key, @data ]; } @@ -231,7 +227,7 @@ sub do_names_search { or die "couldn't tie DB $DBDIR/$file: $!"; if ($opts->{exact}) { - &$read_entry( \%packages, $keyword, \@results ); + &$read_entry( \%packages, $keyword, \@results, $opts ); } else { my ($key, $prefixes) = ($keyword, ''); my %pkgs; @@ -258,7 +254,7 @@ sub do_names_search { %pkgs = ( $keyword => 1 ); } foreach my $pkg (sort keys %pkgs) { - &$read_entry( \%packages, $pkg, \@results ); + &$read_entry( \%packages, $pkg, \@results, $opts ); } } return \@results; @@ -302,16 +298,35 @@ sub do_fulltext_search { my $result = $did2pkg{$l}; foreach (split /\000/o, $result) { my @data = split /\s/, $_, 3; - next unless $archs{$data[2]}; + next unless $opts->{h_archs}{$data[2]}; $tmp_results{$data[0]}++; } } foreach my $pkg (keys %tmp_results) { - &$read_entry( \%packages, $pkg, \@results ); + &$read_entry( \%packages, $pkg, \@results, $opts ); } return \@results; } +sub find_binaries { + my ($pkg, $suite) = @_; + + tie my %src2bin, 'DB_File', "$DBDIR/sources_packages.db", O_RDONLY, 0666, $DB_BTREE + or die "couldn't open $DBDIR/sources_packages.db: $!"; + + my $bins = $src2bin{$pkg} || ''; + my %bins; + foreach (split /\000/o, $bins) { + my @data = split /\s/, $_, 4; + + if ($data[0] eq $suite) { + $bins{$data[1]}++; + } + } + + return [ keys %bins ]; +} + if ($searchon eq 'names') { push @results, @{ do_names_search( $keyword, 'packages_small.db', 'package_postfixes.db', @@ -408,7 +423,6 @@ unless ($search_on_sources) { $part{$package}{$suite}{$version} = $section unless $section eq 'main'; $desc{$package}{$suite}{$version} = $desc; - } if ($format eq 'html') { @@ -469,13 +483,13 @@ unless ($search_on_sources) { } else { foreach (@results) { my ($package, $suite, $section, $subsection, $priority, - $version, $binaries) = @$_; + $version) = @$_; $pkgs{$package}{$suite} = $version; $sect{$package}{$suite}{source} = $subsection; $part{$package}{$suite}{source} = $section unless $section eq 'main'; - $binaries{$package}{$suite} = [ sort split( /\s*,\s*/, $binaries ) ]; + $binaries{$package}{$suite} = find_binaries( $package, $suite ); } if ($format eq 'html') { @@ -498,15 +512,8 @@ unless ($search_on_sources) { print "
Binary packages: "; my @bp_links; foreach my $bp (@{$binaries{$pkg}{$ver}}) { - my $sect = 'section'; - - my $bp_link; - if ($sect) { - $bp_link = sprintf( "%s", - $ver, $sect, uri_escape( $bp ), $bp ); - } else { - $bp_link = $bp; - } + my $bp_link = sprintf( "%s", + $ver, uri_escape( $bp ), $bp ); push @bp_links, $bp_link; } print join( ", ", @bp_links );