# read the configuration
our $config_read_time ||= 0;
our $db_read_time ||= 0;
-our ( $topdir, $ROOT, @SUITES, @SECTIONS, @ARCHIVES, @ARCHITECTURES );
+our ( $topdir, $ROOT, @SUITES, @SECTIONS, @ARCHIVES, @ARCHITECTURES,
+ %FTP_SITES );
# FIXME: move to own module
my $modtime = (stat( "../config.sh" ))[9];
$Packages::HTML::BUG_URL = $1 if /^\s*bug_url="?([^\"]*)"?\s*$/o;
$Packages::HTML::SRC_BUG_URL = $1 if /^\s*src_bug_url="?([^\"]*)"?\s*$/o;
$Packages::HTML::QA_URL = $1 if /^\s*qa_url="?([^\"]*)"?\s*$/o;
+ $FTP_SITES{us} = $1 if /^\s*ftpsite="?([^\"]*)"?\s*$/o;
+ $FTP_SITES{$1} = $2 if /^\s*(\w+)_ftpsite="?([^\"]*)"?\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;
#
# display dependencies
#
- my $dep_list = print_deps( \%packages, \%opts, $pkg,
+ my $dep_list;
+ $dep_list = print_deps( \%packages, \%opts, $pkg,
$page->get_dep_field('depends'),
'depends' );
$dep_list .= print_deps( \%packages, \%opts, $pkg,
[ 'sug', gettext( 'suggests' ) ], );
$package_page .= $dep_list;
- $package_page .= "</div> <!-- end pdeps -->\n";
-
- #
- # Download package
- #
- my $encodedpack = uri_escape( $pkg );
- $package_page .= "<div id=\"pdownload\">";
- $package_page .= sprintf( "<h2>".gettext( "Download %s\n" )."</h2>",
- $pkg ) ;
- $package_page .= "<table border=\"1\" summary=\"".gettext("The download table links to the download of the package and a file overview. In addition it gives information about the package size and the installed size.")."\">\n";
- $package_page .= "<caption class=\"hidecss\">".gettext("Download for all available architectures")."</caption>\n";
+ $package_page .= "</div> <!-- end pdeps -->\n";
+ }
+
+ #
+ # Download package
+ #
+ my $encodedpack = uri_escape( $pkg );
+ $package_page .= "<div id=\"pdownload\">";
+ $package_page .= sprintf( "<h2>".gettext( "Download %s\n" )."</h2>",
+ $pkg ) ;
+ $package_page .= "<table border=\"1\" summary=\"".gettext("The download table links to the download of the package and a file overview. In addition it gives information about the package size and the installed size.")."\">\n";
+ $package_page .= "<caption class=\"hidecss\">".gettext("Download for all available architectures")."</caption>\n";
+ $package_page .= "<tr>\n";
+ $package_page .= "<th>".gettext("Architecture")."</th><th>".gettext("Files")."</th><th>".gettext( "Package Size")."</th><th>".gettext("Installed Size")."</th></tr>\n";
+ foreach my $a ( @archs ) {
$package_page .= "<tr>\n";
- $package_page .= "<th>".gettext("Architecture")."</th><th>".gettext("Files")."</th><th>".gettext( "Package Size")."</th><th>".gettext("Installed Size")."</th></tr>\n";
- foreach my $a ( @archs ) {
- $package_page .= "<tr>\n";
- $package_page .= "<th><a href=\"$DL_URL?arch=$a";
- $package_page .= "&file=".uri_escape($filenames->{$a});
- $package_page .= "&md5sum=$file_md5sums->{$a}";
- $package_page .= "&arch=$a";
- # there was at least one package with two
- # different source packages on different
- # archs where one had a security update
- # and the other one not
- for ($archives->{$a}) {
- /security/o && do {
- $package_page .= "&type=security"; last };
- /volatile/o && do {
- $package_page .= "&type=volatile"; last };
- /non-us/io && do {
- $package_page .= "&type=nonus"; last };
- $package_page .= "&type=main";
- }
- $package_page .= "\">$a</a></th>\n";
- $package_page .= "<td>";
- if ( $suite ne "experimental" ) {
- $package_page .= sprintf( "[<a href=\"%s\">".gettext( "list of files" )."</a>]\n", "$FILELIST_URL$encodedpkg&version=$suite&arch=$a", $pkg );
- } else {
- $package_page .= gettext( "no current information" );
- }
- $package_page .= "</td>\n<td>";
- $package_page .= floor(($sizes_deb->{$a}/102.4)+0.5)/10;
- $package_page .= "</td>\n<td>";
- $package_page .= $sizes_inst->{$a};
- $package_page .= "</td>\n</tr>";
+ $package_page .= "<th><a href=\"$DL_URL?arch=$a";
+ $package_page .= "&file=".uri_escape($filenames->{$a});
+ $package_page .= "&md5sum=$file_md5sums->{$a}";
+ $package_page .= "&arch=$a";
+ # there was at least one package with two
+ # different source packages on different
+ # archs where one had a security update
+ # and the other one not
+ for ($archives->{$a}) {
+ /security/o && do {
+ $package_page .= "&type=security"; last };
+ /volatile/o && do {
+ $package_page .= "&type=volatile"; last };
+ /non-us/io && do {
+ $package_page .= "&type=nonus"; last };
+ $package_page .= "&type=main";
}
- $package_page .= "</table><p>".gettext ( "Size is measured in kBytes." )."</p>\n";
- $package_page .= "</div> <!-- end pdownload -->\n";
-
- #
- # more information
- #
- $package_page .= pmoreinfo( name => $pkg, data => $page,
- bugreports => 1, sourcedownload => 1,
- changesandcopy => 0, maintainers => 1,
- search => 1 );
+ $package_page .= "\">$a</a></th>\n";
+ $package_page .= "<td>";
+ if ( $suite ne "experimental" ) {
+ $package_page .= sprintf( "[<a href=\"%s\">".gettext( "list of files" )."</a>]\n", "$FILELIST_URL$encodedpkg&version=$suite&arch=$a", $pkg );
+ } else {
+ $package_page .= gettext( "no current information" );
+ }
+ $package_page .= "</td>\n<td>";
+ $package_page .= floor(($sizes_deb->{$a}/102.4)+0.5)/10;
+ $package_page .= "</td>\n<td>";
+ $package_page .= $sizes_inst->{$a};
+ $package_page .= "</td>\n</tr>";
}
+ $package_page .= "</table><p>".gettext ( "Size is measured in kBytes." )."</p>\n";
+ $package_page .= "</div> <!-- end pdownload -->\n";
+
+ #
+ # more information
+ #
+ $package_page .= pmoreinfo( name => $pkg, data => $page,
+ env => \%FTP_SITES,
+ bugreports => 1, sourcedownload => 1,
+ changesandcopy => 1, maintainers => 1,
+ search => 1 );
}
}
}
use HTML::Entities;
use Packages::CGI;
-use Packages::Search qw( read_entry );
+use Packages::Search qw( read_entry_simple );
#use Packages::Util;
#use Packages::I18N::Locale;
return $str;
}
-sub pkg_list {
- my ( $pkgs, $lang, $env ) = @_;
+# sub pkg_list {
+# my ( $pkgs, $lang, $env ) = @_;
- my $str = "";
- foreach my $p ( @$pkgs ) {
- my $p_pkg = $env->{db}->get_pkg( $p );
+# my $str = "";
+# foreach my $p ( @$pkgs ) {
+# my $p_pkg = $env->{db}->get_pkg( $p );
- if ( $p_pkg ) {
- if ($p_pkg->is_virtual) {
- $str .= "<dt><a href=\"../virtual/$p\">$p</a></dt>\n".
- "\t<dd>".gettext("Virtual package")."</dd>\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 .= "<dt><a href=\"../$subsection/$p\">$p</a></dt>\n".
- "\t<dd>$short_desc</dd>\n";
- }
- } else {
- $str .= "<dt>$p</dt>\n\t<dd>".gettext("Not available")."</dd>\n";
- }
- }
- if ($str) {
- $str = "<dl>$str</dl>\n";
- }
+# if ( $p_pkg ) {
+# if ($p_pkg->is_virtual) {
+# $str .= "<dt><a href=\"../virtual/$p\">$p</a></dt>\n".
+# "\t<dd>".gettext("Virtual package")."</dd>\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 .= "<dt><a href=\"../$subsection/$p\">$p</a></dt>\n".
+# "\t<dd>$short_desc</dd>\n";
+# }
+# } else {
+# $str .= "<dt>$p</dt>\n\t<dd>".gettext("Not available")."</dd>\n";
+# }
+# }
+# if ($str) {
+# $str = "<dl>$str</dl>\n";
+# }
- return $str;
-}
+# return $str;
+# }
sub pmoreinfo {
my %info = @_;
my $name = $info{name} or return;
-# my $env = $info{env} or return;
+ my $env = $info{env} or return;
my $page = $info{data} or return;
my $is_source = $info{is_source};
}
my $source = $page->get_src( 'name' );
+ my $source_version = $page->get_src( 'version' );
+ my $src_dir = $page->get_src('directory');
if ($info{sourcedownload}) {
my $files = $page->get_src( 'files' );
$str .= gettext( "Source Package:" );
} else {
foreach( @$files ) {
my ($src_file_md5, $src_file_size, $src_file_name) = @$_;
-# if ($d->{is_security}) {
-# $str .= "<a href=\"$env->{opts}{security_site}/$d->{src_directory}/$src_file_name\">[";
-# } elsif ($d->{is_volatile}) {
-# $str .= "<a href=\"$env->{opts}{volatile_site}/$d->{src_directory}/$src_file_name\">[";
-# } elsif ($d->{is_nonus}) {
-# $str .= "<a href=\"$env->{opts}{nonus_site}/$d->{src_directory}/$src_file_name\">[";
-# } else {
-# $str .= "<a href=\"$env->{opts}{debian_site}/$d->{src_directory}/$src_file_name\">[";
-# }
+ for ($page->get_newest('archive')) {
+ /security/o && do {
+ $str .= "<a href=\"$env->{security}/$src_dir/$src_file_name\">["; last };
+ /volatile/o && do {
+ $str .= "<a href=\"$env->{volatile}/$src_dir/$src_file_name\">["; last };
+ /non-us/io && do {
+ $str .= "<a href=\"$env->{nonus_site}/$src_dir/$src_file_name\">["; last };
+ $str .= "<a href=\"$env->{us}/$src_dir/$src_file_name\">[";
+ }
if ($src_file_name =~ /dsc$/) {
$str .= "dsc";
} else {
# if ($src_version ne $version) && !$src_version_given_in_control;
}
-# if ($info{changesandcopy}) {
-# if ( $d->{src_directory} ) {
-# my $src_dir = $d->{src_directory};
-# (my $src_basename = $d->{src_version}) =~ s,^\d+:,,; # strip epoche
-# $src_basename = "$d->{src_name}_$src_basename";
-# $src_dir =~ s,pool/updates,pool,o;
-# $src_dir =~ s,pool/non-US,pool,o;
-# $str .= "<br>".sprintf( gettext( "View the <a href=\"%s\">Debian changelog</a>" ),
-# "$CHANGELOG_URL/$src_dir/$src_basename/changelog" )."<br>\n";
-# my $copyright_url = "$CHANGELOG_URL/$src_dir/$src_basename/";
-# $copyright_url .= ( $is_source ? 'copyright' : "$name.copyright" );
-
-# $str .= sprintf( gettext( "View the <a href=\"%s\">copyright file</a>" ),
-# $copyright_url )."</p>";
-# }
-# }
+ if ($info{changesandcopy}) {
+ if ( $src_dir ) {
+ (my $src_basename = $source_version) =~ s,^\d+:,,; # strip epoche
+ $src_basename = "${source}_$src_basename";
+ $src_dir =~ s,pool/updates,pool,o;
+ $src_dir =~ s,pool/non-US,pool,o;
+ $str .= "<br>".sprintf( gettext( "View the <a href=\"%s\">Debian changelog</a>" ),
+ "$CHANGELOG_URL/$src_dir/$src_basename/changelog" )."<br>\n";
+ my $copyright_url = "$CHANGELOG_URL/$src_dir/$src_basename/";
+ $copyright_url .= ( $is_source ? 'copyright' : "$name.copyright" );
+
+ $str .= sprintf( gettext( "View the <a href=\"%s\">copyright file</a>" ),
+ $copyright_url )."</p>";
+ }
+ }
if ($info{maintainers}) {
my @uploaders = @{$page->get_src( 'uploaders' )};
$pkg_version = "($pkg_version)" if $pkg_version;
my @results;
- read_entry( $packages, $p_name, \@results, $opts);
- if ( @results ) {
+ my %short_descs;
+ my $short_desc = $short_descs{$p_name} ||
+ (read_entry_simple( $packages, $p_name, $opts->{suite}))->[-1];
+ if ( $short_desc ) {
if ( $is_old_pkgs ) {
push @res_pkgs, dep_item( "/$opts->{suite}/$p_name",
$p_name, "$pkg_version$arch_str" );
} else {
- my $short_desc = encode_entities( $results[0][-1], "<>&\"" );
+ $short_descs{$p_name} ||= $short_desc;
+ $short_desc = encode_entities( $short_desc, "<>&\"" );
push @res_pkgs, dep_item( "/$opts->{suite}/$p_name",
$p_name, "$pkg_version$arch_str", $short_desc );
}
sub merge_data {
my ($self, $pkg, $version, $architecture, $data) = @_;
- local $/ = "";
- my $strio = IO::String->new($data);
- my $merged = 0;
- while (<$strio>) {
- next if /^\s*$/;
- my %data = ( package => $pkg,
+ my %data = ( package => $pkg,
version => $version,
architecture => $architecture );
- chomp;
- s/\n /\377/g;
- while (/^(\S+):\s*(.*)\s*$/mg) {
- my ($key, $value) = ($1, $2);
- $value =~ s/\377/\n /g;
- $key =~ tr [A-Z] [a-z];
- $data{$key} = $value;
- }
-# debug( "Merge package:\n".Dumper(\%data), 3 );
- $merged += $self->merge_package( \%data );
+ chomp($data);
+ while ($data =~ /^(\S+):\s*(.*)\s*$/mg) {
+ my ($key, $value) = ($1, $2);
+ $key =~ tr [A-Z] [a-z];
+ $data{$key} = $value;
}
- close DATA;
- return $merged;
+# debug( "Merge package:\n".Dumper(\%data), 3 );
+ return $self->merge_package( \%data );
}
sub gettext { return $_[0]; }
sub add_src_data {
my ($self, $src, $version, $data) = @_;
- local $/ = "";
- my $strio = IO::String->new($data);
- my %data;
- while (<$strio>) {
- next if /^\s*$/;
- chomp;
- %data = ();
- s/\n /\377/g;
- while (/^(\S+):\s*(.*)\s*$/mg) {
- my ($key, $value) = ($1, $2);
- $value =~ s/\377/\n /g;
- $key =~ tr [A-Z] [a-z];
- $data{$key} = $value;
- }
+ chomp($data);
+ my %data = ();
+ while ($data =~ /^(\S+):\s*(.*)\s*$/mg) {
+ my ($key, $value) = ($1, $2);
+ $key =~ tr [A-Z] [a-z];
+ $data{$key} = $value;
}
- close DATA;
$self->{src}{name} = $src;
$self->{src}{version} = $version;
push @{$self->{src}{files}}, [ split( /\s+/, $sf) ];
}
}
+ $self->{src}{directory} = $data{directory};
my @uploaders;
if ($data{maintainer} ||= '') {
push @uploaders, [ split_name_mail( $data{maintainer} ) ];
our @EXPORT_OK = qw( nextlink prevlink indexline
resperpagelink
- read_entry read_entry_all read_src_entry find_binaries
+ read_entry read_entry_all read_entry_simple
+ read_src_entry find_binaries
do_names_search do_fulltext_search
printindexline multipageheader );
our %EXPORT_TAGS = ( all => [ @EXPORT_OK ] );
sub read_entry_all {
my ($hash, $key, $results, $non_results, $opts) = @_;
my $result = $hash->{$key} || '';
- foreach (split /\000/, $result) {
- my @data = split ( /\s/, $_, 8 );
+ foreach (split /\000/o, $result) {
+ my @data = split ( /\s/o, $_, 8 );
debug( "Considering entry ".join( ':', @data), 2);
if ($opts->{h_archives}{$data[0]} && $opts->{h_suites}{$data[1]}
&& ($opts->{h_archs}{$data[2]} || $data[2] eq 'all')
my @non_results;
read_entry_all( $hash, $key, $results, \@non_results, $opts );
}
+sub read_entry_simple {
+ my ($hash, $key, $suite) = @_;
+ my $result = $hash->{$key} || '';
+ foreach (split /\000/o, $result) {
+ my @data = split ( /\s/o, $_, 8 );
+ debug( "Considering entry ".join( ':', @data), 2);
+ if ($data[1] eq $suite) {
+ debug( "Using entry ".join( ':', @data), 2);
+ return \@data;
+ }
+ }
+}
sub read_src_entry {
my ($hash, $key, $results, $opts) = @_;
my $result = $hash->{$key} || '';
- foreach (split /\000/, $result) {
- my @data = split ( /\s/, $_, 6 );
+ foreach (split /\000/o, $result) {
+ my @data = split ( /\s/o, $_, 6 );
debug( "Considering entry ".join( ':', @data), 2);
if ($opts->{h_archives}{$data[0]}
&& $opts->{h_suites}{$data[1]}