X-Git-Url: https://git.deb.at/?a=blobdiff_plain;ds=sidebyside;f=cgi-bin%2Fsearch_packages.pl;h=e5cf44d15d4b2bd44a517fd0bc7a29a09a22dc2f;hb=08852aab550de858d4e4956ea357dbc3ae713a26;hp=1912dac8ed41fb5044fd68420e4aa51b355152d2;hpb=c049f68b67a8ffdce5280f39f96b38abf005641d;p=deb%2Fpackages.git
diff --git a/cgi-bin/search_packages.pl b/cgi-bin/search_packages.pl
index 1912dac..e5cf44d 100755
--- a/cgi-bin/search_packages.pl
+++ b/cgi-bin/search_packages.pl
@@ -1,5 +1,5 @@
#!/usr/bin/perl -wT
-#
+# $Id$
# search_packages.pl -- CGI interface to the Packages files on packages.debian.org
#
# Copyright (C) 1998 James Treacy
@@ -20,46 +20,72 @@ use HTML::Entities;
use DB_File;
use Benchmark;
-use lib "../lib";
-
use Deb::Versions;
+use Packages::CGI;
use Packages::Search qw( :all );
use Packages::HTML ();
-my $thisscript = "search_packages.pl";
-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
- kfreebsd-i386 mips mipsel powerpc s390 sparc );
-my %SUITES = map { $_ => 1 } @SUITES;
-my %SECTIONS = map { $_ => 1 } @SECTIONS;
-my %ARCHIVES = map { $_ => 1 } @ARCHIVES;
-my %ARCHITECTURES = map { $_ => 1 } @ARCHITECTURES;
+&Packages::CGI::reset;
$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;
+my $tet0 = new Benchmark;
# use this to disable debugging in production mode completly
my $debug_allowed = 1;
my $debug = $debug_allowed && $input->param("debug");
-$Search::Param::debug = 1 if $debug > 1;
+$debug = 0 if !defined($debug) || $debug !~ /^\d+$/o;
+$Packages::CGI::debug = $debug;
-# If you want, just print out a list of all of the variables and exit.
-print $input->header if $debug;
-# print $input->dump;
-# exit;
+# read the configuration
+our $config_read_time ||= 0;
+our $db_read_time ||= 0;
+our ( $topdir, $ROOT, @SUITES, @SECTIONS, @ARCHIVES, @ARCHITECTURES );
+
+# FIXME: move to own module
+my $modtime = (stat( "../config.sh" ))[9];
+if ($modtime > $config_read_time) {
+ if (!open (C, '<', "../config.sh")) {
+ error( "Internal: Cannot open configuration file." );
+ }
+ while ( You have searched for ${source_wording}packages $exact_wording $keyword_enc in $suite_wording, $section_wording, and $arch_wording. You have searched for $keyword_enc in packages names and descriptions in $suite_wording, $section_wording, and $arch_wording$exact_wording. Can't find that package. Can't find that package, at least not in that suite ".
- ( $search_on_sources ? "" : " and on that architecture" ).
- ". You have searched only for exact matches of the package name. You can try to search for package names that contain your search string. Can't find that string. Can't find that string, at least not in that suite ($suites_enc, section $sections_enc) and on that architecture ($archs_enc). You have searched only for words exactly matching your keywords. You can try to search allowing subword matching. ".( $printed ? "Or you" : "You" )." can try a different search on the Packages search page. $index_line Found $no_results matching packages,";
- if ($end == $start) {
- print " displaying package $end.
" if $debug;
-
-if ($format eq 'html') {
-print Packages::HTML::header( title => 'Package Search Results' ,
- lang => 'en',
- title_tag => 'Debian Package Search Results',
- print_title_above => 1,
- print_search_field => 'packages',
- search_field_values => {
- keywords => $keyword_enc,
- searchon => $searchon,
- arch => $archs_enc,
- suite => $suites_enc,
- section => $sections_enc,
- subword => $subword,
- exact => $exact,
- case => $case,
- },
- );
-}
-
-# read the configuration
-my $topdir;
-if (!open (C, "../config.sh")) {
- print "\nInternal Error: Cannot open configuration file.\n\n"
-if $format eq 'html';
- exit 0;
-}
-while (
" if $debug > 2;
-
-if ($searchon eq 'names') {
-
- $keyword = lc $keyword unless $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: $!";
-
- if ($exact) {
- my $result = $packages{$keyword};
- 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, [ $keyword, @data ];
- }
- }
+our ($obj, $s_obj, $p_obj, $sp_obj,
+ %packages, %sources, %postf, %spostf, %src2bin, %did2pkg );
+
+unless (@Packages::CGI::fatal_errors) {
+
+ my $dbmodtime = (stat("$DBDIR/packages_small.db"))[9];
+ if ($dbmodtime > $db_read_time) {
+ $obj = tie %packages, 'DB_File', "$DBDIR/packages_small.db",
+ O_RDONLY, 0666, $DB_BTREE
+ or die "couldn't tie DB $DBDIR/packages_small.db: $!";
+ $s_obj = tie %sources, 'DB_File', "$DBDIR/sources_small.db",
+ O_RDONLY, 0666, $DB_BTREE
+ or die "couldn't tie DB $DBDIR/sources_small.db: $!";
+ $p_obj = tie %postf, 'DB_File', "$DBDIR/package_postfixes.db",
+ O_RDONLY, 0666, $DB_BTREE
+ or die "couldn't tie postfix db $DBDIR/package_postfixes.db: $!";
+ $sp_obj = tie %spostf, 'DB_File', "$DBDIR/source_postfixes.db",
+ O_RDONLY, 0666, $DB_BTREE
+ or die "couldn't tie postfix db $DBDIR/source_postfixes.db: $!";
+ tie %src2bin, 'DB_File', "$DBDIR/sources_packages.db",
+ O_RDONLY, 0666, $DB_BTREE
+ or die "couldn't open $DBDIR/sources_packages.db: $!";
+ tie %did2pkg, 'DB_File', "$DBDIR/descriptions_packages.db",
+ O_RDONLY, 0666, $DB_BTREE
+ or die "couldn't tie DB $DBDIR/descriptions_packages.db: $!";
+
+ debug( "tied databases ($dbmodtime > $db_read_time)" );
+ $db_read_time = $dbmodtime;
+ }
+
+ if ($searchon eq 'names') {
+ push @results, @{ do_names_search( $keyword, \%packages,
+ $p_obj,
+ \&read_entry, \%opts ) };
+ } elsif ($searchon eq 'sourcenames') {
+ push @results, @{ do_names_search( $keyword, \%sources,
+ $sp_obj,
+ \&read_src_entry, \%opts ) };
} 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/, $_, 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, [ $pkg , @data ];
- }
- }
- }
+ push @results, @{ do_names_search( $keyword, \%packages,
+ $p_obj,
+ \&read_entry, \%opts ) };
+ push @results, @{ do_fulltext_search( $keyword, "$DBDIR/descriptions.txt",
+ \%did2pkg,
+ \%packages,
+ \&read_entry, \%opts ) };
}
}
my $st1 = new Benchmark;
my $std = timediff($st1, $st0);
-print "DEBUG: Search took ".timestr($std)."
" if $debug;
+debug( "Search took ".timestr($std) );
if ($format eq 'html') {
my $suite_wording = $suites_enc eq "all" ? "all suites"
@@ -235,16 +232,20 @@ if ($format eq 'html') {
my $arch_wording = $archs_enc eq 'any' ? "all architectures"
: "architecture(s) $archs_enc";
if (($searchon eq "names") || ($searchon eq 'sourcenames')) {
- my $source_wording = $search_on_sources ? "source " : "";
+ my $source_wording = ( $searchon eq 'sourcenames' ) ? "source " : "";
my $exact_wording = $exact ? "named" : "that names contain";
- print "Package %s
\n", $pkg;
- print "\n";
- foreach my $ver (@SUITES) {
- if (exists $pkgs{$pkg}{$ver}) {
- my @versions = version_sort keys %{$pkgs{$pkg}{$ver}};
- my $part_str = "";
- if ($part{$pkg}{$ver}{$versions[0]}) {
- $part_str = "[$part{$pkg}{$ver}{$versions[0]}]";
- }
- printf "
\n";
- }
- } elsif ($format eq 'xml') {
- require RDF::Simple::Serialiser;
- my $rdf = new RDF::Simple::Serialiser;
- $rdf->addns( debpkg => 'http://packages.debian.org/xml/01-debian-packages-rdf' );
- my @triples;
- foreach my $pkg (sort keys %pkgs) {
- foreach my $ver (@DISTS) {
- if (exists $pkgs{$pkg}{$ver}) {
- my @versions = version_sort keys %{$pkgs{$pkg}{$ver}};
- foreach my $version (@versions) {
- my $id = "$ROOT/$ver/$sect{$pkg}{$ver}{$version}/$pkg/$version";
- push @triples, [ $id, 'debpkg:package', $pkg ];
- push @triples, [ $id, 'debpkg:version', $version ];
- push @triples, [ $id, 'debpkg:section', $sect{$pkg}{$ver}{$version}, ];
- push @triples, [ $id, 'debpkg:suite', $ver ];
- push @triples, [ $id, 'debpkg:shortdesc', $desc{$pkg}{$ver}{$version} ];
- push @triples, [ $id, 'debpkg:part', $part{$pkg}{$ver}{$version} || 'main' ];
- foreach my $arch (sort keys %{$pkgs{$pkg}{$ver}{$version}}) {
- push @triples, [ $id, 'debpkg:architecture', $arch ];
+ foreach my $pkg (sort keys %pkgs) {
+ $count++;
+ next if $count < $start or $count > $end;
+ printf "
%s: %s\n",
- $v, join (" ", (sort keys %{$pkgs{$pkg}{$ver}{$v}}) );
- }
- print "Package %s
\n", $pkg;
+ print "\n";
+ foreach my $suite (@SUITES) {
+ foreach my $archive (@ARCHIVES) {
+ if (exists $pkgs{$pkg}{$suite}{$archive}) {
+ my @versions = version_sort keys %{$pkgs{$pkg}{$suite}{$archive}};
+ my $origin_str = "";
+ if ($sect{$pkg}{$suite}{$archive}{$versions[0]}) {
+ $origin_str .= " [$sect{$pkg}{$suite}{$versions[0]}]";
+ }
+ printf "
\n";
}
}
+ } else {
+ foreach (@results) {
+ my ($pkg, $archive, $suite, $section, $subsection, $priority,
+ $version) = @$_;
- print $rdf->serialise(@triples);
- }
-} else {
- foreach (@results) {
- my ($package, $suite, $section, $version, $binaries);
-
- $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 ) ];
+ $pkgs{$pkg}{$suite}{$archive} = $version;
+ $subsect{$pkg}{$suite}{$archive}{source} = $subsection;
+ $sect{$pkg}{$suite}{$archive}{source} = $section
+ unless $section eq 'main';
- }
+ $binaries{$pkg}{$suite}{$archive} = find_binaries( $pkg, $archive, $suite, \%src2bin );
+ }
- if ($format eq 'html') {
- my ($start, $end) = multipageheader( scalar keys %pkgs );
- my $count = 0;
-
- foreach my $pkg (sort keys %pkgs) {
- $count++;
- next if ($count < $start) or ($count > $end);
- printf "
%s: %s\n",
+ $v, join (" ", (sort keys %{$pkgs{$pkg}{$suite}{$archive}{$v}}) );
+ }
+ print "Source package %s
\n", $pkg;
- print "\n";
- foreach my $ver (@SUITES) {
- if (exists $pkgs{$pkg}{$ver}) {
- my $part_str = "";
- if ($part{$pkg}{$ver}{source}) {
- $part_str = "[$part{$pkg}{$ver}{source}]";
- }
- printf "
\n";
- }
- } elsif ($format eq 'xml') {
- require RDF::Simple::Serialiser;
- my $rdf = new RDF::Simple::Serialiser;
- $rdf->addns( debpkg => 'http://packages.debian.org/xml/01-debian-packages-rdf' );
- my @triples;
- foreach my $pkg (sort keys %pkgs) {
- foreach my $ver (@SUITES) {
- if (exists $pkgs{$pkg}{$ver}) {
- my $id = "$ROOT/$ver/source/$pkg";
-
- push @triples, [ $id, 'debpkg:package', $pkg ];
- push @triples, [ $id, 'debpkg:type', 'source' ];
- push @triples, [ $id, 'debpkg:section', $sect{$pkg}{$ver}{source} ];
- push @triples, [ $id, 'debpkg:version', $pkgs{$pkg}{$ver} ];
- push @triples, [ $id, 'debpkg:part', $part{$pkg}{$ver}{source} || 'main' ];
-
- foreach my $bp (@{$binaries{$pkg}{$ver}}) {
- push @triples, [ $id, 'debpkg:binary', $bp ];
}
}
+ print "\n";
}
}
- print $rdf->serialise(@triples);
- }
-}
-
-if ($format eq 'html') {
- &printindexline( scalar keys %pkgs );
- &printfooter;
-}
-
-exit;
-
-sub printindexline {
- my $no_results = shift;
-
- my $index_line;
- if ($no_results > $results_per_page) {
-
- $index_line = prevlink($input,\%params)." | ".indexline( $input, \%params, $no_results)." | ".nextlink($input,\%params, $no_results);
-
- 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 $bp_link;
- if ($sect) {
- $bp_link = sprintf "%s", $ver, $sect, uri_escape( $bp ), $bp;
- } else {
- $bp_link = $bp;
+ if ($opts{format} eq 'html') {
+ my ($start, $end) = multipageheader( $input, scalar keys %pkgs, \%opts );
+ my $count = 0;
+
+ foreach my $pkg (sort keys %pkgs) {
+ $count++;
+ next if ($count < $start) or ($count > $end);
+ printf "Source package %s
\n", $pkg;
+ print "\n";
+ foreach my $suite (@SUITES) {
+ foreach my $archive (@ARCHIVES) {
+ if (exists $pkgs{$pkg}{$suite}{$archive}) {
+ my $origin_str = "";
+ if ($sect{$pkg}{$suite}{$archive}{source}) {
+ $origin_str .= " [$sect{$pkg}{$suite}{$archive}{source}]";
+ }
+ printf( "
Binary packages: ";
+ my @bp_links;
+ foreach my $bp (@{$binaries{$pkg}{$suite}{$archive}}) {
+ my $bp_link = sprintf( "%s",
+ $suite.(($archive ne 'us')?"/$archive":''), uri_escape( $bp ), $bp );
+ push @bp_links, $bp_link;
+ }
+ print join( ", ", @bp_links );
+ print "
Results per page: "; - my @resperpagelinks; - for (50, 100, 200) { - if ($results_per_page == $_) { - push @resperpagelinks, $_; - } else { - push @resperpagelinks, resperpagelink($input,\%params,$_); - } - } - if ($params{values}{number}{final} =~ /^all$/i) { - push @resperpagelinks, "all"; - } else { - push @resperpagelinks, resperpagelink($input, \%params,"all"); - } - print join( " | ", @resperpagelinks )."
"; } - return ( $start, $end ); + printindexline( $input, scalar keys %pkgs, \%opts ); } +#print_results(\@results, \%opts) if @results;; +my $tet1 = new Benchmark; +my $tetd = timediff($tet1, $tet0); +print "Total page evaluation took ".timestr($tetd)."