X-Git-Url: https://git.deb.at/?p=deb%2Fpackages.git;a=blobdiff_plain;f=lib%2FPackages%2FSearch.pm;h=61b37b5c1ee722c29f586ea2549bbd9c35d2aabe;hp=47d2b8299619fd839112a9aca6e0222c9bbfcb59;hb=0f318fa9ad9d473b543a48f46a7714a11283d300;hpb=720ad1b27c68b4395f55f96f0d1067fe62812a7e diff --git a/lib/Packages/Search.pm b/lib/Packages/Search.pm index 47d2b82..61b37b5 100644 --- a/lib/Packages/Search.pm +++ b/lib/Packages/Search.pm @@ -1,8 +1,8 @@ # # Packages::Search # -# Copyright (C) 2004-2006 Frank Lichtenheld -# +# Copyright (C) 2004-2007 Frank Lichtenheld +# # The code is based on the old search_packages.pl script that # was: # @@ -23,7 +23,7 @@ # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software -# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. # =head1 NAME @@ -43,233 +43,278 @@ package Packages::Search; use strict; use warnings; -use CGI qw( -oldstyle_urls ); use POSIX; use HTML::Entities; +use DB_File; +use Lingua::Stem v0.82; +use Search::Xapian qw(:ops); use Deb::Versions; +use Packages::CGI; use Exporter; our @ISA = qw( Exporter ); -our @EXPORT_OK = qw( nextlink prevlink indexline - resperpagelink ); +our @EXPORT_OK = qw( read_entry read_entry_all read_entry_simple + read_src_entry read_src_entry_all find_binaries + do_names_search do_fulltext_search do_xapian_search + find_similar + ); our %EXPORT_TAGS = ( all => [ @EXPORT_OK ] ); our $VERSION = 0.01; -our $USE_PAGED_MODE = 1; -use constant DEFAULT_PAGE => 1; -use constant DEFAULT_RES_PER_PAGE => 50; -our %page_params = ( page => { default => DEFAULT_PAGE, - match => '(\d+)' }, - number => { default => DEFAULT_RES_PER_PAGE, - match => '(\d+)' } ); - -our $debug = 0; - -sub parse_params { - my ( $cgi, $params_def ) = @_; - - my %params_ret = ( values => {}, errors => {} ); - my %params; - if ($USE_PAGED_MODE) { - print "DEBUG: Use PAGED_MODE
" if $debug; - %params = %$params_def; - foreach (keys %page_params) { - delete $params{$_}; - } - %params = ( %params, %page_params ); - } else { - %params = %$params_def; - } - - foreach my $param ( keys %params ) { - - print "

DEBUG: Param $param
" if $debug; +our $too_many_hits = 0; - my $p_value_orig = $cgi->param($param); +sub read_entry_all { + my ($hash, $key, $results, $non_results, $opts) = @_; + my ($virt, $result) = split /\000/o, $hash->{$key} || "-\01-", 2; - if (!defined($p_value_orig) - && defined $params_def->{$param}{alias} - && defined $cgi->param($params_def->{$param}{alias})) { - $p_value_orig = $cgi->param($params_def->{$param}{alias}); - print "DEBUG: Used alias $params_def->{$param}{alias}
" - if $debug; + my %virt = split /\01/o, $virt; + while (my ($suite, $provides) = each %virt) { + next if $suite eq '-'; + if ($opts->{h_suites}{$suite}) { + push @$results, [ $key, "-", $suite, 'virtual', 'v', 'v', 'v', 'v', 'v', + $provides]; + } else { + push @$non_results, [ $key, "-", $suite, 'virtual', 'v', 'v', 'v', 'v', 'v', + $provides]; } + } - my @p_value = ($p_value_orig); - - print "DEBUG: Value (Orig) ".($p_value_orig||"")."
" if $debug; - - if ($params_def->{$param}{array} && defined $p_value_orig) { - @p_value = split /$params_def->{$param}{array}/, $p_value_orig; - print "DEBUG: Value (Array Split) ". - join('##',@p_value)."
" if $debug; + foreach (split(/\000/o, $result||'')) { + my @data = split ( /\s/o, $_, 9 ); + debug( "Considering entry ".join( ':', @data), 2) if DEBUG; + if ($opts->{h_suites}{$data[1]} + && ($opts->{h_archs}{$data[2]} || $data[2] eq 'all') + && $opts->{h_sections}{$data[3]}) { + debug( "Using entry ".join( ':', @data), 2) if DEBUG; + push @$results, [ $key, @data ]; + } else { + push @$non_results, [ $key, @data ]; } + } +} +sub read_entry { + my ($hash, $key, $results, $opts) = @_; + my @non_results; + read_entry_all( $hash, $key, $results, \@non_results, $opts ); +} - if ($params_def->{$param}{match} && defined $p_value_orig) { - @p_value = map - { $_ =~ m/$params_def->{$param}{match}/; $_ = $1 } - @p_value; - } - @p_value = grep { defined $_ } @p_value; - - print "DEBUG: Value (Match) ". - join('##',@p_value)."
" if $debug; - - unless (@p_value) { - if (defined $params{$param}{default}) { - @p_value = ($params{$param}{default}); - } else { - @p_value = undef; - $params_ret{errors}{$param} = "undef"; - next; - } - } +#FIXME: make configurable +my %fallback_suites = ( + 'etch-backports' => 'etch', + 'etch-volatile' => 'etch', + 'lenny-backports' => 'lenny', + 'lenny-volatile' => 'lenny', + experimental => 'sid' ); + +sub read_entry_simple { + my ($hash, $key, $archives, $suite) = @_; + # FIXME: drop $archives + + my ($virt, $result) = split /\000/o, $hash->{$key} || "-\01-\0", 2; + my %virt = split /\01/o, $virt; + debug( "read_entry_simple: key=$key, archives=". + join(" ",(keys %$archives)).", suite=$suite", 1) if DEBUG; + debug( "read_entry_simple: virt=".join(" ",(%virt)), 2) if DEBUG; + # FIXME: not all of the 2^4=16 combinations of empty(results), + # empty(virt{suite}), empty(fb_result), empty(virt{fb_suite}) are dealt + # with correctly, but it's adequate enough for now + return [ $virt{$suite} ] unless defined $result; + foreach (split /\000/o, $result) { + my @data = split ( /\s/o, $_, 9 ); + debug( "use entry: @data", 2 ) if DEBUG && $data[1] eq $suite; + return [ $virt{$suite}, @data ] if $data[1] eq $suite; + } + if (my $fb_suite = $fallback_suites{$suite}) { + my $fb_result = read_entry_simple( $hash, $key, $archives, $fb_suite ); + my $fb_virt = shift(@$fb_result); + $virt{$suite} .= $virt{$suite} ? " $fb_virt" : $fb_virt if $fb_virt; + return [ $virt{$suite}, @$fb_result ] if @$fb_result; + } + return [ $virt{$suite} ]; +} - print "DEBUG: Value (Default) ". - join('##',@p_value)."
" if $debug; - my @p_value_no_replace = @p_value; - - if ($params{$param}{replace} && @p_value) { - @p_value = (); - foreach my $pattern (keys %{$params{$param}{replace}}) { - foreach (@p_value_no_replace) { - if ($_ eq $pattern) { - my $replacement = $params{$param}{replace}{$_}; - if (ref $replacement) { - push @p_value, @$replacement; - } else { - push @p_value, $replacement; - } - } else { - push @p_value, $_; - } +sub read_src_entry_all { + my ($hash, $key, $results, $non_results, $opts) = @_; + my $result = $hash->{$key} || ''; + debug( "read_src_entry_all: key=$key", 1) if DEBUG; + foreach (split /\000/o, $result) { + my @data = split ( /\s/o, $_, 6 ); + debug( "Considering entry ".join( ':', @data), 2) if DEBUG; + if ($opts->{h_archives}{$data[0]} + && $opts->{h_suites}{$data[1]} + && $opts->{h_sections}{$data[2]}) { + debug( "Using entry ".join( ':', @data), 2) if DEBUG; + push @$results, [ $key, @data ]; + } else { + push @$non_results, [ $key, @data ]; + } + } +} +sub read_src_entry { + my ($hash, $key, $results, $opts) = @_; + my @non_results; + read_src_entry_all( $hash, $key, $results, \@non_results, $opts ); +} +sub do_names_search { + my ($keywords, $packages, $postfixes, $read_entry, $opts, + $results, $non_results) = @_; + + my $first_keyword = lc shift @$keywords; + @$keywords = map { lc $_ } @$keywords; + + my ($key, $prefixes) = ($first_keyword, ''); + my (%pkgs, %pkgs_min); + $postfixes->seq( $key, $prefixes, R_CURSOR ); + while (index($key, $first_keyword) >= 0) { + if ($prefixes =~ /^(\^)?\001(\d+)/o) { + debug("$key has too many hits", 2 ) if DEBUG; + $too_many_hits += $2; + if ($1) { # use the empty prefix + foreach my $k (@$keywords) { + next unless $key =~ /\Q$k\E/; } + debug("add key $key", 2) if DEBUG; + $pkgs{$key}++; + $pkgs_min{$key}++; } - } - - print "DEBUG: Value (Final) ". - join('##',@p_value)."
" if $debug; - - if ($params_def->{$param}{array}) { - $params_ret{values}{$param} = { - orig => $p_value_orig, - no_replace => \@p_value_no_replace, - final => \@p_value, - }; } else { - $params_ret{values}{$param} = { - orig => $p_value_orig, - no_replace => $p_value_no_replace[0], - final => $p_value[0], - }; + PREFIX: + foreach (split /\000/o, $prefixes) { + $_ = '' if $_ eq '^'; + my $word = "$_$key"; + foreach my $k (@$keywords) { + next PREFIX unless $word =~ /\Q$k\E/; + } + debug("add word $word", 2) if DEBUG; + $pkgs{$word}++; + $pkgs_min{$word}++ if $_ eq ''; + } } + last if $postfixes->seq( $key, $prefixes, R_NEXT ) != 0; + last if keys %pkgs_min >= 100; } - if ($USE_PAGED_MODE) { - $cgi->delete( "page" ); - $cgi->delete( "number" ); + my $nr = keys %pkgs; + my $min_nr = keys %pkgs_min; + debug("nr=$nr min_nr=$min_nr too_many_hits=$too_many_hits", 1) if DEBUG; + if ($nr >= 100) { + $too_many_hits += $nr - $min_nr + 1; + %pkgs = %pkgs_min; + } + foreach my $pkg (sort keys %pkgs) { + &$read_entry( $packages, $pkg, $results, $non_results, $opts ); } - - return %params_ret; } -sub start { - my $params = shift; +sub do_xapian_search { + my ($keywords, $dbpath, $did2pkg, $packages, $read_entry, $opts, + $results, $non_results) = @_; - my $page = $params->{values}{page}{final} - || DEFAULT_PAGE; - my $res_per_page = $params->{values}{number}{final} - || DEFAULT_RES_PER_PAGE; +# NOTE: this needs to correspond with parse-packages! + my @tmp; + foreach my $keyword (@$keywords) { + $keyword =~ s;[^\w/+]+; ;og; + push @tmp, $keyword; + } + my $stemmer = Lingua::Stem->new(); + my @stemmed_keywords = grep { length($_) } @{$stemmer->stem( @tmp )}; + + my $db = Search::Xapian::Database->new( $dbpath ); + my $enq = $db->enquire( OP_OR, @$keywords, @stemmed_keywords ); + debug( "Xapian Query was: ".$enq->get_query()->get_description(), 1) if DEBUG; + my @matches = $enq->matches(0, 999); + + my (@order, %tmp_results); + foreach my $match ( @matches ) { + my $id = $match->get_docid(); + my $result = $did2pkg->{$id}; + + foreach (split /\000/o, $result) { + my @data = split /\s/, $_, 3; + debug ("Considering $data[0], arch = $data[2], relevance=".$match->get_percent(), 3) if DEBUG; +# next unless $data[2] eq 'all' || $opts->{h_archs}{$data[2]}; +# debug ("Ok", 3) if DEBUG; + unless ($tmp_results{$data[0]}++) { + push @order, $data[0]; + } + } + last if @order > 100; + } + undef $db; + $too_many_hits++ if @order > 100; - return 1 if $res_per_page =~ /^all$/i; - return $res_per_page * ($page - 1) + 1; + debug ("ORDER: @order", 2) if DEBUG; + foreach my $pkg (@order) { + &$read_entry( $packages, $pkg, $results, $non_results, $opts ); + } } -sub end { - my $params = shift; +sub find_similar { + my ($pkg, $dbpath, $did2pkg) = @_; - my $page = $params->{values}{page}{final} - || DEFAULT_PAGE; - my $res_per_page = $params->{values}{number}{final} - || DEFAULT_RES_PER_PAGE; + my $db = Search::Xapian::Database->new( $dbpath ); + my $enq = $db->enquire( "P$pkg" ); + debug( "Xapian Query was: ".$enq->get_query()->get_description(), 1) if DEBUG; + my $first_match = ($enq->matches(0,1))[0]->get_document(); - return $page * $res_per_page; -} + my @terms; + my $term_it = $first_match->termlist_begin(); + my $term_end = $first_match->termlist_end(); -sub indexline { - my ($cgi, $params, $num_res) = @_; - - my $index_line = ""; - my $page = $params->{values}{page}{final} - || DEFAULT_PAGE; - my $res_per_page = $params->{values}{number}{final} - || DEFAULT_RES_PER_PAGE; - my $numpages = ceil($num_res / - $res_per_page); - for (my $i = 1; $i <= $numpages; $i++) { - if ($i == $page) { - $index_line .= $i; - } else { - $index_line .= "self_url). - "&page=$i&number=$res_per_page\">". - "$i"; - } - if ($i < $numpages) { - $index_line .= " | "; - } + for (; $term_it ne $term_end; $term_it++) { + debug( "TERM: ".$term_it->get_termname(), 3); + push @terms, $term_it->get_termname(); } - return $index_line; -} - -sub nextlink { - my ($cgi, $params, $no_results ) = @_; - my $page = $params->{values}{page}{final} - || DEFAULT_PAGE; - $page++; - my $res_per_page = $params->{values}{number}{final} - || DEFAULT_RES_PER_PAGE; + my $rel_enq = $db->enquire( OP_OR, @terms ); + debug( "Xapian Query was: ".$rel_enq->get_query()->get_description(), 1) if DEBUG; + my @rel_pkg = $rel_enq->matches(2,20); - if ((($page-1)*$res_per_page + 1) > $no_results) { - return ">>"; - } - - return "self_url). - "&page=$page&number=$res_per_page\">>>"; -} +# use Data::Dumper; +# debug(Dumper(\@rel_pkg),1); -sub prevlink { - my ($cgi, $params ) = @_; + my (@order, %tmp_results); + foreach my $match ( @rel_pkg ) { + my $id = $match->get_docid(); + my $result = $did2pkg->{$id}; - my $page = $params->{values}{page}{final} - || DEFAULT_PAGE; - $page--; - if (!$page) { - return "<<"; + foreach (split /\000/o, $result) { + my @data = split /\s/, $_, 3; + debug ("Considering $data[0], arch = $data[2], relevance=".$match->get_percent(), 3) if DEBUG; + next if $data[0] eq $pkg; + unless ($tmp_results{$data[0]}++) { + push @order, $data[0]; + } + } } + undef $db; - my $res_per_page = $params->{values}{number}{final} - || DEFAULT_RES_PER_PAGE; - - return "self_url). - "&page=$page&number=$res_per_page\"><<"; + debug ("ORDER: @order", 2) if DEBUG; + my $last = 10; + $last = $#order if $#order < $last; + return @order[0..$last]; } -sub resperpagelink { - my ($cgi, $params, $res_per_page ) = @_; +sub find_binaries { + my ($pkg, $archive, $suite, $src2bin) = @_; - my $page; - if ($res_per_page =~ /^all$/i) { - $page = 1; - } else { - $page = ceil(start( $params ) / $res_per_page); + my $bins = $src2bin->{$pkg} || ''; + my %bins; + foreach (split /\000/o, $bins) { + my @data = split /\s/, $_, 5; + + debug( "find_binaries: considering @data", 3 ) if DEBUG; + if (($data[0] eq $archive) + && ($data[1] eq $suite)) { + $bins{$data[2]}++; + debug( "find_binaries: using @data", 3 ) if DEBUG; + } } - return "self_url). - "&page=$page&number=$res_per_page\">$res_per_page"; + return [ keys %bins ]; }