X-Git-Url: https://git.deb.at/?a=blobdiff_plain;f=cgi-bin%2Fsearch_packages.pl;h=2e141bb5e6f3374daedc6ba192a9850a759e0717;hb=186b663bf3f69e02137d247021400e5a3f90d666;hp=e22b8bd4bc812eba9bcd6bd2132c163181719d68;hpb=1d3541d031fd7eadfb034dc2ac6a644d3dddb7a8;p=deb%2Fpackages.git diff --git a/cgi-bin/search_packages.pl b/cgi-bin/search_packages.pl index e22b8bd..2e141bb 100755 --- a/cgi-bin/search_packages.pl +++ b/cgi-bin/search_packages.pl @@ -26,12 +26,11 @@ use Deb::Versions; use Packages::Search qw( :all ); use Packages::HTML (); -my $thisscript = "search_packages.pl"; +my $thisscript = $Packages::HTML::SEARCH_CGI; my $HOME = "http://www.debian.org"; my $ROOT = ""; my $SEARCHPAGE = "http://packages.debian.org/"; my @SUITES = qw( oldstable stable testing unstable experimental ); -my @DISTS = @SUITES; my @SECTIONS = qw( main contrib non-free ); my @ARCHIVES = qw( us security installer ); my @ARCHITECTURES = qw( alpha amd64 arm hppa hurd-i386 i386 ia64 @@ -44,12 +43,18 @@ my %ARCHITECTURES = map { $_ => 1 } @ARCHITECTURES; $ENV{PATH} = "/bin:/usr/bin"; # Read in all the variables set by the form -my $input = new CGI; +my $input; +if ($ARGV[0] && ($ARGV[0] eq 'php')) { + $input = new CGI(\*STDIN); +} else { + $input = new CGI; +} my $pet0 = new Benchmark; # use this to disable debugging in production mode completly my $debug_allowed = 1; my $debug = $debug_allowed && $input->param("debug"); +$debug = 0 if not defined($debug); $Search::Param::debug = 1 if $debug > 1; # If you want, just print out a list of all of the variables and exit. @@ -125,6 +130,7 @@ my @sections = @{$params{values}{section}{final}}; my @archs = @{$params{values}{arch}{final}}; my $page = $params{values}{page}{final}; my $results_per_page = $params{values}{number}{final}; +my %opts = ( case_bool => $case_bool, exact => $exact ); # for URL construction my $suites_param = join ',', @{$params{values}{suite}{no_replace}}; @@ -177,6 +183,7 @@ my $search_on_sources = 0; my $st0 = new Benchmark; my @results; +my $too_many_hits; if ($searchon eq 'sourcenames') { $search_on_sources = 1; } @@ -185,54 +192,142 @@ 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; - -if ($searchon eq 'names') { +print "DEBUG: suites=@suites, sections=@sections, archs=@archs
" + if $debug > 2; + +sub read_entry { + my ($hash, $key, $results) = @_; + 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]}) { + 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}; + + 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]}) { + print "DEBUG: Using entry ".join( ':', @data)."
" if $debug > 2; + push @$results, [ $key, @data ]; + } + } +} +sub do_names_search { + my ($keyword, $file, $postfix_file, $read_entry, $opts) = @_; + my @results; - $keyword = lc $keyword unless $case_bool; + $keyword = lc $keyword unless $opts->{case_bool}; - my $obj = tie my %packages, 'DB_File', "$DBDIR/packages_small.db", O_RDONLY, 0666, $DB_BTREE - or die "couldn't tie DB $DBDIR/packages_small.db: $!"; + my $obj = tie my %packages, 'DB_File', "$DBDIR/$file", O_RDONLY, 0666, $DB_BTREE + or die "couldn't tie DB $DBDIR/$file: $!"; - if ($exact) { - my $result = $packages{$keyword}; - foreach (split /\000/, $result) { - my @data = split ( /\s/, $_, 6 ); - #FIXME, should be done on db generation - if ($data[2] =~ m,/,) { - $data[2] =~ s,/.*$,,; - } else { - $data[2] = 'main'; - } - print "DEBUG: Considering entry ".join( ':', @data)."
" if $debug > 2; - if ($suites{$data[0]} && ($archs{$data[1]} || $data[1] eq 'all') - && $sections{$data[2]}) { - print "DEBUG: Using entry ".join( ':', @data)."
" if $debug > 2; - push @results, [ $keyword, @data ]; - } - } + if ($opts->{exact}) { + &$read_entry( \%packages, $keyword, \@results ); } else { - while (my ($pkg, $result) = each %packages) { - #what's faster? I can't really see a difference - (index($pkg, $keyword) >= 0) or next; - #$pkg =~ /\Q$keyword\E/ or next; - foreach (split /\000/, $packages{$pkg}) { - my @data = split ( /\s/, $_, 6 ); - #FIXME, should be done on db generation - if ($data[2] =~ m,/,) { - $data[2] =~ s,/.*$,,; - } else { - $data[2] = 'main'; - } - print "DEBUG: Considering entry ".join( ':', @data)."
" if $debug > 2; - if ($suites{$data[0]} && ($archs{$data[1]} || $data[1] eq 'all') - && $sections{$data[2]}) { - print "DEBUG: Using entry ".join( ':', @data)."
" if $debug > 2; - push @results, [ $pkg , @data ]; + my ($key, $prefixes) = ($keyword, ''); + my %pkgs; + my $p_obj = tie my %pref, 'DB_File', "$DBDIR/$postfix_file", O_RDONLY, 0666, $DB_BTREE + or die "couldn't tie postfix db $DBDIR/$postfix_file: $!"; + $p_obj->seq( $key, $prefixes, R_CURSOR ); + while (index($key, $keyword) >= 0) { + if ($prefixes =~ /^\001(\d+)/o) { + $too_many_hits += $1; + } else { + foreach (split /\000/o, $prefixes) { + $_ = '' if $_ eq '^'; + print "DEBUG: add word $_$key
" if $debug > 2; + $pkgs{$_.$key}++; } } + last if $p_obj->seq( $key, $prefixes, R_NEXT ) != 0; + last if $too_many_hits or keys %pkgs >= 100; + } + + my $no_results = keys %pkgs; + if ($too_many_hits || ($no_results >= 100)) { + $too_many_hits += $no_results; + %pkgs = ( $keyword => 1 ); + } + foreach my $pkg (sort keys %pkgs) { + &$read_entry( \%packages, $pkg, \@results ); } } + return \@results; +} +sub do_fulltext_search { + my ($keword, $file, $mapping, $lookup, $read_entry, $opts) = @_; + my @results; + + my @lines; + my $regex; + if ($opts->{case_bool}) { + if ($opts->{exact}) { + $regex = qr/\b\Q$keyword\E\b/o; + } else { + $regex = qr/\Q$keyword\E/o; + } + } else { + if ($exact) { + $regex = qr/\b\Q$keyword\E\b/io; + } else { + $regex = qr/\Q$keyword\E/io; + } + } + + open DESC, '<', "$DBDIR/$file" + or die "couldn't open $DBDIR/$file: $!"; + while () { + $_ =~ $regex or next; + print "DEBUG: Matched line $.
" if $debug > 2; + push @lines, $.; + } + close DESC; + + tie my %packages, 'DB_File', "$DBDIR/$lookup", O_RDONLY, 0666, $DB_BTREE + or die "couldn't tie DB $DBDIR/$lookup: $!"; + tie my %did2pkg, 'DB_File', "$DBDIR/$mapping", O_RDONLY, 0666, $DB_BTREE + or die "couldn't tie DB $DBDIR/$mapping: $!"; + + my %tmp_results; + foreach my $l (@lines) { + my $result = $did2pkg{$l}; + foreach (split /\000/o, $result) { + my @data = split /\s/, $_, 3; + next unless $archs{$data[2]}; + $tmp_results{$data[0]}++; + } + } + foreach my $pkg (keys %tmp_results) { + &$read_entry( \%packages, $pkg, \@results ); + } + return \@results; +} + +if ($searchon eq 'names') { + push @results, @{ do_names_search( $keyword, 'packages_small.db', + 'package_postfixes.db', + \&read_entry, \%opts ) }; +} elsif ($searchon eq 'sourcenames') { + push @results, @{ do_names_search( $keyword, 'sources_small.db', + 'source_postfixes.db', + \&read_src_entry, \%opts ) }; +} else { + push @results, @{ do_names_search( $keyword, 'packages_small.db', + 'package_postfixes.db', + \&read_entry, \%opts ) }; + push @results, @{ do_fulltext_search( $keyword, 'descriptions.txt', + 'descriptions_packages.db', + 'packages_small.db', + \&read_entry, \%opts ) }; } my $st1 = new Benchmark; @@ -256,6 +351,10 @@ if ($format eq 'html') { } } +if ($too_many_hits) { +print "

Your search was too wide so we will only display exact matches. At least $too_many_hits results have been omitted and will not be displayed. Please consider using a longer keyword or more keywords.

"; +} + if (!@results) { if ($format eq 'html') { my $keyword_esc = uri_escape( $keyword ); @@ -300,11 +399,12 @@ my (%pkgs, %sect, %part, %desc, %binaries); unless ($search_on_sources) { foreach (@results) { - my ($pkg_t, $suite, $arch, $section, $priority, $version, $desc) = @$_; + my ($pkg_t, $suite, $arch, $section, $subsection, + $priority, $version, $desc) = @$_; my ($package) = $pkg_t =~ m/^(.+)/; # untaint $pkgs{$package}{$suite}{$version}{$arch} = 1; - $sect{$package}{$suite}{$version} = 'subsection'; + $sect{$package}{$suite}{$version} = $subsection; $part{$package}{$suite}{$version} = $section unless $section eq 'main'; $desc{$package}{$suite}{$version} = $desc; @@ -345,7 +445,7 @@ unless ($search_on_sources) { $rdf->addns( debpkg => 'http://packages.debian.org/xml/01-debian-packages-rdf' ); my @triples; foreach my $pkg (sort keys %pkgs) { - foreach my $ver (@DISTS) { + foreach my $ver (@SUITES) { if (exists $pkgs{$pkg}{$ver}) { my @versions = version_sort keys %{$pkgs{$pkg}{$ver}}; foreach my $version (@versions) { @@ -368,14 +468,14 @@ unless ($search_on_sources) { } } else { foreach (@results) { - my ($package, $suite, $section, $version, $binaries); + my ($package, $suite, $section, $subsection, $priority, + $version, $binaries) = @$_; $pkgs{$package}{$suite} = $version; - $sect{$package}{$suite}{source} = 'subsection'; + $sect{$package}{$suite}{source} = $subsection; $part{$package}{$suite}{source} = $section unless $section eq 'main'; $binaries{$package}{$suite} = [ sort split( /\s*,\s*/, $binaries ) ]; - } if ($format eq 'html') { @@ -398,12 +498,12 @@ unless ($search_on_sources) { print "
Binary packages: "; my @bp_links; foreach my $bp (@{$binaries{$pkg}{$ver}}) { - my $sect = find_section($bp, $ver, $part{$pkg}{$ver}{source}||'main') || ''; - $sect =~ s,^(non-free|contrib)/,,; - $sect =~ s,^non-US.*$,non-US,,; + my $sect = 'section'; + my $bp_link; if ($sect) { - $bp_link = sprintf "%s", $ver, $sect, uri_escape( $bp ), $bp; + $bp_link = sprintf( "%s", + $ver, $sect, uri_escape( $bp ), $bp ); } else { $bp_link = $bp; } @@ -454,7 +554,9 @@ sub printindexline { my $index_line; if ($no_results > $results_per_page) { - $index_line = prevlink($input,\%params)." | ".indexline( $input, \%params, $no_results)." | ".nextlink($input,\%params, $no_results); + $index_line = prevlink($input,\%params)." | ". + indexline( $input, \%params, $no_results)." | ". + nextlink($input,\%params, $no_results); print "

$index_line

"; } @@ -513,5 +615,11 @@ print < END +my $pete = new Benchmark; +my $petd = timediff($pete, $pet0); +print "Total page evaluation took ".timestr($petd)."
" + if $debug_allowed; print $input->end_html; } + +# vim: ts=8 sw=4