From f46c14dbc13274569f533b19e27c61960ea9bacd Mon Sep 17 00:00:00 2001
From: Frank Lichtenheld
Date: Tue, 7 Feb 2006 01:01:00 +0000
Subject: [PATCH] * Add source package display * Move most of the DB init code
to own module
---
bin/parse-sources | 19 +-
cgi-bin/search_packages.pl | 33 +--
cgi-bin/show_package.pl | 592 +++++++++++++++++++++++--------------
lib/Packages/DB.pm | 51 ++++
lib/Packages/HTML.pm | 154 +++++-----
lib/Packages/Page.pm | 7 +-
lib/Packages/Search.pm | 13 +-
lib/Packages/SrcPage.pm | 127 ++++++++
8 files changed, 656 insertions(+), 340 deletions(-)
create mode 100644 lib/Packages/DB.pm
create mode 100644 lib/Packages/SrcPage.pm
diff --git a/bin/parse-sources b/bin/parse-sources
index 9c97e2f..e640b9d 100755
--- a/bin/parse-sources
+++ b/bin/parse-sources
@@ -57,20 +57,29 @@ for my $archive (@ARCHIVES) {
$key =~ tr [A-Z] [a-z];
$data{$key} = $value;
}
- $data .= "Archive: $archive\n";
- $sources_all_db{"$data{'package'} $data{'version'}"}
- = $data;
-
$source_names{$data{'package'}} = 1;
my $section = 'main';
my $subsection = $data{section} || '-';
if ($data{section} && ($data{section} =~ m=/=o)) {
($section, $subsection) = split m=/=o, $data{section}, 2;
+ ($subsection, $section) = split m=/=o, $data{section}, 2
+ if $section eq 'non-US';
}
- $data{'priority'} = "-" if not exists($data{'priority'});
+ $data{'section'} = $section;
+ $data{'subsection'} = $subsection;
+ $data{'priority'} ||= "-";
$sources_small{$data{'package'}} .=
"$archive $suite $section $subsection $data{'priority'} $data{'version'}\000";
+
+ $data{archive} = $archive;
+ while (my ($key, $value) = each (%data)) {
+ next if $key eq 'package' or $key eq 'version';
+ print STDERR "WARN: $key ($suite/$archive/$data{package}/$data{architecture}\n" unless defined $value;
+ $data .= "$key: $value\n";
+ }
+ $sources_all_db{"$data{'package'} $data{'version'}"}
+ = $data;
}
untie %sources_all_db;
diff --git a/cgi-bin/search_packages.pl b/cgi-bin/search_packages.pl
index 5a31a1c..516d36d 100755
--- a/cgi-bin/search_packages.pl
+++ b/cgi-bin/search_packages.pl
@@ -25,6 +25,7 @@ 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 ();
@@ -48,10 +49,8 @@ my $debug = $debug_allowed && $input->param("debug");
$debug = 0 if !defined($debug) || $debug !~ /^\d+$/o;
$Packages::CGI::debug = $debug;
-# read the configuration
-our $db_read_time ||= 0;
-
&Packages::Config::init( '../' );
+&Packages::DB::init();
if (my $path = $input->param('path')) {
my @components = map { lc $_ } split /\//, $path;
@@ -148,36 +147,8 @@ debug( "Parameter evaluation took ".timestr($petd) );
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,
diff --git a/cgi-bin/show_package.pl b/cgi-bin/show_package.pl
index 1a29b39..0f3c48f 100755
--- a/cgi-bin/show_package.pl
+++ b/cgi-bin/show_package.pl
@@ -26,9 +26,11 @@ use Deb::Versions;
use Packages::Config qw( $DBDIR $ROOT @SUITES @ARCHIVES @SECTIONS
@ARCHITECTURES %FTP_SITES );
use Packages::CGI;
+use Packages::DB;
use Packages::Search qw( :all );
use Packages::HTML;
use Packages::Page ();
+use Packages::SrcPage ();
&Packages::CGI::reset;
@@ -50,10 +52,8 @@ my $debug = $debug_allowed && $input->param("debug");
$debug = 0 if !defined($debug) || $debug !~ /^\d+$/o;
$Packages::CGI::debug = $debug;
-# read the configuration
-our $db_read_time ||= 0;
-
&Packages::Config::init( '../' );
+&Packages::DB::init();
if (my $path = $input->param('path')) {
my @components = map { lc $_ } split /\//, $path;
@@ -72,6 +72,8 @@ if (my $path = $input->param('path')) {
$input->param('archive', $_);
} elsif ($ARCHITECTURES{$_}) {
$input->param('arch', $_);
+ } elsif ($_ eq 'source') {
+ $input->param('source', 1);
}
}
}
@@ -91,7 +93,8 @@ my %params_def = ( package => { default => undef, match => '^([a-z0-9.+-]+)$',
array => ',', var => \@archs,
replace => { any => \@ARCHITECTURES } },
format => { default => 'html', match => '^(\w+)$',
- var => \$format }
+ var => \$format },
+ source => { default => 0, match => '^(\d+)$' },
);
my %opts;
my %params = Packages::Search::parse_params( $input, \%params_def, \%opts );
@@ -119,9 +122,11 @@ $opts{h_archives} = { map { $_ => 1 } @archives };;
my $DL_URL = "$pkg/download";
my $FILELIST_URL = "$pkg/files";
-our (%packages, %packages_all, %sources_all, %descriptions);
+our (%packages_all, %sources_all);
my (@results, @non_results);
-my $page = new Packages::Page( $pkg );
+my $page = $opts{source} ?
+ new Packages::SrcPage( $pkg ) :
+ new Packages::Page( $pkg );
my $package_page = "";
my ($short_desc, $version, $archive, $section, $subsection) = ("")x5;
@@ -129,243 +134,402 @@ sub gettext { return $_[0]; };
my $st0 = new Benchmark;
unless (@Packages::CGI::fatal_errors) {
- my $dbmodtime = (stat("$DBDIR/packages_small.db"))[9];
tie %packages_all, 'DB_File', "$DBDIR/packages_all_$suite.db",
O_RDONLY, 0666, $DB_BTREE
or die "couldn't tie DB $DBDIR/packages_all_$suite.db: $!";
tie %sources_all, 'DB_File', "$DBDIR/sources_all_$suite.db",
O_RDONLY, 0666, $DB_BTREE
or die "couldn't tie DB $DBDIR/sources_all_$suite.db: $!";
- if ($dbmodtime > $db_read_time) {
- tie %packages, 'DB_File', "$DBDIR/packages_small.db",
- O_RDONLY, 0666, $DB_BTREE
- or die "couldn't tie DB $DBDIR/packages_small.db: $!";
- tie %descriptions, 'DB_File', "$DBDIR/descriptions.db",
- O_RDONLY, 0666, $DB_BTREE
- or die "couldn't tie DB $DBDIR/descriptions.db: $!";
-
- debug( "tied databases ($dbmodtime > $db_read_time)" );
- $db_read_time = $dbmodtime;
- }
- read_entry_all( \%packages, $pkg, \@results, \@non_results, \%opts );
+ unless ($opts{source}) {
+ read_entry_all( \%packages, $pkg, \@results, \@non_results, \%opts );
- unless (@results || @non_results ) {
- fatal_error( "No such package".
- "{insert link to search page with substring search}" );
- } else {
- unless (@results) {
- fatal_error( "Package not available in this suite" );
+ unless (@results || @non_results ) {
+ fatal_error( "No such package".
+ "{insert link to search page with substring search}" );
} else {
- for my $entry (@results) {
- debug( join(":", @$entry), 1 );
- my (undef, $archive, undef, $arch, $section, $subsection,
- $priority, $version) = @$entry;
-
- my $data = $packages_all{"$pkg $arch $version"};
- $page->merge_data($pkg, $version, $arch, $data) or debug( "Merging $pkg $arch $version FAILED", 2 );
- }
+ unless (@results) {
+ fatal_error( "Package not available in this suite" );
+ } else {
+ for my $entry (@results) {
+ debug( join(":", @$entry), 1 );
+ my (undef, $archive, undef, $arch, $section, $subsection,
+ $priority, $version) = @$entry;
+
+ my $data = $packages_all{"$pkg $arch $version"};
+ $page->merge_data($pkg, $version, $arch, $data) or debug( "Merging $pkg $arch $version FAILED", 2 );
+ }
- $version = $page->{newest};
- my $source = $page->get_newest( 'source' );
- my $source_version = $page->get_newest( 'source-version' )
- || $version;
- debug( "find source package: source=$source (=$source_version)", 1);
- my $src_data = $sources_all{"$source $source_version"};
- unless ($src_data) { #fucking binNMUs
- my $versions = $page->get_versions;
- my $sources = $page->get_arch_field( 'source' );
- my $source_versions = $page->get_arch_field( 'source-version' );
- foreach (version_sort keys %$versions) {
- $source = $sources->{$versions->{$_}[0]};
- $source = $source_versions->{$versions->{$_}[0]}
+ $version = $page->{newest};
+ my $source = $page->get_newest( 'source' );
+ my $source_version = $page->get_newest( 'source-version' )
|| $version;
- $src_data = $sources_all{"$source $source_version"};
- last if $src_data;
+ debug( "find source package: source=$source (=$source_version)", 1);
+ my $src_data = $sources_all{"$source $source_version"};
+ unless ($src_data) { #fucking binNMUs
+ my $versions = $page->get_versions;
+ my $sources = $page->get_arch_field( 'source' );
+ my $source_versions = $page->get_arch_field( 'source-version' );
+ foreach (version_sort keys %$versions) {
+ $source = $sources->{$versions->{$_}[0]};
+ $source = $source_versions->{$versions->{$_}[0]}
+ || $version;
+ $src_data = $sources_all{"$source $source_version"};
+ last if $src_data;
+ }
+ error( "couldn't find source package" ) unless $src_data;
}
- error( "couldn't find source package" ) unless $src_data;
- }
- $page->add_src_data( $source, $source_version, $src_data )
- if $src_data;
-
- my $st1 = new Benchmark;
- my $std = timediff($st1, $st0);
- debug( "Data search and merging took ".timestr($std) );
-
- my $encodedpkg = uri_escape( $pkg );
- my ($v_str, $v_str_arch, $v_str_arr) = $page->get_version_string();
- my $did = $page->get_newest( 'description' );
- $archive = $page->get_newest( 'archive' );
- $section = $page->get_newest( 'section' );
- $subsection = $page->get_newest( 'subsection' );
- my $filenames = $page->get_arch_field( 'filename' );
- my $file_md5sums = $page->get_arch_field( 'md5sum' );
- my $archives = $page->get_arch_field( 'archive' );
- my $sizes_inst = $page->get_arch_field( 'installed-size' );
- my $sizes_deb = $page->get_arch_field( 'size' );
- my @archs = sort $page->get_architectures;
-
- # process description
- #
- my $desc = $descriptions{$did};
- $short_desc = encode_entities( $1, "<>&\"" )
- if $desc =~ s/^(.*)$//m;
- my $long_desc = encode_entities( $desc, "<>&\"" );
-
- $long_desc =~ s,((ftp|http|https)://[\S~-]+?/?)((\>\;)?[)]?[']?[:.\,]?(\s|$)),$1$3,go; # syntax highlighting -> '];
- $long_desc =~ s/\A //o;
- $long_desc =~ s/\n /\n/sgo;
- $long_desc =~ s/\n.\n/\n\n/go;
- $long_desc =~ s/(((\n|\A) [^\n]*)+)/\n
$1\n<\/pre>/sgo;
+ $page->add_src_data( $source, $source_version, $src_data )
+ if $src_data;
+
+ my $st1 = new Benchmark;
+ my $std = timediff($st1, $st0);
+ debug( "Data search and merging took ".timestr($std) );
+
+ my $encodedpkg = uri_escape( $pkg );
+ my ($v_str, $v_str_arch, $v_str_arr) = $page->get_version_string();
+ my $did = $page->get_newest( 'description' );
+ $archive = $page->get_newest( 'archive' );
+ $section = $page->get_newest( 'section' );
+ $subsection = $page->get_newest( 'subsection' );
+ my $filenames = $page->get_arch_field( 'filename' );
+ my $file_md5sums = $page->get_arch_field( 'md5sum' );
+ my $archives = $page->get_arch_field( 'archive' );
+ my $sizes_inst = $page->get_arch_field( 'installed-size' );
+ my $sizes_deb = $page->get_arch_field( 'size' );
+ my @archs = sort $page->get_architectures;
+
+ # process description
+ #
+ my $desc = $descriptions{$did};
+ $short_desc = encode_entities( $1, "<>&\"" )
+ if $desc =~ s/^(.*)$//m;
+ my $long_desc = encode_entities( $desc, "<>&\"" );
+
+ $long_desc =~ s,((ftp|http|https)://[\S~-]+?/?)((\>\;)?[)]?[']?[:.\,]?(\s|$)),$1$3,go; # syntax highlighting -> '];
+ $long_desc =~ s/\A //o;
+ $long_desc =~ s/\n /\n/sgo;
+ $long_desc =~ s/\n.\n/\n\n/go;
+ $long_desc =~ s/(((\n|\A) [^\n]*)+)/\n
$1\n<\/pre>/sgo;
# $long_desc = conv_desc( $lang, $long_desc );
# $short_desc = conv_desc( $lang, $short_desc );
- my %all_suites;
- foreach (@results, @non_results) {
- my $a = $_->[1];
- my $s = $_->[2];
- if ($a =~ /^(?:us|security|non-US)$/o) {
- $all_suites{$s}++;
- } else {
- $all_suites{"$s/$a"}++;
+ my %all_suites;
+ foreach (@results, @non_results) {
+ my $a = $_->[1];
+ my $s = $_->[2];
+ if ($a =~ /^(?:us|security|non-US)$/o) {
+ $all_suites{$s}++;
+ } else {
+ $all_suites{"$s/$a"}++;
+ }
}
- }
- foreach (suites_sort(keys %all_suites)) {
- if (("$suite/$archive" eq $_)
- || (!$all_suites{"$suite/$archive"} && ($suite eq $_))) {
- $package_page .= "[ $_ ] ";
- } else {
- $package_page .=
- "[ $_ ] ";
+ foreach (suites_sort(keys %all_suites)) {
+ if (("$suite/$archive" eq $_)
+ || (!$all_suites{"$suite/$archive"} && ($suite eq $_))) {
+ $package_page .= "[ $_ ] ";
+ } else {
+ $package_page .=
+ "[ $_ ] ";
+ }
}
- }
- $package_page .= '
';
-
- $package_page .= simple_menu( [ gettext( "Distribution:" ),
- gettext( "Overview over this suite" ),
- "/$suite/",
- $suite ],
- [ gettext( "Section:" ),
- gettext( "All packages in this section" ),
- "/$suite/$subsection/",
- $subsection ],
- );
-
- my $title .= sprintf( gettext( "Package: %s (%s)" ), $pkg, $v_str );
- $title .= " ".marker( $archive ) if $archive ne 'us';
- $title .= " ".marker( $subsection ) if $subsection eq 'non-US'
- and $archive ne 'non-US'; # non-US/security
- $title .= " ".marker( $section ) if $section ne 'main';
- $package_page .= title( $title );
-
- $package_page .= "".gettext( "Versions:" )." $v_str_arch
\n"
- unless $version eq $v_str;
-
- if ($suite eq "experimental") {
- $package_page .= note( gettext( "Experimental package"),
- gettext( "Warning: This package is from the experimental distribution. That means it is likely unstable or buggy, and it may even cause data loss. If you ignore this warning and install it nevertheless, you do it on your own risk.")."
".
- gettext( "Users of experimental packages are encouraged to contact the package maintainers directly in case of problems." )
- );
- }
- if ($subsection eq "debian-installer") {
- note( gettext( "debian-installer udeb package"),
- gettext( "Warning: This package is intended for the use in building debian-installer images only. Do not install it on a normal Debian system." )
- );
- }
- $package_page .= pdesc( $short_desc, $long_desc );
-
- #
- # display dependencies
- #
- my $dep_list;
- $dep_list = print_deps( \%packages, \%opts, $pkg,
- $page->get_dep_field('depends'),
- 'depends' );
- $dep_list .= print_deps( \%packages, \%opts, $pkg,
- $page->get_dep_field('recommends'),
- 'recommends' );
- $dep_list .= print_deps( \%packages, \%opts, $pkg,
- $page->get_dep_field('suggests'),
- 'suggests' );
-
- if ( $dep_list ) {
- $package_page .= "
\n";
- $package_page .= sprintf( "
".gettext( "Other Packages Related to %s" )."
\n", $pkg );
- if ($suite eq "experimental") {
- note( gettext( "Note that the \"
experimental\" distribution is not self-contained; missing dependencies are likely found in the \"
unstable\" distribution." ) );
- }
+ $package_page .= '
';
+
+ $package_page .= simple_menu( [ gettext( "Distribution:" ),
+ gettext( "Overview over this suite" ),
+ "/$suite/",
+ $suite ],
+ [ gettext( "Section:" ),
+ gettext( "All packages in this section" ),
+ "/$suite/$subsection/",
+ $subsection ],
+ );
+
+ my $title .= sprintf( gettext( "Package: %s (%s)" ), $pkg, $v_str );
+ $title .= " ".marker( $archive ) if $archive ne 'us';
+ $title .= " ".marker( $subsection ) if $subsection eq 'non-US'
+ and $archive ne 'non-US'; # non-US/security
+ $title .= " ".marker( $section ) if $section ne 'main';
+ $package_page .= title( $title );
- $package_page .= pdeplegend( [ 'dep', gettext( 'depends' ) ],
- [ 'rec', gettext( 'recommends' ) ],
- [ 'sug', gettext( 'suggests' ) ], );
+ $package_page .= "
".gettext( "Versions:" )." $v_str_arch
\n"
+ unless $version eq $v_str;
- $package_page .= $dep_list;
- $package_page .= "
\n";
- }
+ if ($suite eq "experimental") {
+ $package_page .= note( gettext( "Experimental package"),
+ gettext( "Warning: This package is from the experimental distribution. That means it is likely unstable or buggy, and it may even cause data loss. If you ignore this warning and install it nevertheless, you do it on your own risk.")."".
+ gettext( "Users of experimental packages are encouraged to contact the package maintainers directly in case of problems." )
+ );
+ }
+ if ($subsection eq "debian-installer") {
+ note( gettext( "debian-installer udeb package"),
+ gettext( "Warning: This package is intended for the use in building debian-installer images only. Do not install it on a normal Debian system." )
+ );
+ }
+ $package_page .= pdesc( $short_desc, $long_desc );
+
+ #
+ # display dependencies
+ #
+ my $dep_list;
+ $dep_list = print_deps( \%packages, \%opts, $pkg,
+ $page->get_dep_field('depends'),
+ 'depends' );
+ $dep_list .= print_deps( \%packages, \%opts, $pkg,
+ $page->get_dep_field('recommends'),
+ 'recommends' );
+ $dep_list .= print_deps( \%packages, \%opts, $pkg,
+ $page->get_dep_field('suggests'),
+ 'suggests' );
+
+ if ( $dep_list ) {
+ $package_page .= "
\n";
+ $package_page .= sprintf( "
".gettext( "Other Packages Related to %s" )."
\n", $pkg );
+ if ($suite eq "experimental") {
+ note( gettext( "Note that the \"
experimental\" distribution is not self-contained; missing dependencies are likely found in the \"
unstable\" distribution." ) );
+ }
+
+ $package_page .= pdeplegend( [ 'dep', gettext( 'depends' ) ],
+ [ 'rec', gettext( 'recommends' ) ],
+ [ 'sug', gettext( 'suggests' ) ], );
+
+ $package_page .= $dep_list;
+ $package_page .= "
\n";
+ }
- #
- # Download package
- #
- my $encodedpack = uri_escape( $pkg );
- $package_page .= "";
- $package_page .= sprintf( "
".gettext( "Download %s\n" )."
",
- $pkg ) ;
- $package_page .= "
\n";
- $package_page .= "".gettext("Download for all available architectures")."\n";
- $package_page .= "\n";
- $package_page .= "".gettext("Architecture")." | ".gettext("Files")." | ".gettext( "Package Size")." | ".gettext("Installed Size")." |
\n";
- foreach my $a ( @archs ) {
+ #
+ # Download package
+ #
+ my $encodedpack = uri_escape( $pkg );
+ $package_page .= "";
+ $package_page .= sprintf( "
".gettext( "Download %s\n" )."
",
+ $pkg ) ;
+ $package_page .= "
".gettext ( "Size is measured in kBytes." )."
\n";
+ $package_page .= "
\n";
+
+ #
+ # more information
+ #
+ $package_page .= pmoreinfo( name => $pkg, data => $page,
+ opts => \%opts,
+ env => \%FTP_SITES,
+ bugreports => 1, sourcedownload => 1,
+ changesandcopy => 1, maintainers => 1,
+ search => 1 );
+ }
+ }
+ } else {
+ read_src_entry_all( \%sources, $pkg, \@results, \@non_results, \%opts );
+
+ unless (@results || @non_results ) {
+ fatal_error( "No such package".
+ "{insert link to search page with substring search}" );
+ } else {
+ unless (@results) {
+ fatal_error( "Package not available in this suite" );
+ } else {
+ for my $entry (@results) {
+ debug( join(":", @$entry), 1 );
+ my (undef, $archive, undef, $section, $subsection,
+ $priority, $version) = @$entry;
+
+ my $data = $sources_all{"$pkg $version"};
+ $page->merge_data($pkg, $version, $data) or debug( "Merging $pkg $version FAILED", 2 );
+ }
+ $version = $page->{version};
+
+ my $st1 = new Benchmark;
+ my $std = timediff($st1, $st0);
+ debug( "Data search and merging took ".timestr($std) );
+
+ my $encodedpkg = uri_escape( $pkg );
+ my ($v_str, $v_str_arr) = $page->get_version_string();
+ $archive = $page->get_newest( 'archive' );
+ $section = $page->get_newest( 'section' );
+ $subsection = $page->get_newest( 'subsection' );
+
+ my %all_suites;
+ foreach (@results, @non_results) {
+ my $a = $_->[1];
+ my $s = $_->[2];
+ if ($a =~ /^(?:us|security|non-US)$/o) {
+ $all_suites{$s}++;
+ } else {
+ $all_suites{"$s/$a"}++;
+ }
+ }
+ foreach (suites_sort(keys %all_suites)) {
+ if (("$suite/$archive" eq $_)
+ || (!$all_suites{"$suite/$archive"} && ($suite eq $_))) {
+ $package_page .= "[ $_ ] ";
+ } else {
+ $package_page .=
+ "[ $_ ] ";
+ }
+ }
+ $package_page .= '
';
+
+ $package_page .= simple_menu( [ gettext( "Distribution:" ),
+ gettext( "Overview over this suite" ),
+ "/$suite/",
+ $suite ],
+ [ gettext( "Section:" ),
+ gettext( "All packages in this section" ),
+ "/$suite/$subsection/",
+ $subsection ],
+ );
+
+ my $title .= sprintf( gettext( "Source Package: %s (%s)" ),
+ $pkg, $v_str );
+ $title .= " ".marker( $archive ) if $archive ne 'us';
+ $title .= " ".marker( $subsection ) if $subsection eq 'non-US'
+ and $archive ne 'non-US'; # non-US/security
+ $title .= " ".marker( $section ) if $section ne 'main';
+ $package_page .= title( $title );
+
+ if ($suite eq "experimental") {
+ $package_page .= note( gettext( "Experimental package"),
+ gettext( "Warning: This package is from the experimental distribution. That means it is likely unstable or buggy, and it may even cause data loss. If you ignore this warning and install it nevertheless, you do it on your own risk.")."".
+ gettext( "Users of experimental packages are encouraged to contact the package maintainers directly in case of problems." )
+ );
+ }
+ if ($subsection eq "debian-installer") {
+ note( gettext( "debian-installer udeb package"),
+ gettext( "Warning: This package is intended for the use in building debian-installer images only. Do not install it on a normal Debian system." )
+ );
+ }
+
+ my $binaries = find_binaries( $pkg, $archive, $suite, \%src2bin );
+ if ($binaries && @$binaries) {
+ $package_page .= '
';
+ $package_page .= gettext( "The following binary packages are built from this source package:" );
+ $package_page .= pkg_list( \%packages, \%opts, $binaries, 'en' );
+ $package_page .= '
';
+ }
+
+ #
+ # display dependencies
+ #
+ my $dep_list;
+ $dep_list = print_src_deps( \%packages, \%opts, $pkg,
+ $page->get_dep_field('build-depends'),
+ 'build-depends' );
+ $dep_list .= print_src_deps( \%packages, \%opts, $pkg,
+ $page->get_dep_field('build-depends-indep'),
+ 'build-depends-indep' );
+
+ if ( $dep_list ) {
+ $package_page .= "\n";
+ $package_page .= sprintf( "
".gettext( "Other Packages Related to %s" )."
\n", $pkg );
+ if ($suite eq "experimental") {
+ note( gettext( "Note that the \"
experimental\" distribution is not self-contained; missing dependencies are likely found in the \"
unstable\" distribution." ) );
+ }
+
+ $package_page .= pdeplegend( [ 'adep', gettext( 'build-depends' ) ],
+ [ 'idep', gettext( 'build-depends-indep' ) ],
+ );
+
+ $package_page .= $dep_list;
+ $package_page .= "
\n";
+ }
+
+ #
+ # Source package download
+ #
+ $package_page .= "\n";
+ my $encodedpack = uri_escape( $pkg );
+ $package_page .= sprintf( "
".gettext( "Download %s" )."
\n",
+ $pkg ) ;
+
+ my $source_files = $page->get_src( 'files' );
+ my $source_dir = $page->get_src( 'directory' );
+
+ $package_page .= sprintf( "
\n"
+ ."%s | %s | %s | ",
+ gettext("File"),
+ gettext("Size (in kB)"),
+ gettext("md5sum") );
+ foreach( @$source_files ) {
+ my ($src_file_md5, $src_file_size, $src_file_name) = @$_;
+ my $src_url;
+ for ($archive) {
+ /security/o && do {
+ $src_url = $FTP_SITES{security}; last };
+ /volatile/o && do {
+ $src_url = $FTP_SITES{volatile}; last };
+ /backports/o && do {
+ $src_url = $FTP_SITES{backports}; last };
+ /non-us/io && do {
+ $src_url = $FTP_SITES{'non-US'}; last };
+ $src_url = $FTP_SITES{us};
+ }
+ $src_url .= "/$source_dir/$src_file_name";
+
+ $package_page .= "
---|
$src_file_name | \n"
+ ."".sprintf("%.1f", (floor(($src_file_size/102.4)+0.5)/10))." | \n"
+ ."$src_file_md5 |
";
}
- $package_page .= "\n";
- $package_page .= floor(($sizes_deb->{$a}/102.4)+0.5)/10;
- $package_page .= " | \n";
- $package_page .= $sizes_inst->{$a};
- $package_page .= " | \n";
+ $package_page .= "
\n";
+ $package_page .= "
\n";
+
+ #
+ # more information
+ #
+ $package_page .= pmoreinfo( name => $pkg, data => $page,
+ opts => \%opts,
+ env => \%FTP_SITES,
+ bugreports => 1,
+ changesandcopy => 1, maintainers => 1,
+ search => 1, is_source => 1 );
}
- $package_page .= "
".gettext ( "Size is measured in kBytes." )."
\n";
- $package_page .= "
\n";
-
- #
- # more information
- #
- $package_page .= pmoreinfo( name => $pkg, data => $page,
- opts => \%opts,
- env => \%FTP_SITES,
- bugreports => 1, sourcedownload => 1,
- changesandcopy => 1, maintainers => 1,
- search => 1 );
}
}
}
-use Data::Dumper;
-debug( "Final page object:\n".Dumper($page), 3 );
+#use Data::Dumper;
+#debug( "Final page object:\n".Dumper($page), 3 );
-print Packages::HTML::header( title => "Details of package $pkg in $suite" ,
+my $title = $opts{source} ?
+ "Details of source package $pkg in $suite" :
+ "Details of package $pkg in $suite" ;
+my $title_tag = $opts{source} ?
+ "Details of source package $pkg in $suite" :
+ "Details of package $pkg in $suite" ;
+print Packages::HTML::header( title => $title ,
lang => 'en',
desc => $short_desc,
keywords => "$suite, $archive, $section, $subsection, $version",
diff --git a/lib/Packages/DB.pm b/lib/Packages/DB.pm
new file mode 100644
index 0000000..e959f60
--- /dev/null
+++ b/lib/Packages/DB.pm
@@ -0,0 +1,51 @@
+package Packages::DB;
+
+use strict;
+use warnings;
+
+use Exporter;
+use DB_File;
+use Packages::CGI;
+use Packages::Config qw( $DBDIR );
+
+our @ISA = qw( Exporter );
+our ( %packages, %sources, %src2bin, %did2pkg, %descriptions,
+ %postf, %spostf,
+ $obj, $s_obj, $p_obj, $sp_obj );
+our @EXPORT = qw( %packages %sources %src2bin %did2pkg %descriptions
+ %postf %spostf
+ $obj $s_obj $p_obj $sp_obj );
+our $db_read_time ||= 0;
+
+sub init {
+ 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: $!";
+ tie %src2bin, 'DB_File', "$DBDIR/sources_packages.db",
+ O_RDONLY, 0666, $DB_BTREE
+ or die "couldn't open $DBDIR/sources_packages.db: $!";
+ tie %descriptions, 'DB_File', "$DBDIR/descriptions.db",
+ O_RDONLY, 0666, $DB_BTREE
+ or die "couldn't tie DB $DBDIR/descriptions.db: $!";
+ tie %did2pkg, 'DB_File', "$DBDIR/descriptions_packages.db",
+ O_RDONLY, 0666, $DB_BTREE
+ or die "couldn't tie DB $DBDIR/descriptions_packages.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: $!";
+
+ debug( "tied databases ($dbmodtime > $db_read_time)" );
+ $db_read_time = $dbmodtime;
+ }
+}
+
+1;
+
diff --git a/lib/Packages/HTML.pm b/lib/Packages/HTML.pm
index 90c9569..a291a00 100644
--- a/lib/Packages/HTML.pm
+++ b/lib/Packages/HTML.pm
@@ -24,7 +24,7 @@ our @ISA = qw( Exporter );
our @EXPORT = qw( header title trailer file_changed time_stamp
read_md5_hash write_md5_hash simple_menu
ds_begin ds_item ds_end note title marker pdesc
- pdeplegend pkg_list pmoreinfo print_deps );
+ pdeplegend pkg_list pmoreinfo print_deps print_src_deps );
our $CHANGELOG_URL = '/changelogs';
@@ -79,38 +79,27 @@ sub pdeplegend {
return $str;
}
-# sub pkg_list {
-# my ( $pkgs, $lang, $env ) = @_;
-
-# my $str = "";
-# foreach my $p ( @$pkgs ) {
-# my $p_pkg = $env->{db}->get_pkg( $p );
-
-# if ( $p_pkg ) {
-# if ($p_pkg->is_virtual) {
-# $str .= "$p\n".
-# "\t".gettext("Virtual package")."\n";
-# } else {
-# my %subsections = $p_pkg->get_arch_fields( 'section',
-# $env->{archs} );
-# my $subsection = $subsections{max_unique};
-# my %desc_md5s = $p_pkg->get_arch_fields( 'description-md5',
-# $env->{archs} );
-# my $short_desc = conv_desc( $lang,
-# encode_entities( $env->{db}->get_short_desc( $desc_md5s{max_unique}, $lang ), "<>&\"" ) );
-# $str .= "$p\n".
-# "\t$short_desc\n";
-# }
-# } else {
-# $str .= "$p\n\t".gettext("Not available")."\n";
-# }
-# }
-# if ($str) {
-# $str = "$str
\n";
-# }
-
-# return $str;
-# }
+sub pkg_list {
+ my ( $packages, $opts, $pkgs, $lang ) = @_;
+
+ my $str = "";
+ foreach my $p ( @$pkgs ) {
+
+ my $short_desc = (read_entry_simple( $packages, $p, $opts->{h_archives}, $opts->{suite}))->[-1];
+
+ if ( $short_desc ) {
+ $str .= "{suite}/$p\">$p\n".
+ "\t$short_desc\n";
+ } else {
+ $str .= "$p\n\t".gettext("Not available")."\n";
+ }
+ }
+ if ($str) {
+ $str = "$str
\n";
+ }
+
+ return $str;
+}
sub pmoreinfo {
my %info = @_;
@@ -124,7 +113,6 @@ sub pmoreinfo {
my $str = "";
$str .= sprintf( "
".gettext( "More Information on %s" )."
",
$name );
-
if ($info{bugreports}) {
my $bug_url = $is_source ? $SRC_BUG_URL : $BUG_URL;
@@ -132,7 +120,7 @@ sub pmoreinfo {
$bug_url.$name, $name );
}
- my $source = $page->get_src( 'name' );
+ my $source = $page->get_src( 'package' );
my $source_version = $page->get_src( 'version' );
my $src_dir = $page->get_src('directory');
if ($info{sourcedownload}) {
@@ -154,6 +142,8 @@ sub pmoreinfo {
$str .= "
{security}/$src_dir/$src_file_name\">["; last };
/volatile/o && do {
$str .= "{volatile}/$src_dir/$src_file_name\">["; last };
+ /backports/o && do {
+ $str .= "{backports}/$src_dir/$src_file_name\">["; last };
/non-us/io && do {
$str .= "{nonus_site}/$src_dir/$src_file_name\">["; last };
$str .= "{us}/$src_dir/$src_file_name\">[";
@@ -270,7 +260,7 @@ sub print_deps {
} else {
$res .= "\n";
}
- $res .= "- ";
+ $res .= "
- ";
}
foreach my $rel_alt ( @$rel ) {
@@ -321,56 +311,48 @@ sub print_deps {
return $res;
} # end print_deps
-# sub print_src_deps {
-# my ( $env, $lang, $pkg, $version, $type) = @_;
-# my %dep_type = ('build-depends' => 'adep', 'build-depends-indep' => 'idep' );
-# my $found = 0;
-# my $res = "
\n";
-# foreach my $dep ( @{$pkg->{versions}{$version}{$type}} ) {
-# $found = 1;
-# my @res_pkgs;
-# $res .= "- ";
-# foreach my $or_dep ( @$dep ) {
-# my $p_name = $or_dep->[0];
-# my $p = $env->{db}->get_pkg( $p_name );
-# my $p_version = $or_dep->[1] ? "(".encode_entities( $or_dep->[1] ).
-# " $or_dep->[2]) " : "";
-# my $not = gettext( "not" );
-# if ($or_dep->[3]) {
-# $or_dep->[3] =~ s/\s+/, /go;
-# # as either all or no archs have to be prepended with
-# # exlamation marks, convert the first and delete the others
-# $or_dep->[3] =~ s/!\s*/$not /o;
-# $or_dep->[3] =~ s/!\s*//go;
-# }
-# my $arch_str = $or_dep->[3] ? " [$or_dep->[3]]" : "";
-# if ( $p ) {
-# if ( $p->is_virtual ) {
-# my $short_desc = gettext( "Virtual package" );
-# push @res_pkgs, dep_item( "../virtual/$p_name", $p_name, "$p_version$arch_str", $short_desc );
-# } else {
-# my %sections = $p->get_arch_fields( 'section',
-# $env->{archs} );
-# my $section = $sections{max_unique};
-# my %desc_md5s = $p->get_arch_fields( 'description-md5',
-# $env->{archs} );
-# my $short_desc = conv_desc( $lang, encode_entities( $env->{db}->get_short_desc( $desc_md5s{max_unique}, $lang ), "<>&\"" ) );
-# push @res_pkgs, dep_item( "../$section/$p_name", $p_name, "$p_version$arch_str", $short_desc );
-# }
-# } else {
-# my $short_desc = gettext( "Package not available" );
-# push @res_pkgs, dep_item( undef, $p_name, "$p_version$arch_str", $short_desc );
-# }
-# }
-# $res .= "\n".join( "
- \n".gettext( "or" )." ", @res_pkgs )."
\n";
-# }
-# if ($found) {
-# $res .= "\n
";
-# } else {
-# $res = "";
-# }
-# return $res;
-# } # end print_src_deps
+sub print_src_deps {
+ my ( $packages, $opts, $pkg, $relations, $type) = @_;
+ my %dep_type = ('build-depends' => 'adep', 'build-depends-indep' => 'idep' );
+ my $res = "\n";
+ foreach my $dep (@$relations) {
+ my @res_pkgs;
+ $res .= "- ";
+ foreach my $or_dep ( @$dep ) {
+ my $p_name = $or_dep->[0];
+ my $p_version = $or_dep->[1] ? "(".encode_entities( $or_dep->[1] ).
+ " $or_dep->[2]) " : "";
+ my $not = gettext( "not" );
+ my $arch_str = '';
+ if ($or_dep->[3] && @{$or_dep->[3]}) {
+ # as either all or no archs have to be prepended with
+ # exlamation marks, convert the first and delete the others
+ if ($or_dep->[3][0] =~ /^!/) {
+ $arch_str = "$not ";
+ foreach (@{$or_dep->[3]}) {
+ $_ =~ s/^!//go;
+ }
+ }
+ $arch_str = " [${arch_str}@{$or_dep->[3]}]";
+ }
+ my $short_desc = (read_entry_simple( $packages, $p_name, $opts->{h_archives}, $opts->{suite}))->[-1];
+ if ( $short_desc ) {
+ $short_desc = encode_entities( $short_desc, "<>&\"" );
+ push @res_pkgs, dep_item( "/$opts->{suite}/$p_name", $p_name, "$p_version$arch_str", $short_desc );
+ } else {
+ $short_desc = gettext( "Package not available" );
+ push @res_pkgs, dep_item( undef, $p_name, "$p_version$arch_str", $short_desc );
+ }
+ }
+ $res .= "\n".join( "
- \n".gettext( "or" )." ", @res_pkgs )."
\n";
+ }
+ if (@$relations) {
+ $res .= "\n
";
+ } else {
+ $res = "";
+ }
+ return $res;
+} # end print_src_deps
my $ds_begin = ' ';
diff --git a/lib/Packages/Page.pm b/lib/Packages/Page.pm
index b00eefb..d57126e 100644
--- a/lib/Packages/Page.pm
+++ b/lib/Packages/Page.pm
@@ -4,9 +4,14 @@ use strict;
use warnings;
use Data::Dumper;
+use Exporter;
use Deb::Versions;
use Packages::CGI;
+our @ISA = qw( Exporter );
+our @EXPORT_OK = qw( split_name_mail parse_deps );
+our %EXPORT_TAGS = ( all => [ @EXPORT_OK ] );
+
our $ARCHIVE_DEFAULT = '';
our $SECTION_DEFAULT = 'main';
our $SUBSECTION_DEFAULT = 'unknown';
@@ -74,7 +79,7 @@ sub add_src_data {
$data{$key} = $value;
}
- $self->{src}{name} = $src;
+ $self->{src}{package} = $src;
$self->{src}{version} = $version;
if ($data{files}) {
$self->{src}{files} = [];
diff --git a/lib/Packages/Search.pm b/lib/Packages/Search.pm
index b545dbc..6945284 100644
--- a/lib/Packages/Search.pm
+++ b/lib/Packages/Search.pm
@@ -57,7 +57,7 @@ our @ISA = qw( Exporter );
our @EXPORT_OK = qw( nextlink prevlink indexline
resperpagelink
read_entry read_entry_all read_entry_simple
- read_src_entry find_binaries
+ read_src_entry read_src_entry_all find_binaries
do_names_search do_fulltext_search
printindexline multipageheader );
our %EXPORT_TAGS = ( all => [ @EXPORT_OK ] );
@@ -379,8 +379,8 @@ sub read_entry_simple {
}
return \@data_fuzzy;
}
-sub read_src_entry {
- my ($hash, $key, $results, $opts) = @_;
+sub read_src_entry_all {
+ my ($hash, $key, $results, $non_results, $opts) = @_;
my $result = $hash->{$key} || '';
foreach (split /\000/o, $result) {
my @data = split ( /\s/o, $_, 6 );
@@ -390,9 +390,16 @@ sub read_src_entry {
&& $opts->{h_sections}{$data[2]}) {
debug( "Using entry ".join( ':', @data), 2);
push @$results, [ $key, @data ];
+ } else {
+ push @$non_results, [ $key, @data ];
}
}
}
+sub read_src_entry {
+ my ($hash, $key, $results, $opts) = @_;
+ my @non_results;
+ read_src_entry_all( $hash, $key, $results, \@non_results, $opts );
+}
sub do_names_search {
my ($keyword, $packages, $postfixes, $read_entry, $opts) = @_;
my @results;
diff --git a/lib/Packages/SrcPage.pm b/lib/Packages/SrcPage.pm
new file mode 100644
index 0000000..aaee2a9
--- /dev/null
+++ b/lib/Packages/SrcPage.pm
@@ -0,0 +1,127 @@
+package Packages::SrcPage;
+
+use strict;
+use warnings;
+
+use Data::Dumper;
+use Deb::Versions;
+use Packages::CGI;
+use Packages::Page qw( :all );
+
+our @ISA = qw( Packages::Page );
+
+#FIXME: change parameters so that we can use the version from Packages::Page
+sub merge_data {
+ my ($self, $pkg, $version, $data) = @_;
+
+ my %data = ( package => $pkg,
+ version => $version,
+ );
+ chomp($data);
+ $data =~ s/\n\s+/\377/g;
+ while ($data =~ /^(\S+):\s*(.*)\s*$/mg) {
+ my ($key, $value) = ($1, $2);
+ $key =~ tr [A-Z] [a-z];
+ $data{$key} = $value;
+ }
+# debug( "Merge package:\n".Dumper(\%data), 3 );
+ return $self->merge_package( \%data );
+}
+
+sub gettext { return $_[0]; }
+
+our @DEP_FIELDS = qw( build-depends build-depends-indep
+ build-conflicts build-conflicts-indep);
+sub merge_package {
+ my ($self, $data) = @_;
+
+ ($data->{package} && $data->{version}) || return;
+ $self->{package} ||= $data->{package};
+ ($self->{package} eq $data->{package}) || return;
+ debug( "merge package $data->{package}/$data->{version} into $self (".($self->{version}||'').")", 2 );
+
+ if (!$self->{version}
+ || (version_cmp( $data->{version}, $self->{version} ) > 0)) {
+ debug( "added package is newer, replacing old information" );
+
+ $self->{data} = $data;
+
+ my @uploaders;
+ if ($data->{maintainer} ||= '') {
+ push @uploaders, [ split_name_mail( $data->{maintainer} ) ];
+ }
+ if ($data->{uploaders}) {
+ my @up_tmp = split( /\s*,\s*/,
+ $data->{uploaders} );
+ foreach my $up (@up_tmp) {
+ if ($up ne $data->{maintainer}) { # weed out duplicates
+ push @uploaders, [ split_name_mail( $up ) ];
+ }
+ }
+ }
+ $self->{uploaders} = \@uploaders;
+
+ if ($data->{files}) {
+ $self->{files} = [];
+ foreach my $sf ( split( /\377/, $data->{files} ) ) {
+ next unless $sf;
+ # md5, size, name
+ push @{$self->{files}}, [ split( /\s+/, $sf) ];
+ }
+ }
+
+ foreach (@DEP_FIELDS) {
+ $self->normalize_dependencies( $_, $data );
+ }
+
+ $self->{version} = $data->{version};
+ }
+}
+
+#FIXME: should be mergable with the Packages::Page version
+sub normalize_dependencies {
+ my ($self, $dep_field, $data) = @_;
+
+ my ($deps_norm, $deps) = parse_deps( $data->{$dep_field}||'' );
+ $self->{dep_fields}{$dep_field} =
+ [ $deps_norm, $deps ];
+}
+
+sub get_src {
+ my ($self, $field) = @_;
+
+ return $self->{$field} if exists $self->{$field};
+ return $self->{data}{$field};
+}
+
+sub get_architectures {
+ die "NOT SUPPORTED";
+}
+
+sub get_arch_field {
+ my ($self, $field) = @_;
+
+ return $self->{data}{$field};
+}
+
+sub get_versions {
+ my ($self) = @_;
+
+ return [ $self->{version} ];
+}
+
+sub get_version_string {
+ my ($self) = @_;
+
+ my $versions = $self->get_versions;
+
+ return ($self->{version}, $versions);
+}
+
+sub get_dep_field {
+ my ($self, $dep_field) = @_;
+
+ return $self->{dep_fields}{$dep_field}[1];
+}
+
+1;
--
2.39.2