cgi-bin/show_package.pl

   1 #!/usr/bin/perl -wT
   2 # $Id$
   3 # show_package.pl -- CGI interface to show info about a package
   4 #
   5 # Copyright (C) 1998 James Treacy
   6 # Copyright (C) 2000, 2001 Josip Rodin
   7 # Copyright (C) 2001 Adam Heath
   8 # Copyright (C) 2004 Martin Schulze
   9 # Copyright (C) 2004-2006 Frank Lichtenheld
  10 # Copyright (C) 2006 Jeroen van Wolffelaar
  11 #
  12 # use is allowed under the terms of the GNU Public License (GPL)
  13 # see http://www.fsf.org/copyleft/gpl.html for a copy of the license
  14
  15 use strict;
  16 use lib '../lib';
  17 use CGI qw( -oldstyle_urls );
  18 use CGI::Carp qw( fatalsToBrowser );
  19 use POSIX;
  20 use URI::Escape;
  21 use HTML::Entities;
  22 use DB_File;
  23 use Benchmark;
  24
  25 use Deb::Versions;
  26 use Packages::Config qw( $DBDIR $ROOT @SUITES @ARCHIVES @SECTIONS
  27                          @ARCHITECTURES %FTP_SITES );
  28 use Packages::CGI;
  29 use Packages::DB;
  30 use Packages::Search qw( :all );
  31 use Packages::HTML;
  32 use Packages::Page ();
  33 use Packages::SrcPage ();
  34
  35 &Packages::CGI::reset;
  36
  37 $ENV{PATH} = "/bin:/usr/bin";
  38
  39 # Read in all the variables set by the form
  40 my $input;
  41 if ($ARGV[0] && ($ARGV[0] eq 'php')) {
  42         $input = new CGI(\*STDIN);
  43 } else {
  44         $input = new CGI;
  45 }
  46
  47 my $pet0 = new Benchmark;
  48 my $tet0 = new Benchmark;
  49 # use this to disable debugging in production mode completly
  50 my $debug_allowed = 1;
  51 my $debug = $debug_allowed && $input->param("debug");
  52 $debug = 0 if !defined($debug) || $debug !~ /^\d+$/o;
  53 $Packages::CGI::debug = $debug;
  54
  55 &Packages::Config::init( '../' );
  56 &Packages::DB::init();
  57
  58 if (my $path = $input->param('path')) {
  59     my @components = map { lc $_ } split /\//, $path;
  60
  61     my %SUITES = map { $_ => 1 } @SUITES;
  62     my %SECTIONS = map { $_ => 1 } @SECTIONS;
  63     my %ARCHIVES = map { $_ => 1 } @ARCHIVES;
  64     my %ARCHITECTURES = map { $_ => 1 } @ARCHITECTURES;
  65
  66     foreach (@components) {
  67         if ($SUITES{$_}) {
  68             $input->param('suite', $_);
  69         } elsif ($SECTIONS{$_}) {
  70             $input->param('section', $_);
  71         } elsif ($ARCHIVES{$_}) {
  72             $input->param('archive', $_);
  73         } elsif ($ARCHITECTURES{$_}) {
  74             $input->param('arch', $_);
  75         } elsif ($_ eq 'source') {
  76             $input->param('source', 1);
  77         }
  78     }
  79 }
  80
  81 my ( $pkg, $suite, @sections, @archs, @archives, $format );
  82 my %params_def = ( package => { default => undef, match => '^([a-z0-9.+-]+)$',
  83                                 var => \$pkg },
  84                    suite => { default => undef, match => '^(\w+)$',
  85                               var => \$suite },
  86                    archive => { default => 'all', match => '^(\w+)$',
  87                                 array => ',', var => \@archives,
  88                                 replace => { all => [qw(us security non-US)] } },
  89                    section => { default => 'all', match => '^(\w+)$',
  90                                 array => ',', var => \@sections,
  91                                 replace => { all => \@SECTIONS } },
  92                    arch => { default => 'any', match => '^(\w+)$',
  93                              array => ',', var => \@archs,
  94                              replace => { any => \@ARCHITECTURES } },
  95                    format => { default => 'html', match => '^(\w+)$',
  96                                var => \$format },
  97                    source => { default => 0, match => '^(\d+)$' },
  98                    );
  99 my %opts;
 100 my %params = Packages::Search::parse_params( $input, \%params_def, \%opts );
 101
 102 #XXX: Don't use alternative output formats yet
 103 $format = 'html';
 104 if ($format eq 'html') {
 105     print $input->header( -charset => 'utf-8' );
 106 }
 107
 108 if ($params{errors}{package}) {
 109     fatal_error( "package not valid or not specified" );
 110     $pkg = '';
 111 }
 112 if ($params{errors}{suite}) {
 113     fatal_error( "suite not valid or not specified" );
 114     $suite = '';
 115 }
 116
 117 $opts{h_suites} =   { $suite => 1 };
 118 $opts{h_archs} =    { map { $_ => 1 } @archs };
 119 $opts{h_sections} = { map { $_ => 1 } @sections };
 120 $opts{h_archives} = { map { $_ => 1 } @archives };
 121
 122 my $DL_URL = "$pkg/download";
 123 my $FILELIST_URL = "$pkg/files";
 124
 125 our (%packages_all, %sources_all);
 126 my (@results, @non_results);
 127 my $page = $opts{source} ?
 128     new Packages::SrcPage( $pkg ) :
 129     new Packages::Page( $pkg );
 130 my $package_page = "";
 131 my ($short_desc, $version, $archive, $section, $subsection) = ("")x5;
 132
 133 sub gettext { return $_[0]; };
 134
 135 my $st0 = new Benchmark;
 136 unless (@Packages::CGI::fatal_errors) {
 137     tie %packages_all, 'DB_File', "$DBDIR/packages_all_$suite.db",
 138     O_RDONLY, 0666, $DB_BTREE
 139         or die "couldn't tie DB $DBDIR/packages_all_$suite.db: $!";
 140     tie %sources_all, 'DB_File', "$DBDIR/sources_all_$suite.db",
 141     O_RDONLY, 0666, $DB_BTREE
 142         or die "couldn't tie DB $DBDIR/sources_all_$suite.db: $!";
 143
 144     unless ($opts{source}) {
 145         read_entry_all( \%packages, $pkg, \@results, \@non_results, \%opts );
 146
 147         unless (@results || @non_results ) {
 148             fatal_error( "No such package".
 149                          "{insert link to search page with substring search}" );
 150         } else {
 151             unless (@results) {
 152                 fatal_error( "Package not available in this suite" );
 153             } else {
 154                 for my $entry (@results) {
 155                     debug( join(":", @$entry), 1 );
 156                     my (undef, $archive, undef, $arch, $section, $subsection,
 157                         $priority, $version, $provided_by) = @$entry;
 158
 159                     if ($arch ne 'virtual') {
 160                         my %data = split /\000/, $packages_all{"$pkg $arch $version"};
 161                         $data{package} = $pkg;
 162                         $data{architecture} = $arch;
 163                         $data{version} = $version;
 164                         $page->merge_package(\%data) or debug( "Merging $pkg $arch $version FAILED", 2 );
 165                     } else {
 166                         $page->add_provided_by([split /\s+/, $provided_by]);
 167                     }
 168                 }
 169
 170                 unless ($page->is_virtual()) {
 171                     $version = $page->{newest};
 172                     my $source = $page->get_newest( 'source' );
 173                     $archive = $page->get_newest( 'archive' );
 174                     debug( "find source package: source=$source", 1);
 175                     my $src_data = $sources_all{"$archive $suite $source"};
 176                     $page->add_src_data( $source, $src_data )
 177                         if $src_data;
 178
 179                     my $st1 = new Benchmark;
 180                     my $std = timediff($st1, $st0);
 181                     debug( "Data search and merging took ".timestr($std) );
 182
 183                     my $encodedpkg = uri_escape( $pkg );
 184                     my ($v_str, $v_str_arch, $v_str_arr) = $page->get_version_string();
 185                     my $did = $page->get_newest( 'description' );
 186                     $section = $page->get_newest( 'section' );
 187                     $subsection = $page->get_newest( 'subsection' );
 188                     my $filenames = $page->get_arch_field( 'filename' );
 189                     my $file_md5sums = $page->get_arch_field( 'md5sum' );
 190                     my $archives = $page->get_arch_field( 'archive' );
 191                     my $sizes_inst = $page->get_arch_field( 'installed-size' );
 192                     my $sizes_deb = $page->get_arch_field( 'size' );
 193                     my @archs = sort $page->get_architectures;
 194
 195                     # process description
 196                     #
 197                     my $desc = $descriptions{$did};
 198                     $short_desc = encode_entities( $1, "<>&\"" )
 199                         if $desc =~ s/^(.*)$//m;
 200                     my $long_desc = encode_entities( $desc, "<>&\"" );
 201
 202                     $long_desc =~ s,((ftp|http|https)://[\S~-]+?/?)((\&gt\;)?[)]?[']?[:.\,]?(\s|$)),<a href=\"$1\">$1</a>$3,go; # syntax highlighting -> '];
 203                     $long_desc =~ s/\A //o;
 204                     $long_desc =~ s/\n /\n/sgo;
 205                     $long_desc =~ s/\n.\n/\n<p>\n/go;
 206                     $long_desc =~ s/(((\n|\A) [^\n]*)+)/\n<pre>$1\n<\/pre>/sgo;
 207 #           $long_desc = conv_desc( $lang, $long_desc );
 208 #           $short_desc = conv_desc( $lang, $short_desc );
 209
 210                     my %all_suites;
 211                     foreach (@results, @non_results) {
 212                         my $a = $_->[1];
 213                         my $s = $_->[2];
 214                         if ($a =~ /^(?:us|security|non-US)$/o) {
 215                             $all_suites{$s}++;
 216                         } else {
 217                             $all_suites{"$s/$a"}++;
 218                         }
 219                     }
 220                     foreach (suites_sort(keys %all_suites)) {
 221                         if (("$suite/$archive" eq $_)
 222                             || (!$all_suites{"$suite/$archive"} && ($suite eq $_))) {
 223                             $package_page .= "[ <strong>$_</strong> ] ";
 224                         } else {
 225                             $package_page .=
 226                                 "[ <a href=\"$ROOT/$_/".uri_escape($pkg)."\">$_</a> ] ";
 227                         }
 228                     }
 229                     $package_page .= '<br>';
 230
 231                     $package_page .= simple_menu( [ gettext( "Distribution:" ),
 232                                                     gettext( "Overview over this suite" ),
 233                                                     "$ROOT/$suite/",
 234                                                     $suite ],
 235                                                   [ gettext( "Section:" ),
 236                                                     gettext( "All packages in this section" ),
 237                                                     "$ROOT/$suite/$subsection/",
 238                                                     $subsection ],
 239                                                   );
 240
 241                     my $title .= sprintf( gettext( "Package: %s (%s)" ), $pkg, $v_str );
 242                     $title .=  " ".marker( $archive ) if $archive ne 'us';
 243                     $title .=  " ".marker( $subsection ) if $subsection eq 'non-US'
 244                         and $archive ne 'non-US'; # non-US/security
 245                     $title .=  " ".marker( $section ) if $section ne 'main';
 246                     $package_page .= title( $title );
 247
 248                     $package_page .= "<h2>".gettext( "Versions:" )." $v_str_arch</h2>\n"
 249                         unless $version eq $v_str;
 250                     if (my $provided_by = $page->{provided_by}) {
 251                         note( gettext( "This is also a virtual package provided by ").join( ', ', map { "<a href=\"$ROOT/$suite/$_\">$_</a>"  } @$provided_by) );
 252                     }
 253
 254                     if ($suite eq "experimental") {
 255                         note( gettext( "Experimental package"),
 256                               gettext( "Warning: This package is from the <span class=\"pred\">experimental</span> 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.")."</p><p>".
 257                               gettext( "Users of experimental packages are encouraged to contact the package maintainers directly in case of problems." )
 258                               );
 259                     }
 260                     if ($subsection eq "debian-installer") {
 261                         note( gettext( "debian-installer udeb package"),
 262                               gettext( "Warning: This package is intended for the use in building <a href=\"http://www.debian.org/devel/debian-installer\">debian-installer</a> images only. Do not install it on a normal Debian system." )
 263                               );
 264                     }
 265                     $package_page .= pdesc( $short_desc, $long_desc );
 266
 267                     #
 268                     # display dependencies
 269                     #
 270                     my $dep_list;
 271                     $dep_list = print_deps( \%packages, \%opts, $pkg,
 272                                             $page->get_dep_field('depends'),
 273                                             'depends' );
 274                     $dep_list .= print_deps( \%packages, \%opts, $pkg,
 275                                              $page->get_dep_field('recommends'),
 276                                              'recommends' );
 277                     $dep_list .= print_deps( \%packages, \%opts, $pkg,
 278                                              $page->get_dep_field('suggests'),
 279                                              'suggests' );
 280
 281                     if ( $dep_list ) {
 282                         $package_page .= "<div id=\"pdeps\">\n";
 283                         $package_page .= sprintf( "<h2>".gettext( "Other Packages Related to %s" )."</h2>\n", $pkg );
 284                         if ($suite eq "experimental") {
 285                             note( gettext( "Note that the \"<span class=\"pred\">experimental</span>\" distribution is not self-contained; missing dependencies are likely found in the \"<a href=\"/unstable/\">unstable</a>\" distribution." ) );
 286                         }
 287
 288                         $package_page .= pdeplegend( [ 'dep',  gettext( 'depends' ) ],
 289                                                      [ 'rec',  gettext( 'recommends' ) ],
 290                                                      [ 'sug',  gettext( 'suggests' ) ], );
 291
 292                         $package_page .= $dep_list;
 293                         $package_page .= "</div> <!-- end pdeps -->\n";
 294                     }
 295
 296                     #
 297                     # Download package
 298                     #
 299                     my $encodedpack = uri_escape( $pkg );
 300                     $package_page .= "<div id=\"pdownload\">";
 301                     $package_page .= sprintf( "<h2>".gettext( "Download %s\n" )."</h2>",
 302                                               $pkg ) ;
 303                     $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";
 304                     $package_page .= "<caption class=\"hidecss\">".gettext("Download for all available architectures")."</caption>\n";
 305                     $package_page .= "<tr>\n";
 306                     $package_page .= "<th>".gettext("Architecture")."</th><th>".gettext("Files")."</th><th>".gettext( "Package Size")."</th><th>".gettext("Installed Size")."</th></tr>\n";
 307                     foreach my $a ( @archs ) {
 308                         $package_page .= "<tr>\n";
 309                         $package_page .=  "<th><a href=\"$ROOT/$suite/$encodedpkg/$a/download";
 310                         $package_page .=  "\">$a</a></th>\n";
 311                         $package_page .= "<td>";
 312                         if ( $suite ne "experimental" ) {
 313                             $package_page .= sprintf( "[<a href=\"%s\">".gettext( "list of files" )."</a>]\n",
 314                                                       "$ROOT/$suite/$encodedpkg/$a/filelist", $pkg );
 315                         } else {
 316                             $package_page .= gettext( "no current information" );
 317                         }
 318                         $package_page .= "</td>\n<td align=right>"; #FIXME: css
 319                         $package_page .=  floor(($sizes_deb->{$a}/102.4)+0.5)/10 . "&nbsp;kB";
 320                         $package_page .= "</td>\n<td align=right>"; #FIXME: css
 321                         $package_page .=  $sizes_inst->{$a} . "&nbsp;kB";
 322                         $package_page .= "</td>\n</tr>";
 323                     }
 324                     $package_page .= "</table>\n";
 325                     $package_page .= "</div> <!-- end pdownload -->\n";
 326
 327                     #
 328                     # more information
 329                     #
 330                     $package_page .= pmoreinfo( name => $pkg, data => $page,
 331                                                 opts => \%opts,
 332                                                 env => \%FTP_SITES,
 333                                                 bugreports => 1, sourcedownload => 1,
 334                                                 changesandcopy => 1, maintainers => 1,
 335                                                 search => 1 );
 336                 } else { # unless $page->is_virtual
 337                     $short_desc = gettext( "virtual package" );
 338
 339                     my %all_suites;
 340                     foreach (@results, @non_results) {
 341                         my $a = $_->[1];
 342                         my $s = $_->[2];
 343                         if ($a =~ /^(?:us|security|non-US)$/o) {
 344                             $all_suites{$s}++;
 345                         } else {
 346                             $all_suites{"$s/$a"}++;
 347                         }
 348                     }
 349                     foreach (suites_sort(keys %all_suites)) {
 350                         if (("$suite/$archive" eq $_)
 351                             || (!$all_suites{"$suite/$archive"} && ($suite eq $_))) {
 352                             $package_page .= "[ <strong>$_</strong> ] ";
 353                         } else {
 354                             $package_page .=
 355                                 "[ <a href=\"$ROOT/$_/".uri_escape($pkg)."\">$_</a> ] ";
 356                         }
 357                     }
 358                     $package_page .= '<br>';
 359                     $package_page .= simple_menu( [ gettext( "Distribution:" ),
 360                                                     gettext( "Overview over this distribution" ),
 361                                                     "$ROOT/",
 362                                                     $suite ],
 363                                                   [ gettext( "Section:" ),
 364                                                     gettext( "All packages in this section" ),
 365                                                     "$ROOT/$suite/virtual/",
 366
 367                                                     'virtual' ], );
 368
 369                     $package_page .= title( sprintf( gettext( "Virtual Package: %s" ),
 370                                                      $pkg ) );
 371
 372                     my $policy_url = 'http://www.debian.org/doc/debian-policy/';
 373                     note( sprintf( gettext( "This is a <em>virtual package</em>. See the <a href=\"%s\">Debian policy</a> for a <a href=\"%sch-binary.html#s-virtual_pkg\">definition of virtual packages</a>." ),
 374                                    $policy_url, $policy_url ));
 375
 376                     $package_page .= sprintf( "<h2>".gettext( "Packages providing %s" )."</h2>",                              $pkg );
 377                           my $provided_by = $page->{provided_by};
 378                     $package_page .= pkg_list( \%packages, \%opts, $provided_by, 'en');
 379
 380                 } # else (unless $page->is_virtual)
 381             } # else (unless @results)
 382         } # else (unless (@results || @non_results ))
 383     } else {
 384         read_src_entry_all( \%sources, $pkg, \@results, \@non_results, \%opts );
 385
 386         unless (@results || @non_results ) {
 387             fatal_error( "No such package".
 388                          "{insert link to search page with substring search}" );
 389         } else {
 390             unless (@results) {
 391                 fatal_error( "Package not available in this suite" );
 392             } else {
 393                 for my $entry (@results) {
 394                     debug( join(":", @$entry), 1 );
 395                     my (undef, $archive, undef, $section, $subsection,
 396                         $priority, $version) = @$entry;
 397
 398                     my $data = $sources_all{"$archive $suite $pkg"};
 399                     $page->merge_data($pkg, $suite, $archive, $data) or debug( "Merging $pkg $version FAILED", 2 );
 400                 }
 401                 $version = $page->{version};
 402
 403                 my $st1 = new Benchmark;
 404                 my $std = timediff($st1, $st0);
 405                 debug( "Data search and merging took ".timestr($std) );
 406
 407                 my $encodedpkg = uri_escape( $pkg );
 408                 my ($v_str, $v_str_arr) = $page->get_version_string();
 409                 $archive = $page->get_newest( 'archive' );
 410                 $section = $page->get_newest( 'section' );
 411                 $subsection = $page->get_newest( 'subsection' );
 412
 413                 my %all_suites;
 414                 foreach (@results, @non_results) {
 415                     my $a = $_->[1];
 416                     my $s = $_->[2];
 417                     if ($a =~ /^(?:us|security|non-US)$/o) {
 418                         $all_suites{$s}++;
 419                     } else {
 420                         $all_suites{"$s/$a"}++;
 421                     }
 422                 }
 423                 foreach (suites_sort(keys %all_suites)) {
 424                     if (("$suite/$archive" eq $_)
 425                         || (!$all_suites{"$suite/$archive"} && ($suite eq $_))) {
 426                         $package_page .= "[ <strong>$_</strong> ] ";
 427                     } else {
 428                         $package_page .=
 429                             "[ <a href=\"$ROOT/$_/source/".uri_escape($pkg)."\">$_</a> ] ";
 430                     }
 431                 }
 432                 $package_page .= '<br>';
 433
 434                 $package_page .= simple_menu( [ gettext( "Distribution:" ),
 435                                                 gettext( "Overview over this suite" ),
 436                                                 "/$suite/",
 437                                                 $suite ],
 438                                               [ gettext( "Section:" ),
 439                                                 gettext( "All packages in this section" ),
 440                                                 "/$suite/$subsection/",
 441                                                 $subsection ],
 442                                               );
 443
 444                 my $title .= sprintf( gettext( "Source Package: %s (%s)" ),
 445                                       $pkg, $v_str );
 446                 $title .=  " ".marker( $archive ) if $archive ne 'us';
 447                 $title .=  " ".marker( $subsection ) if $subsection eq 'non-US'
 448                     and $archive ne 'non-US'; # non-US/security
 449                 $title .=  " ".marker( $section ) if $section ne 'main';
 450                 $package_page .= title( $title );
 451
 452                 if ($suite eq "experimental") {
 453                     $package_page .= note( gettext( "Experimental package"),
 454                                            gettext( "Warning: This package is from the <span class=\"pred\">experimental</span> 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.")."</p><p>".
 455                                            gettext( "Users of experimental packages are encouraged to contact the package maintainers directly in case of problems." )
 456                                            );
 457                 }
 458                 if ($subsection eq "debian-installer") {
 459                     note( gettext( "debian-installer udeb package"),
 460                           gettext( "Warning: This package is intended for the use in building <a href=\"http://www.debian.org/devel/debian-installer\">debian-installer</a> images only. Do not install it on a normal Debian system." )
 461                           );
 462                 }
 463
 464                 my $binaries = find_binaries( $pkg, $archive, $suite, \%src2bin );
 465                 if ($binaries && @$binaries) {
 466                     $package_page .= '<div class="pdesc">';
 467                     $package_page .= gettext( "The following binary packages are built from this source package:" );
 468                     $package_page .= pkg_list( \%packages, \%opts, $binaries, 'en' );
 469                     $package_page .= '</div> <!-- end pdesc -->';
 470                 }
 471
 472                 #
 473                 # display dependencies
 474                 #
 475                 my $dep_list;
 476                 $dep_list = print_src_deps( \%packages, \%opts, $pkg,
 477                                             $page->get_dep_field('build-depends'),
 478                                             'build-depends' );
 479                 $dep_list .= print_src_deps( \%packages, \%opts, $pkg,
 480                                              $page->get_dep_field('build-depends-indep'),
 481                                              'build-depends-indep' );
 482
 483                 if ( $dep_list ) {
 484                     $package_page .= "<div id=\"pdeps\">\n";
 485                     $package_page .= sprintf( "<h2>".gettext( "Other Packages Related to %s" )."</h2>\n", $pkg );
 486                     if ($suite eq "experimental") {
 487                         note( gettext( "Note that the \"<span class=\"pred\">experimental</span>\" distribution is not self-contained; missing dependencies are likely found in the \"<a href=\"/unstable/\">unstable</a>\" distribution." ) );
 488                     }
 489
 490                     $package_page .= pdeplegend( [ 'adep',  gettext( 'build-depends' ) ],
 491                                                  [ 'idep',  gettext( 'build-depends-indep' ) ],
 492                                                  );
 493
 494                     $package_page .= $dep_list;
 495                     $package_page .= "</div> <!-- end pdeps -->\n";
 496                 }
 497
 498                 #
 499                 # Source package download
 500                 #
 501                 $package_page .= "<div id=\"pdownload\">\n";
 502                 my $encodedpack = uri_escape( $pkg );
 503                 $package_page .= sprintf( "<h2>".gettext( "Download %s" )."</h2>\n",
 504                                           $pkg ) ;
 505
 506                 my $source_files = $page->get_src( 'files' );
 507                 my $source_dir = $page->get_src( 'directory' );
 508
 509                 $package_page .= sprintf( "<table cellspacing=\"0\" cellpadding=\"2\" summary=\"Download information for the files of this source package\">\n"
 510                                           ."<tr><th>%s</th><th>%s</th><th>%s</th>",
 511                                           gettext("File"),
 512                                           gettext("Size (in kB)"),
 513                                           gettext("md5sum") );
 514                 foreach( @$source_files ) {
 515                     my ($src_file_md5, $src_file_size, $src_file_name)
 516                         = split /\s+/, $_;
 517                     my $src_url;
 518                     for ($archive) {
 519                         /security/o &&  do {
 520                             $src_url = $FTP_SITES{security}; last };
 521                         /volatile/o &&  do {
 522                             $src_url = $FTP_SITES{volatile}; last };
 523                         /backports/o &&  do {
 524                             $src_url = $FTP_SITES{backports}; last };
 525                         /non-us/io  &&  do {
 526                             $src_url = $FTP_SITES{'non-US'}; last };
 527                         $src_url = $FTP_SITES{us};
 528                     }
 529                     $src_url .= "/$source_dir/$src_file_name";
 530
 531                     $package_page .= "<tr><td><a href=\"$src_url\">$src_file_name</a></td>\n"
 532                         ."<td class=\"dotalign\">".sprintf("%.1f", (floor(($src_file_size/102.4)+0.5)/10))."</td>\n"
 533                         ."<td>$src_file_md5</td></tr>";
 534                 }
 535                 $package_page .= "</table>\n";
 536                 $package_page .= "</div> <!-- end pdownload -->\n";
 537
 538                 #
 539                 # more information
 540                 #
 541                 $package_page .= pmoreinfo( name => $pkg, data => $page,
 542                                             opts => \%opts,
 543                                             env => \%FTP_SITES,
 544                                             bugreports => 1,
 545                                             changesandcopy => 1, maintainers => 1,
 546                                             search => 1, is_source => 1 );
 547             }
 548         }
 549     }
 550 }
 551
 552 use Data::Dumper;
 553 debug( "Final page object:\n".Dumper($page), 3 );
 554
 555 my $title = $opts{source} ?
 556     "Details of source package <em>$pkg</em> in $suite"  :
 557     "Details of package <em>$pkg</em> in $suite" ;
 558 my $title_tag = $opts{source} ?
 559     "Details of source package $pkg in $suite"  :
 560     "Details of package $pkg in $suite" ;
 561 print Packages::HTML::header( title => $title ,
 562                               lang => 'en',
 563                               desc => $short_desc,
 564                               keywords => "$suite, $archive, $section, $subsection, $version",
 565                               title_tag => "Details of package $pkg in $suite",
 566                               );
 567
 568 print_errors();
 569 print_hints();
 570 print_msgs();
 571 print_debug();
 572 print_notes();
 573
 574 unless (@Packages::CGI::fatal_errors) {
 575     print $package_page;
 576 }
 577 my $tet1 = new Benchmark;
 578 my $tetd = timediff($tet1, $tet0);
 579 print "Total page evaluation took ".timestr($tetd)."<br>"
 580     if $debug_allowed;
 581
 582 my $trailer = Packages::HTML::trailer( $ROOT );
 583 $trailer =~ s/LAST_MODIFIED_DATE/gmtime()/e; #FIXME
 584 print $trailer;
 585
 586 # vim: ts=8 sw=4