# 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');
}
}
}
my ( $format, $keyword, $case, $subword, $exact, $searchon,
@suites, @sections, @archives, @archs );
-# my %params_def = ( keywords => { default => undef,
-# match => '^\s*([-+\@\w\/.:]+)\s*$',
-# var => \$keyword },
-# suite => { default => 'stable', match => '^([\w-]+)$',
-# alias => 'version', array => ',',
-# var => \@suites,
-# replace => { all => \@SUITES } },
-# archive => { default => 'all', match => '^([\w-]+)$',
-# array => ',', var => \@archives,
-# replace => { all => \@ARCHIVES } },
-# case => { default => 'insensitive', match => '^(\w+)$',
-# var => \$case },
-# official => { default => 0, match => '^(\w+)$' },
-# subword => { default => 0, match => '^(\w+)$',
-# var => \$subword },
-# exact => { default => undef, match => '^(\w+)$',
-# var => \$exact },
-# searchon => { default => 'all', match => '^(\w+)$',
-# var => \$searchon },
-# section => { default => 'all', match => '^([\w-]+)$',
-# alias => 'release', array => ',',
-# var => \@sections,
-# replace => { all => \@SECTIONS } },
-# arch => { default => 'any', match => '^(\w+)$',
-# array => ',', var => \@archs, replace =>
-# { any => \@ARCHITECTURES } },
-# format => { default => 'html', match => '^(\w+)$',
-# var => \$format },
-# );
+my %params_def = ( keywords => { default => undef,
+ match => '^\s*([-+\@\w\/.:]+)\s*$',
+ var => \$keyword },
+ suite => { default => 'stable', match => '^([\w-]+)$',
+ alias => 'version', array => ',',
+ var => \@suites,
+ replace => { all => \@SUITES } },
+ archive => { default => 'all', match => '^([\w-]+)$',
+ array => ',', var => \@archives,
+ replace => { all => \@ARCHIVES } },
+ case => { default => 'insensitive', match => '^(\w+)$',
+ var => \$case },
+ official => { default => 0, match => '^(\w+)$' },
+ subword => { default => 0, match => '^(\w+)$',
+ var => \$subword },
+ exact => { default => undef, match => '^(\w+)$',
+ var => \$exact },
+ searchon => { default => 'all', match => '^(\w+)$',
+ var => \$searchon },
+ section => { default => 'all', match => '^([\w-]+)$',
+ alias => 'release', array => ',',
+ var => \@sections,
+ replace => { all => \@SECTIONS } },
+ arch => { default => 'any', match => '^(\w+)$',
+ array => ',', var => \@archs, replace =>
+ { any => \@ARCHITECTURES } },
+ format => { default => 'html', match => '^(\w+)$',
+ var => \$format },
+ );
my %opts;
my %params = Packages::Search::parse_params( $input, \%params_def, \%opts );
#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);
} 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, %archives, %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') {
+ my $real_archive;
+ if ($archive =~ /^(security|non-US)$/) {
+ $real_archive = $archive;
+ $archive = 'us';
+ }
+
+ $pkgs{$pkg}{$suite}{$archive}{$version}{$arch} = 1;
+ $subsect{$pkg}{$suite}{$archive}{$version} = $subsection;
+ $sect{$pkg}{$suite}{$archive}{$version} = $section
+ unless $section eq 'main';
+ $archives{$pkg}{$suite}{$archive}{$version} = $real_archive
+ if $real_archive;
+
+ $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 $count = 0;
+ #my ($start, $end) = multipageheader( $input, scalar @pkgs, \%opts );
+ print "<p>Found <em>".(scalar @pkgs)."</em> matching packages,";
+ #my $count = 0;
- foreach my $pkg (sort keys %pkgs) {
- $count++;
- next if $count < $start or $count > $end;
+ 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) {
+ next if $archive eq 'security';
+ next if $archive eq 'non-US';
+ my $path = $suite.(($archive ne 'us')?"/$archive":'');
if (exists $pkgs{$pkg}{$suite}{$archive}) {
+ my %archs_printed;
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}}) );
+ my $archive_str = "";
+ if ($archives{$pkg}{$suite}{$archive}{$v}) {
+ $archive_str .= " [<span style=\"color:red\">$archives{$pkg}{$suite}{$archive}{$v}</span>]";
+ }
+
+ my @archs_to_print = grep { !$archs_printed{$_} } sort keys %{$pkgs{$pkg}{$suite}{$archive}{$v}};
+ printf "<br>%s$archive_str: %s\n",
+ $v, join (" ", @archs_to_print )
+ if @archs_to_print;
+ $archs_printed{$_}++ foreach @archs_to_print;
+ }
+ 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);
}
}
}
my ($pkg, $archive, $suite, $section, $subsection, $priority,
$version) = @$_;
+ my $real_archive = '';
+ if ($archive =~ /^(security|non-US)$/) {
+ $real_archive = $archive;
+ $archive = 'us';
+ }
+ if (($real_archive eq $archive) &&
+ $pkgs{$pkg}{$suite}{$archive} &&
+ (version_cmp( $pkgs{$pkg}{$suite}{$archive}, $version ) >= 0)) {
+ next;
+ }
$pkgs{$pkg}{$suite}{$archive} = $version;
$subsect{$pkg}{$suite}{$archive}{source} = $subsection;
$sect{$pkg}{$suite}{$archive}{source} = $section
unless $section eq 'main';
+ $archives{$pkg}{$suite}{$archive}{source} = $real_archive
+ if $real_archive;
$binaries{$pkg}{$suite}{$archive} = find_binaries( $pkg, $archive, $suite, \%src2bin );
}
if ($opts{format} eq 'html') {
- my ($start, $end) = multipageheader( $input, scalar keys %pkgs, \%opts );
- my $count = 0;
+ #my ($start, $end) = multipageheader( $input, scalar keys %pkgs, \%opts );
+ print "<p>Found <em>".(scalar keys %pkgs)."</em> matching packages,";
+ #my $count = 0;
foreach my $pkg (sort keys %pkgs) {
- $count++;
- next if ($count < $start) or ($count > $end);
+ #$count++;
+ #next if ($count < $start) or ($count > $end);
printf "<h3>Source package %s</h3>\n", $pkg;
print "<ul>\n";
foreach my $suite (@SUITES) {
if ($sect{$pkg}{$suite}{$archive}{source}) {
$origin_str .= " [<span style=\"color:red\">$sect{$pkg}{$suite}{$archive}{source}</span>]";
}
+ if ($archives{$pkg}{$suite}{$archive}{source}) {
+ $origin_str .= " [<span style=\"color:red\">$archives{$pkg}{$suite}{$archive}{source}</span>]";
+ }
printf( "<li><a href=\"$ROOT/%s/source/%s\">%s</a> (%s): %s %s",
$suite.(($archive ne 'us')?"/$archive":''), $pkg, $suite.(($archive ne 'us')?"/$archive":''), $subsect{$pkg}{$suite}{$archive}{source},
$pkgs{$pkg}{$suite}{$archive}, $origin_str );
}
}
}
- printindexline( $input, scalar keys %pkgs, \%opts );
+ #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($petd)."<br>"
+print "Total page evaluation took ".timestr($tetd)."<br>"
if $debug_allowed;
my $trailer = Packages::HTML::trailer( $ROOT );
projects / deb / packages.git / blobdiff