lib/Packages/DoShow.pm

   1 package Packages::DoShow;
   2
   3 use strict;
   4
   5 use POSIX;
   6 use URI::Escape;
   7 use HTML::Entities;
   8 use DB_File;
   9 use Benchmark ':hireswallclock';
  10 use Exporter;
  11
  12 use Deb::Versions;
  13 use Packages::Config qw( $DBDIR $ROOT @SUITES @ARCHIVES @SECTIONS
  14                          @ARCHITECTURES %FTP_SITES $SEARCH_URL );
  15 use Packages::I18N::Locale;
  16 use Packages::CGI;
  17 use Packages::DB;
  18 use Packages::Search qw( :all );
  19 use Packages::HTML;
  20 use Packages::Page ();
  21 use Packages::SrcPage ();
  22
  23 our @ISA = qw( Exporter );
  24 our @EXPORT = qw( do_show );
  25
  26 sub do_show {
  27     my ($params, $opts, $html_header, $menu, $page_content) = @_;
  28
  29     if ($params->{errors}{package}) {
  30         fatal_error( _g( "package not valid or not specified" ) );
  31     }
  32     if ($params->{errors}{suite}) {
  33         fatal_error( _g( "suite not valid or not specified" ) );
  34     }
  35     if (@{$opts->{suite}} > 1) {
  36         fatal_error( sprintf( _g( "more than one suite specified for show (%s)" ), "@{$opts->{suite}}" ) );
  37     }
  38
  39     my $pkg = $opts->{package};
  40     my $encodedpkg = uri_escape( $pkg );
  41     my $suite = $opts->{suite}[0];
  42     my $archive = $opts->{archive}[0] ||'';
  43
  44     my $DL_URL = "$pkg/download";
  45     my $FILELIST_URL = "$pkg/files";
  46
  47     our (%packages_all, %sources_all);
  48     my (@results, @non_results);
  49     my $page = $opts->{source} ?
  50         new Packages::SrcPage( $pkg ) :
  51         new Packages::Page( $pkg );
  52     my $package_page = "";
  53     my ($short_desc, $version, $section, $subsection) = ("")x5;
  54
  55     my $st0 = new Benchmark;
  56     unless (@Packages::CGI::fatal_errors) {
  57         tie %packages_all, 'DB_File', "$DBDIR/packages_all_$suite.db",
  58         O_RDONLY, 0666, $DB_BTREE
  59             or die "couldn't tie DB $DBDIR/packages_all_$suite.db: $!";
  60         tie %sources_all, 'DB_File', "$DBDIR/sources_all_$suite.db",
  61         O_RDONLY, 0666, $DB_BTREE
  62             or die "couldn't tie DB $DBDIR/sources_all_$suite.db: $!";
  63
  64         unless ($opts->{source}) {
  65             read_entry_all( \%packages, $pkg, \@results, \@non_results, $opts );
  66         } else {
  67             read_src_entry_all( \%sources, $pkg, \@results, \@non_results, $opts );
  68         }
  69
  70         unless (@results || @non_results ) {
  71             fatal_error( _g( "No such package." )."<br>".
  72                          sprintf( _g( '<a href="%s">Search for the package</a>' ), "$SEARCH_URL/$pkg" ) );
  73         } else {
  74             my %all_suites;
  75             foreach (@results, @non_results) {
  76                 my $a = $_->[1];
  77                 my $s = $_->[2];
  78                 if ($a =~ /^(?:us|security|non-US)$/o) {
  79                     $all_suites{$s}++;
  80                 } else {
  81                     $all_suites{"$s/$a"}++;
  82                 }
  83             }
  84             foreach (suites_sort(keys %all_suites)) {
  85                 if (("$suite/$archive" eq $_)
  86                     || (!$all_suites{"$suite/$archive"} && ($suite eq $_))) {
  87                     $$menu .= "[ <strong>$_</strong> ] ";
  88                 } else {
  89                     $$menu .=
  90                         "[ <a href=\"$ROOT/$_/$encodedpkg\">$_</a> ] ";
  91                 }
  92             }
  93             $$menu .= '<br>';
  94
  95             unless (@results) {
  96                 fatal_error( _g( "Package not available in this suite." ) );
  97             } else {
  98                 unless ($opts->{source}) {
  99                     for my $entry (@results) {
 100                         debug( join(":", @$entry), 1 );
 101                         my (undef, $archive, undef, $arch, $section, $subsection,
 102                             $priority, $version, $provided_by) = @$entry;
 103
 104                         if ($arch ne 'virtual') {
 105                             my %data = split /\000/, $packages_all{"$pkg $arch $version"};
 106                             $data{package} = $pkg;
 107                             $data{architecture} = $arch;
 108                             $data{version} = $version;
 109                             $page->merge_package(\%data) or debug( "Merging $pkg $arch $version FAILED", 2 );
 110                         } else {
 111                             $page->add_provided_by([split /\s+/, $provided_by]);
 112                         }
 113                     }
 114
 115                     unless ($page->is_virtual()) {
 116                         $version = $page->{newest};
 117                         my $source = $page->get_newest( 'source' );
 118                         $archive = $page->get_newest( 'archive' );
 119                         debug( "find source package: source=$source", 1);
 120                         my $src_data = $sources_all{"$archive $suite $source"};
 121                         $page->add_src_data( $source, $src_data )
 122                             if $src_data;
 123
 124                         my $st1 = new Benchmark;
 125                         my $std = timediff($st1, $st0);
 126                         debug( "Data search and merging took ".timestr($std) );
 127
 128                         my ($v_str, $v_str_arch, $v_str_arr) = $page->get_version_string();
 129                         my $did = $page->get_newest( 'description' );
 130                         $section = $page->get_newest( 'section' );
 131                         $subsection = $page->get_newest( 'subsection' );
 132                         my $filenames = $page->get_arch_field( 'filename' );
 133                         my $file_md5sums = $page->get_arch_field( 'md5sum' );
 134                         my $archives = $page->get_arch_field( 'archive' );
 135                         my $sizes_inst = $page->get_arch_field( 'installed-size' );
 136                         my $sizes_deb = $page->get_arch_field( 'size' );
 137                         my @archs = sort $page->get_architectures;
 138
 139                         # process description
 140                         #
 141                         my $desc = $descriptions{$did};
 142                         $short_desc = encode_entities( $1, "<>&\"" )
 143                             if $desc =~ s/^(.*)$//m;
 144                         my $long_desc = encode_entities( $desc, "<>&\"" );
 145
 146                         $long_desc =~ s,((ftp|http|https)://[\S~-]+?/?)((\&gt\;)?[)]?[']?[:.\,]?(\s|$)),<a href=\"$1\">$1</a>$3,go; # syntax highlighting -> '];
 147                         $long_desc =~ s/\A //o;
 148                         $long_desc =~ s/\n /\n/sgo;
 149                         $long_desc =~ s/\n.\n/\n<p>\n/go;
 150                         $long_desc =~ s/(((\n|\A) [^\n]*)+)/\n<pre>$1\n<\/pre>/sgo;
 151 #           $long_desc = conv_desc( $lang, $long_desc );
 152 #           $short_desc = conv_desc( $lang, $short_desc );
 153
 154                         $$menu .= simple_menu( [ _g( "Distribution:" ),
 155                                                  _g( "Overview over this suite" ),
 156                                                  "$ROOT/$suite/",
 157                                                  $suite ],
 158                                                [ _g( "Section:" ),
 159                                                  _g( "All packages in this section" ),
 160                                                  "$ROOT/$suite/$subsection/",
 161                                                  $subsection ],
 162                                                );
 163
 164                         my $title .= sprintf( _g( "Package: %s (%s)" ), $pkg, $v_str );
 165                         $title .=  " ".marker( $archive ) if $archive ne 'us';
 166                         $title .=  " ".marker( $subsection ) if $subsection eq 'non-US'
 167                             and $archive ne 'non-US'; # non-US/security
 168                         $title .=  " ".marker( $section ) if $section ne 'main';
 169                         $package_page .= title( $title );
 170
 171                         $package_page .= "<h2>"._g( "Versions:" )." $v_str_arch</h2>\n"
 172                             unless $version eq $v_str;
 173                         if (my $provided_by = $page->{provided_by}) {
 174                             note( _g( "This is also a virtual package provided by ").join( ', ', map { "<a href=\"$ROOT/$suite/$_\">$_</a>"  } @$provided_by) );
 175                         }
 176
 177                         if ($suite eq "experimental") {
 178                             note( _g( "Experimental package"),
 179                                   _g( "Warning: This package is from the <strong>experimental</strong> 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>"
 180                                   );
 181                         }
 182                         if ($subsection eq "debian-installer") {
 183                             note( _g( "debian-installer udeb package"),
 184                                   _g( '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.' )
 185                                   );
 186                         }
 187                         $package_page .= pdesc( $short_desc, $long_desc );
 188
 189                         #
 190                         # display dependencies
 191                         #
 192                         my $dep_list;
 193                         $dep_list = print_deps( \%packages, $opts, $pkg,
 194                                                 $page->get_dep_field('depends'),
 195                                                 'depends' );
 196                         $dep_list .= print_deps( \%packages, $opts, $pkg,
 197                                                  $page->get_dep_field('recommends'),
 198                                                  'recommends' );
 199                         $dep_list .= print_deps( \%packages, $opts, $pkg,
 200                                                  $page->get_dep_field('suggests'),
 201                                                  'suggests' );
 202
 203                         if ( $dep_list ) {
 204                             $package_page .= "<div id=\"pdeps\">\n";
 205                             $package_page .= sprintf( "<h2>"._g( "Other Packages Related to %s" )."</h2>\n", $pkg );
 206                             if ($suite eq "experimental") {
 207                                 note( sprintf( _g( 'Note that the <strong>experimental</strong> distribution is not self-contained; missing dependencies are likely found in the <a href="%s">unstable</a> distribution.' ), "$ROOT/unstable/" ) );
 208                             }
 209
 210                             $package_page .= pdeplegend( [ 'dep',  _g( 'depends' ) ],
 211                                                          [ 'rec',  _g( 'recommends' ) ],
 212                                                          [ 'sug',  _g( 'suggests' ) ], );
 213
 214                             $package_page .= $dep_list;
 215                             $package_page .= "</div> <!-- end pdeps -->\n";
 216                         }
 217
 218                         #
 219                         # Download package
 220                         #
 221                         my $encodedpack = uri_escape( $pkg );
 222                         $package_page .= "<div id=\"pdownload\">";
 223                         $package_page .= sprintf( "<h2>"._g( "Download %s\n" )."</h2>",
 224                                                   $pkg ) ;
 225                         $package_page .= "<table summary=\""._g("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";
 226                         $package_page .= "<caption class=\"hidecss\">"._g("Download for all available architectures")."</caption>\n";
 227                         $package_page .= "<tr>\n";
 228                         $package_page .= "<th>"._g("Architecture")."</th><th>"._g("Files")."</th><th>"._g( "Package Size")."</th><th>"._g("Installed Size")."</th></tr>\n";
 229                         foreach my $a ( @archs ) {
 230                             $package_page .= "<tr>\n";
 231                             $package_page .=  "<th><a href=\"$ROOT/$suite/$encodedpkg/$a/download";
 232                             $package_page .=  "\">$a</a></th>\n";
 233                             $package_page .= "<td>";
 234                             if ( $suite ne "experimental" ) {
 235                                 $package_page .= sprintf( "[<a href=\"%s\">"._g( "list of files" )."</a>]\n",
 236                                                           "$ROOT/$suite/$encodedpkg/$a/filelist", $pkg );
 237                             } else {
 238                                 $package_page .= _g( "no current information" );
 239                             }
 240                             $package_page .= '</td><td class="size">';
 241                             $package_page .=  floor(($sizes_deb->{$a}/102.4)+0.5)/10 . "&nbsp;kB";
 242                             $package_page .= '</td><td class="size">';
 243                             $package_page .=  $sizes_inst->{$a} . "&nbsp;kB";
 244                             $package_page .= "</td>\n</tr>";
 245                         }
 246                         $package_page .= "</table>\n";
 247                         $package_page .= "</div> <!-- end pdownload -->\n";
 248
 249                         #
 250                         # more information
 251                         #
 252                         $package_page .= pmoreinfo( name => $pkg, data => $page,
 253                                                     opts => $opts,
 254                                                     env => \%FTP_SITES,
 255                                                     bugreports => 1, sourcedownload => 1,
 256                                                     changesandcopy => 1, maintainers => 1,
 257                                                     search => 1 );
 258                     } else { # unless $page->is_virtual
 259                         $short_desc = _g( "virtual package" );
 260
 261                         $$menu .= simple_menu( [ _g( "Distribution:" ),
 262                                                  _g( "Overview over this distribution" ),
 263                                                  "$ROOT/",
 264                                                  $suite ],
 265                                                [ _g( "Section:" ),
 266                                                  _g( "All packages in this section" ),
 267                                                  "$ROOT/$suite/virtual/",
 268
 269                                                  'virtual' ], );
 270
 271                         $package_page .= title( sprintf( _g( "Virtual Package: %s" ),
 272                                                          $pkg ) );
 273
 274                         my $policy_url = 'http://www.debian.org/doc/debian-policy/';
 275                         note( sprintf( _g( '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>.' ),
 276                                        $policy_url, $policy_url ));
 277
 278                         $package_page .= sprintf( "<h2>"._g( "Packages providing %s" )."</h2>",                              $pkg );
 279                         my $provided_by = $page->{provided_by};
 280                         $package_page .= pkg_list( \%packages, $opts, $provided_by, 'en');
 281
 282                     } # else (unless $page->is_virtual)
 283                 } else { # unless $opts->{source}
 284                     for my $entry (@results) {
 285                         debug( join(":", @$entry), 1 );
 286                         my (undef, $archive, undef, $section, $subsection,
 287                             $priority, $version) = @$entry;
 288
 289                         my $data = $sources_all{"$archive $suite $pkg"};
 290                         $page->merge_data($pkg, $suite, $archive, $data)
 291                             or debug( "Merging $pkg $version FAILED", 2 );
 292                     }
 293                     $version = $page->{version};
 294
 295                     my $st1 = new Benchmark;
 296                     my $std = timediff($st1, $st0);
 297                     debug( "Data search and merging took ".timestr($std) );
 298
 299                     my ($v_str, $v_str_arr) = $page->get_version_string();
 300                     $archive = $page->get_newest( 'archive' );
 301                     $section = $page->get_newest( 'section' );
 302                     $subsection = $page->get_newest( 'subsection' );
 303
 304                     $$menu .= simple_menu( [ _g( "Distribution:" ),
 305                                              _g( "Overview over this suite" ),
 306                                              "/$suite/",
 307                                              $suite ],
 308                                            [ _g( "Section:" ),
 309                                              _g( "All packages in this section" ),
 310                                              "/$suite/$subsection/",
 311                                              $subsection ],
 312                                            );
 313
 314                     my $title .= sprintf( _g( "Source Package: %s (%s)" ),
 315                                           $pkg, $v_str );
 316                     $title .=  " ".marker( $archive ) if $archive ne 'us';
 317                     $title .=  " ".marker( $subsection ) if $subsection eq 'non-US'
 318                         and $archive ne 'non-US'; # non-US/security
 319                     $title .=  " ".marker( $section ) if $section ne 'main';
 320                     $package_page .= title( $title );
 321
 322                     if ($suite eq "experimental") {
 323                         note( _g( "Experimental package"),
 324                               _g( "Warning: This package is from the <strong>experimental</strong> 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>"
 325                               );
 326                     }
 327                     if ($subsection eq "debian-installer") {
 328                         note( _g( "debian-installer udeb package"),
 329                               _g( '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.' )
 330                               );
 331                     }
 332
 333                     my $binaries = find_binaries( $pkg, $archive, $suite, \%src2bin );
 334                     if ($binaries && @$binaries) {
 335                         $package_page .= '<div class="pdesc">';
 336                         $package_page .= _g( "The following binary packages are built from this source package:" );
 337                         $package_page .= pkg_list( \%packages, $opts, $binaries, 'en' );
 338                         $package_page .= '</div> <!-- end pdesc -->';
 339                     }
 340
 341                     #
 342                     # display dependencies
 343                     #
 344                     my $dep_list;
 345                     $dep_list = print_deps( \%packages, $opts, $pkg,
 346                                             $page->get_dep_field('build-depends'),
 347                                             'build-depends' );
 348                     $dep_list .= print_deps( \%packages, $opts, $pkg,
 349                                              $page->get_dep_field('build-depends-indep'),
 350                                              'build-depends-indep' );
 351
 352                     if ( $dep_list ) {
 353                         $package_page .= "<div id=\"pdeps\">\n";
 354                         $package_page .= sprintf( "<h2>"._g( "Other Packages Related to %s" )."</h2>\n", $pkg );
 355                         if ($suite eq "experimental") {
 356                             note( sprintf( _g( 'Note that the <strong>experimental</strong> distribution is not self-contained; missing dependencies are likely found in the <a href="%s">unstable</a> distribution.' ), "$ROOT/unstable/" ) );
 357
 358                         }
 359
 360                         $package_page .= pdeplegend( [ 'adep',  _g( 'build-depends' ) ],
 361                                                      [ 'idep',  _g( 'build-depends-indep' ) ],
 362                                                      );
 363
 364                         $package_page .= $dep_list;
 365                         $package_page .= "</div> <!-- end pdeps -->\n";
 366                     }
 367
 368                     #
 369                     # Source package download
 370                     #
 371                     $package_page .= "<div id=\"pdownload\">\n";
 372                     $package_page .= sprintf( "<h2>"._g( "Download %s" )."</h2>\n",
 373                                               $pkg ) ;
 374
 375                     my $source_files = $page->get_src( 'files' );
 376                     my $source_dir = $page->get_src( 'directory' );
 377
 378                     $package_page .= sprintf( '<table summary="'._g('Download information for the files of this source package' ).'">'.
 379                                               "<tr><th>%s</th><th>%s</th><th>%s</th>",
 380                                               _g("File"),
 381                                               _g("Size (in kB)"),
 382                                               _g("md5sum") );
 383                     foreach( @$source_files ) {
 384                         my ($src_file_md5, $src_file_size, $src_file_name)
 385                             = split /\s+/, $_;
 386                         my $src_url;
 387                         for ($archive) {
 388                             /security/o &&  do {
 389                                 $src_url = $FTP_SITES{security}; last };
 390                             /volatile/o &&  do {
 391                                 $src_url = $FTP_SITES{volatile}; last };
 392                             /backports/o &&  do {
 393
 394                                 $src_url = $FTP_SITES{backports}; last };
 395                             /non-us/io  &&  do {
 396                                 $src_url = $FTP_SITES{'non-US'}; last };
 397                             $src_url = $FTP_SITES{us};
 398                         }
 399                         $src_url .= "/$source_dir/$src_file_name";
 400
 401                         $package_page .= "<tr><td><a href=\"$src_url\">$src_file_name</a></td>\n"
 402                             ."<td>".sprintf("%.1f", (floor(($src_file_size/102.4)+0.5)/10))."</td>\n"
 403                             ."<td class=\"md5sum\">$src_file_md5</td></tr>";
 404                     }
 405                     $package_page .= "</table>\n";
 406                     $package_page .= "</div> <!-- end pdownload -->\n";
 407
 408                     #
 409                     # more information
 410                     #
 411                     $package_page .= pmoreinfo( name => $pkg, data => $page,
 412                                                 opts => $opts,
 413                                                 env => \%FTP_SITES,
 414                                                 bugreports => 1,
 415                                                 changesandcopy => 1, maintainers => 1,
 416                                                 search => 1, is_source => 1 );
 417
 418                 } # else (unless $opts->{source})
 419             } # else (unless @results)
 420         } # else (unless (@results || @non_results ))
 421     }
 422
 423 #    use Data::Dumper;
 424 #    debug( "Final page object:\n".Dumper($page), 3 );
 425
 426     my $title = $opts->{source} ?
 427         _g( "Details of source package <em>%s</em> in %s" ) :
 428         _g( "Details of package <em>%s</em> in %s" ) ;
 429     my $title_tag = $opts->{source} ?
 430         _g( "Details of source package %s in %s" ) :
 431         _g( "Details of package %s in %s" ) ;
 432     %$html_header = ( title => sprintf( $title, $pkg, $suite ) ,
 433                       lang => $opts->{lang},
 434                       desc => $short_desc,
 435                       keywords => "$suite, $archive, $section, $subsection, $version",
 436                       title_tag => sprintf( $title_tag, $pkg, $suite ),
 437                       print_search_field => 'packages',
 438                       search_field_values => {
 439                           keywords => '',
 440                           searchon => $opts->{source} ? 'sourcenames' : 'names',
 441                           arch => 'any',
 442                           suite => 'all',
 443                           section => 'all',
 444                           exact => 0,
 445                           debug => $opts->{debug},
 446                       },
 447                       );
 448
 449     $$page_content = $package_page;
 450 }
 451
 452 1;
 453