# see http://www.fsf.org/copyleft/gpl.html for a copy of the license
use strict;
+use lib '../lib';
use CGI qw( -oldstyle_urls );
use CGI::Carp qw( fatalsToBrowser );
use POSIX;
use Benchmark;
use Deb::Versions;
+use Packages::Config qw( $DBDIR $ROOT $SEARCH_CGI $SEARCH_PAGE
+ @SUITES @SECTIONS @ARCHIVES @ARCHITECTURES );
use Packages::CGI;
+use Packages::DB;
use Packages::Search qw( :all );
use Packages::HTML ();
$debug = 0 if !defined($debug) || $debug !~ /^\d+$/o;
$Packages::CGI::debug = $debug;
-# 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 (<C>) {
- next if /^\s*\#/o;
- chomp;
- $topdir = $1 if /^\s*topdir="?([^\"]*)"?\s*$/o;
- $ROOT = $1 if /^\s*root="?([^\"]*)"?\s*$/o;
- $Packages::HTML::HOME = $1 if /^\s*home="?([^\"]*)"?\s*$/o;
- $Packages::HTML::SEARCH_CGI = $1 if /^\s*searchcgi="?([^\"]*)"?\s*$/o;
- $Packages::HTML::SEARCH_PAGE = $1 if /^\s*searchpage="?([^\"]*)"?\s*$/o;
- $Packages::HTML::WEBMASTER_MAIL = $1 if /^\s*webmaster="?([^\"]*)"?\s*$/o;
- $Packages::HTML::CONTACT_MAIL = $1 if /^\s*contact="?([^\"]*)"?\s*$/o;
- @SUITES = split(/\s+/, $1) if /^\s*suites="?([^\"]*)"?\s*$/o;
- @SECTIONS = split(/\s+/, $1) if /^\s*sections="?([^\"]*)"?\s*$/o;
- @ARCHIVES = split(/\s+/, $1) if /^\s*archives="?([^\"]*)"?\s*$/o;
- @ARCHITECTURES = split(/\s+/, $1) if /^\s*architectures="?([^\"]*)"?\s*$/o;
- }
- close (C);
- debug( "read config ($modtime > $config_read_time)" );
- $config_read_time = $modtime;
-}
-my $DBDIR = $topdir . "/files/db";
-my $thisscript = $Packages::HTML::SEARCH_CGI;
+&Packages::Config::init( '../' );
+&Packages::DB::init();
if (my $path = $input->param('path')) {
my @components = map { lc $_ } split /\//, $path;
$input->param('archive', $_);
} elsif ($ARCHITECTURES{$_}) {
$input->param('arch', $_);
+ } elsif ($_ eq 'source') {
+ $input->param('searchon','sourcenames');
}
}
}
#XXX: Don't use alternative output formats yet
$format = 'html';
if ($format eq 'html') {
- print $input->header;
+ print $input->header( -charset => 'utf-8' );
}
if ($params{errors}{keywords}) {
my $st0 = new Benchmark;
my @results;
-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,
push @results, @{ do_names_search( $keyword, \%sources,
$sp_obj,
\&read_src_entry, \%opts ) };
+ } elsif ($searchon eq 'contents') {
+ require "./search_contents.pl";
+ &contents(\$input);
+ exit;
} else {
push @results, @{ do_names_search( $keyword, \%packages,
$p_obj,
if ($exact) {
$printed++;
- hint( "You have searched only for exact matches of the package name. You can try to search for <a href=\"$thisscript?exact=0&searchon=$searchon&suite=$suites_param&case=$case&section=$sections_param&keywords=$keyword_esc&arch=$archs_param\">package names that contain your search string</a>." );
+ hint( "You have searched only for exact matches of the package name. You can try to search for <a href=\"$SEARCH_CGI?exact=0&searchon=$searchon&suite=$suites_param&case=$case&section=$sections_param&keywords=$keyword_esc&arch=$archs_param\">package names that contain your search string</a>." );
}
} else {
if (($suites_enc eq 'all')
unless ($subword) {
$printed++;
- hint( "You have searched only for words exactly matching your keywords. You can try to search <a href=\"$thisscript?subword=1&searchon=$searchon&suite=$suites_param&case=$case&section=$sections_param&keywords=$keyword_esc&arch=$archs_param\">allowing subword matching</a>." );
+ hint( "You have searched only for words exactly matching your keywords. You can try to search <a href=\"$SEARCH_CGI?subword=1&searchon=$searchon&suite=$suites_param&case=$case&section=$sections_param&keywords=$keyword_esc&arch=$archs_param\">allowing subword matching</a>." );
}
}
- hint( ( $printed ? "Or you" : "You" )." can try a different search on the <a href=\"$Packages::HTML::SEARCH_PAGE#search_packages\">Packages search page</a>." );
+ hint( ( $printed ? "Or you" : "You" )." can try a different search on the <a href=\"$SEARCH_PAGE#search_packages\">Packages search page</a>." );
}
}
print_hints();
print_debug();
if (@results) {
- my (%pkgs, %subsect, %sect, %desc, %binaries);
+ my (%pkgs, %subsect, %sect, %desc, %binaries, %provided_by);
unless ($opts{searchon} eq 'sourcenames') {
foreach (@results) {
$priority, $version, $desc) = @$_;
my ($pkg) = $pkg_t =~ m/^(.+)/; # untaint
- $pkgs{$pkg}{$suite}{$archive}{$version}{$arch} = 1;
- $subsect{$pkg}{$suite}{$archive}{$version} = $subsection;
- $sect{$pkg}{$suite}{$archive}{$version} = $section
- unless $section eq 'main';
-
- $desc{$pkg}{$suite}{$archive}{$version} = $desc;
+ if ($arch ne 'virtual') {
+ $pkgs{$pkg}{$suite}{$archive}{$version}{$arch} = 1;
+ $subsect{$pkg}{$suite}{$archive}{$version} = $subsection;
+ $sect{$pkg}{$suite}{$archive}{$version} = $section
+ unless $section eq 'main';
+
+ $desc{$pkg}{$suite}{$archive}{$version} = $desc;
+ } else {
+ $provided_by{$pkg}{$suite}{$archive} = [ split /\s+/, $desc ];
+ }
}
+my @pkgs = sort(keys %pkgs, keys %provided_by);
if ($opts{format} eq 'html') {
- my ($start, $end) = multipageheader( $input, scalar keys %pkgs, \%opts );
+ my ($start, $end) = multipageheader( $input, scalar @pkgs, \%opts );
my $count = 0;
- foreach my $pkg (sort keys %pkgs) {
+ foreach my $pkg (@pkgs) {
$count++;
next if $count < $start or $count > $end;
printf "<h3>Package %s</h3>\n", $pkg;
print "<ul>\n";
foreach my $suite (@SUITES) {
foreach my $archive (@ARCHIVES) {
+ my $path = $suite.(($archive ne 'us')?"/$archive":'');
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 .= " [<span style=\"color:red\">$sect{$pkg}{$suite}{$versions[0]}</span>]";
+ $origin_str .= " [<span style=\"color:red\">$sect{$pkg}{$suite}{$archive}{$versions[0]}</span>]";
}
printf "<li><a href=\"$ROOT/%s/%s\">%s</a> (%s): %s %s\n",
- $suite.(($archive ne 'us')?"/$archive":''), $pkg, $suite.(($archive ne 'us')?"/$archive":''), $subsect{$pkg}{$suite}{$archive}{$versions[0]},
+ $path, $pkg, $path, $subsect{$pkg}{$suite}{$archive}{$versions[0]},
$desc{$pkg}{$suite}{$archive}{$versions[0]}, $origin_str;
foreach my $v (@versions) {
printf "<br>%s: %s\n",
$v, join (" ", (sort keys %{$pkgs{$pkg}{$suite}{$archive}{$v}}) );
}
+ if (my $provided_by = $provided_by{$pkg}{$suite}{$archive}) {
+ print '<br>also provided by: ',
+ join( ', ', map { "<a href=\"$ROOT/$path/$_\">$_</a>" } @$provided_by);
+ }
print "</li>\n";
+ } elsif (my $provided_by = $provided_by{$pkg}{$suite}{$archive}) {
+ printf "<li><a href=\"$ROOT/%s/%s\">%s</a>: Virtual package<br>",
+ $path, $pkg, $path;
+ print 'provided by: ',
+ join( ', ', map { "<a href=\"$ROOT/$path/$_\">$_</a>" } @$provided_by);
}
}
}