X-Git-Url: https://git.deb.at/?a=blobdiff_plain;f=lib%2FPackages%2FSearch.pm;h=021f0fd46196fad9847ce57616e3ebd47da5f802;hb=9f0c86ad48e5ccdd89c2ae10fc35baee286f3adf;hp=0bc157d735334fd3f516a5bf4687e959546ae11a;hpb=ab47ae363dddbc35743572c62fae6350dcb7cf96;p=deb%2Fpackages.git diff --git a/lib/Packages/Search.pm b/lib/Packages/Search.pm index 0bc157d..021f0fd 100644 --- a/lib/Packages/Search.pm +++ b/lib/Packages/Search.pm @@ -46,6 +46,8 @@ use warnings; use POSIX; use HTML::Entities; use DB_File; +use Lingua::Stem v0.82; +use Search::Xapian qw(:ops); use Deb::Versions; use Packages::CGI; @@ -55,7 +57,8 @@ our @ISA = qw( Exporter ); 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_names_search do_fulltext_search do_xapian_search + find_similar ); our %EXPORT_TAGS = ( all => [ @EXPORT_OK ] ); @@ -100,6 +103,8 @@ sub read_entry { #FIXME: make configurable my %fallback_suites = ( + 'oldstable-backports' => 'oldstable', + 'oldstable-volatile' => 'oldstable', 'stable-backports' => 'stable', 'stable-volatile' => 'stable', experimental => 'unstable' ); @@ -154,23 +159,29 @@ sub read_src_entry { read_src_entry_all( $hash, $key, $results, \@non_results, $opts ); } sub do_names_search { - my ($keyword, $packages, $postfixes, $read_entry, $opts, + my ($keywords, $packages, $postfixes, $read_entry, $opts, $results, $non_results) = @_; - $keyword = lc $keyword; + my $first_keyword = lc shift @$keywords; + @$keywords = map { lc $_ } @$keywords; - my ($key, $prefixes) = ($keyword, ''); + my ($key, $prefixes) = ($first_keyword, ''); my %pkgs; $postfixes->seq( $key, $prefixes, R_CURSOR ); - while (index($key, $keyword) >= 0) { + while (index($key, $first_keyword) >= 0) { if ($prefixes =~ /^\001(\d+)/o) { debug( "$key has too many hits", 2 ) if DEBUG; $too_many_hits += $1; } else { + PREFIX: foreach (split /\000/o, $prefixes) { $_ = '' if $_ eq '^'; - debug( "add word $_$key", 2) if DEBUG; - $pkgs{$_.$key}++; + my $word = "$_$key"; + foreach my $k (@$keywords) { + next PREFIX unless $word =~ /\Q$k\E/; + } + debug( "add word $word", 2) if DEBUG; + $pkgs{$word}++; } } last if $postfixes->seq( $key, $prefixes, R_NEXT ) != 0; @@ -180,51 +191,99 @@ sub do_names_search { my $no_results = keys %pkgs; if ($too_many_hits || ($no_results >= 100)) { $too_many_hits += $no_results; - %pkgs = ( $keyword => 1 ); + %pkgs = ( $first_keyword => 1 ) unless @$keywords; } foreach my $pkg (sort keys %pkgs) { &$read_entry( $packages, $pkg, $results, $non_results, $opts ); } } -sub do_fulltext_search { - my ($keyword, $file, $did2pkg, $packages, $read_entry, $opts, + +sub do_xapian_search { + my ($keywords, $db, $did2pkg, $packages, $read_entry, $opts, $results, $non_results) = @_; # NOTE: this needs to correspond with parse-packages! - $keyword =~ tr [A-Z] [a-z]; - if ($opts->{exact}) { - $keyword = " $keyword "; + my @tmp; + foreach my $keyword (@$keywords) { + $keyword =~ s;[^\w/+]+; ;og; + push @tmp, $keyword; } - $keyword =~ s/[(),.-]+//og; - $keyword =~ s#[^a-z0-9_/+]+# #og; - - my $numres = 0; - my %tmp_results; - # fgrep is seriously faster than using perl - open DESC, '-|', 'fgrep', '-n', '--', $keyword, $file - or die "couldn't open $file: $!"; - while () { - /^(\d+)/; - my $nr = $1; - debug( "Matched line $_", 2) if DEBUG; - my $result = $did2pkg->{$nr}; + my $stemmer = Lingua::Stem->new(); + my $stemmed_keywords = $stemmer->stem( @tmp ); + + my $db = Search::Xapian::Database->new( $db ); + 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]", 3) if DEBUG; + 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; - $numres++ unless $tmp_results{$data[0]}++; + unless ($tmp_results{$data[0]}++) { + push @order, $data[0]; + } } - last if $numres > 100; + last if @order > 100; } - close DESC; - $too_many_hits++ if $numres > 100; + undef $db; + $too_many_hits++ if @order > 100; - my @results; - foreach my $pkg (keys %tmp_results) { + debug ("ORDER: @order", 2) if DEBUG; + foreach my $pkg (@order) { &$read_entry( $packages, $pkg, $results, $non_results, $opts ); } - } +} + +sub find_similar { + my ($pkg, $db, $did2pkg) = @_; + + my $db = Search::Xapian::Database->new( $db ); + 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(); + + my @terms; + my $term_it = $first_match->termlist_begin(); + my $term_end = $first_match->termlist_end(); + + for ($term_it; $term_it ne $term_end; $term_it++) { + debug( "TERM: ".$term_it->get_termname(), 3); + push @terms, $term_it->get_termname(); + } + + 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); + + use Data::Dumper; + debug(Dumper(\@rel_pkg),1); + + my (@order, %tmp_results); + foreach my $match ( @rel_pkg ) { + 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 if $data[0] eq $pkg; + unless ($tmp_results{$data[0]}++) { + push @order, $data[0]; + } + } + } + undef $db; + + debug ("ORDER: @order", 2) if DEBUG; + return @order[0..10]; +} sub find_binaries { my ($pkg, $archive, $suite, $src2bin) = @_;