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                 $all_suites{$s}++;
  79             }
  80             foreach (suites_sort(keys %all_suites)) {
  81                 if ($suite eq $_) {
  82                     $$menu .= "[ <strong>$_</strong> ] ";
  83                 } else {
  84                     $$menu .= "[ <a href=\"$ROOT/$_/$encodedpkg\">$_</a> ] ";
  85                 }
  86             }
  87             $$menu .= '<br>';
  88
  89             unless (@results) {
  90                 fatal_error( _g( "Package not available in this suite." ) );
  91             } else {
  92                 unless ($opts->{source}) {
  93                     for my $entry (@results) {
  94                         debug( join(":", @$entry), 1 ) if DEBUG;
  95                         my (undef, $archive, undef, $arch, $section, $subsection,
  96                             $priority, $version, $provided_by) = @$entry;
  97
  98                         if ($arch ne 'virtual') {
  99                             my %data = split /\000/, $packages_all{"$pkg $arch $version"};
 100                             $data{package} = $pkg;
 101                             $data{architecture} = $arch;
 102                             $data{version} = $version;
 103                             $page->merge_package(\%data) or debug( "Merging $pkg $arch $version FAILED", 2 ) if DEBUG;
 104                         } else {
 105                             $page->add_provided_by([split /\s+/, $provided_by]);
 106                         }
 107                     }
 108
 109                     unless ($page->is_virtual()) {
 110                         $version = $page->{newest};
 111                         my $source = $page->get_newest( 'source' );
 112                         $archive = $page->get_newest( 'archive' );
 113                         debug( "find source package: source=$source", 1) if DEBUG;
 114                         my $src_data = $sources_all{"$archive $suite $source"};
 115                         $page->add_src_data( $source, $src_data )
 116                             if $src_data;
 117
 118                         my $st1 = new Benchmark;
 119                         my $std = timediff($st1, $st0);
 120                         debug( "Data search and merging took ".timestr($std) ) if DEBUG;
 121
 122                         my $did = $page->get_newest( 'description' );
 123                         $section = $page->get_newest( 'section' );
 124                         $subsection = $page->get_newest( 'subsection' );
 125                         my $filenames = $page->get_arch_field( 'filename' );
 126                         my $file_md5sums = $page->get_arch_field( 'md5sum' );
 127                         my $archives = $page->get_arch_field( 'archive' );
 128                         my $versions = $page->get_arch_field( 'version' );
 129                         my $sizes_inst = $page->get_arch_field( 'installed-size' );
 130                         my $sizes_deb = $page->get_arch_field( 'size' );
 131                         my @archs = sort $page->get_architectures;
 132
 133                         # process description
 134                         #
 135                         my $desc = $descriptions{$did};
 136                         $short_desc = encode_entities( $1, "<>&\"" )
 137                             if $desc =~ s/^(.*)$//m;
 138                         my $long_desc = encode_entities( $desc, "<>&\"" );
 139
 140                         $long_desc =~ s,((ftp|http|https)://[\S~-]+?/?)((\&gt\;)?[)]?[']?[:.\,]?(\s|$)),<a href=\"$1\">$1</a>$3,go; # syntax highlighting -> '];
 141                         $long_desc =~ s/\A //o;
 142                         $long_desc =~ s/\n /\n/sgo;
 143                         $long_desc =~ s/\n.\n/\n<p>\n/go;
 144                         $long_desc =~ s/(((\n|\A) [^\n]*)+)/\n<pre>$1\n<\/pre>/sgo;
 145 #           $long_desc = conv_desc( $lang, $long_desc );
 146 #           $short_desc = conv_desc( $lang, $short_desc );
 147
 148                         $$menu .= simple_menu( [ _g( "Distribution:" ),
 149                                                  _g( "Overview over this suite" ),
 150                                                  "$ROOT/$suite/",
 151                                                  $suite ],
 152                                                [ _g( "Section:" ),
 153                                                  _g( "All packages in this section" ),
 154                                                  "$ROOT/$suite/$subsection/",
 155                                                  $subsection ],
 156                                                );
 157
 158                         my $v_str = $version;
 159                         my $multiple_versions = grep { $_ ne $version } values %$versions;
 160                         $v_str .= _g(" and others") if $multiple_versions;
 161                         my $title .= sprintf( _g( "Package: %s (%s)" ), $pkg, $v_str );
 162                         $title .=  " ".marker( $archive ) if $archive ne 'us';
 163                         $title .=  " ".marker( $subsection ) if $subsection eq 'non-US'
 164                             and $archive ne 'non-US'; # non-US/security
 165                         $title .=  " ".marker( $section ) if $section ne 'main';
 166                         $package_page .= title( $title );
 167
 168                         if (my $provided_by = $page->{provided_by}) {
 169                             note( _g( "This is also a virtual package provided by ").join( ', ', map { "<a href=\"$ROOT/$suite/$_\">$_</a>"  } @$provided_by) );
 170                         }
 171
 172                         if ($suite eq "experimental") {
 173                             note( _g( "Experimental package"),
 174                                   _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>"
 175                                   );
 176                         }
 177                         if ($subsection eq "debian-installer") {
 178                             note( _g( "debian-installer udeb package"),
 179                                   _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.' )
 180                                   );
 181                         }
 182                         $package_page .= pdesc( $short_desc, $long_desc );
 183
 184                         #
 185                         # display dependencies
 186                         #
 187                         my $dep_list;
 188                         $dep_list = print_deps( \%packages, $opts, $pkg,
 189                                                 $page->get_dep_field('depends'),
 190                                                 'depends' );
 191                         $dep_list .= print_deps( \%packages, $opts, $pkg,
 192                                                  $page->get_dep_field('recommends'),
 193                                                  'recommends' );
 194                         $dep_list .= print_deps( \%packages, $opts, $pkg,
 195                                                  $page->get_dep_field('suggests'),
 196                                                  'suggests' );
 197
 198                         if ( $dep_list ) {
 199                             $package_page .= "<div id=\"pdeps\">\n";
 200                             $package_page .= sprintf( "<h2>"._g( "Other Packages Related to %s" )."</h2>\n", $pkg );
 201                             if ($suite eq "experimental") {
 202                                 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/" ) );
 203                             }
 204
 205                             $package_page .= pdeplegend( [ 'dep',  _g( 'depends' ) ],
 206                                                          [ 'rec',  _g( 'recommends' ) ],
 207                                                          [ 'sug',  _g( 'suggests' ) ], );
 208
 209                             $package_page .= $dep_list;
 210                             $package_page .= "</div> <!-- end pdeps -->\n";
 211                         }
 212
 213                         #
 214                         # Download package
 215                         #
 216                         my $encodedpack = uri_escape( $pkg );
 217                         $package_page .= "<div id=\"pdownload\">";
 218                         $package_page .= sprintf( "<h2>"._g( "Download %s\n" )."</h2>",
 219                                                   $pkg ) ;
 220                         $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";
 221                         $package_page .= "<caption class=\"hidecss\">"._g("Download for all available architectures")."</caption>\n";
 222                         $package_page .= "<tr>\n";
 223                         $package_page .= "<th>"._g("Architecture")."</th>";
 224                         $package_page .= "<th>"._g("Version")."</th>"
 225                             if $multiple_versions;
 226                         $package_page .= "<th>"._g( "Package Size")."</th><th>"._g("Installed Size")."</th><th>"._g("Files")."</th></tr>\n";
 227                         foreach my $a ( @archs ) {
 228                             $package_page .= "<tr>\n";
 229                             $package_page .=  "<th><a href=\"$ROOT/$suite/$encodedpkg/$a/download";
 230                             $package_page .=  "\">$a</a></th>\n";
 231                             $package_page .= "<td>".$versions->{$a}."</td>"
 232                                 if $multiple_versions;
 233                             $package_page .= '</td><td class="size">';
 234                             $package_page .=  floor(($sizes_deb->{$a}/102.4)+0.5)/10 . "&nbsp;kB";
 235                             $package_page .= '</td><td class="size">';
 236                             $package_page .=  $sizes_inst->{$a} . "&nbsp;kB";
 237                             $package_page .= "</td>\n<td>";
 238                             if ( $suite ne "experimental" ) {
 239                                 $package_page .= sprintf( "[<a href=\"%s\">"._g( "list of files" )."</a>]\n",
 240                                                           "$ROOT/$suite/$encodedpkg/$a/filelist", $pkg );
 241                             } else {
 242                                 $package_page .= _g( "no current information" );
 243                             }
 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 ) if DEBUG;
 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 ) if DEBUG;
 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) ) if DEBUG;
 298
 299                     $archive = $page->get_newest( 'archive' );
 300                     $section = $page->get_newest( 'section' );
 301                     $subsection = $page->get_newest( 'subsection' );
 302
 303                     $$menu .= simple_menu( [ _g( "Distribution:" ),
 304                                              _g( "Overview over this suite" ),
 305                                              "/$suite/",
 306                                              $suite ],
 307                                            [ _g( "Section:" ),
 308                                              _g( "All packages in this section" ),
 309                                              "/$suite/$subsection/",
 310                                              $subsection ],
 311                                            );
 312
 313                     my $title .= sprintf( _g( "Source Package: %s (%s)" ),
 314                                           $pkg, $version );
 315                     $title .=  " ".marker( $archive ) if $archive ne 'us';
 316                     $title .=  " ".marker( $subsection ) if $subsection eq 'non-US'
 317                         and $archive ne 'non-US'; # non-US/security
 318                     $title .=  " ".marker( $section ) if $section ne 'main';
 319                     $package_page .= title( $title );
 320
 321                     if ($suite eq "experimental") {
 322                         note( _g( "Experimental package"),
 323                               _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>"
 324                               );
 325                     }
 326                     if ($subsection eq "debian-installer") {
 327                         note( _g( "debian-installer udeb package"),
 328                               _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.' )
 329                               );
 330                     }
 331
 332                     my $binaries = find_binaries( $pkg, $archive, $suite, \%src2bin );
 333                     if ($binaries && @$binaries) {
 334                         $package_page .= '<div class="pdesc">';
 335                         $package_page .= _g( "The following binary packages are built from this source package:" );
 336                         $package_page .= pkg_list( \%packages, $opts, $binaries, 'en' );
 337                         $package_page .= '</div> <!-- end pdesc -->';
 338                     }
 339
 340                     #
 341                     # display dependencies
 342                     #
 343                     my $dep_list;
 344                     $dep_list = print_deps( \%packages, $opts, $pkg,
 345                                             $page->get_dep_field('build-depends'),
 346                                             'build-depends' );
 347                     $dep_list .= print_deps( \%packages, $opts, $pkg,
 348                                              $page->get_dep_field('build-depends-indep'),
 349                                              'build-depends-indep' );
 350
 351                     if ( $dep_list ) {
 352                         $package_page .= "<div id=\"pdeps\">\n";
 353                         $package_page .= sprintf( "<h2>"._g( "Other Packages Related to %s" )."</h2>\n", $pkg );
 354                         if ($suite eq "experimental") {
 355                             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/" ) );
 356
 357                         }
 358
 359                         $package_page .= pdeplegend( [ 'adep',  _g( 'build-depends' ) ],
 360                                                      [ 'idep',  _g( 'build-depends-indep' ) ],
 361                                                      );
 362
 363                         $package_page .= $dep_list;
 364                         $package_page .= "</div> <!-- end pdeps -->\n";
 365                     }
 366
 367                     #
 368                     # Source package download
 369                     #
 370                     $package_page .= "<div id=\"pdownload\">\n";
 371                     $package_page .= sprintf( "<h2>"._g( "Download %s" )."</h2>\n",
 372                                               $pkg ) ;
 373
 374                     my $source_files = $page->get_src( 'files' );
 375                     my $source_dir = $page->get_src( 'directory' );
 376
 377                     $package_page .= sprintf( '<table summary="'._g('Download information for the files of this source package' ).'">'.
 378                                               "<tr><th>%s</th><th>%s</th><th>%s</th>",
 379                                               _g("File"),
 380                                               _g("Size (in kB)"),
 381                                               _g("md5sum") );
 382                     foreach( @$source_files ) {
 383                         my ($src_file_md5, $src_file_size, $src_file_name)
 384                             = split /\s+/, $_;
 385                         my $src_url;
 386                         for ($archive) {
 387                             /security/o &&  do {
 388                                 $src_url = $FTP_SITES{security}; last };
 389                             /volatile/o &&  do {
 390                                 $src_url = $FTP_SITES{volatile}; last };
 391                             /backports/o &&  do {
 392
 393                                 $src_url = $FTP_SITES{backports}; last };
 394                             /non-us/io  &&  do {
 395                                 $src_url = $FTP_SITES{'non-US'}; last };
 396                             $src_url = $FTP_SITES{us};
 397                         }
 398                         $src_url .= "/$source_dir/$src_file_name";
 399
 400                         $package_page .= "<tr><td><a href=\"$src_url\">$src_file_name</a></td>\n"
 401                             ."<td>".sprintf("%.1f", (floor(($src_file_size/102.4)+0.5)/10))."</td>\n"
 402                             ."<td class=\"md5sum\">$src_file_md5</td></tr>";
 403                     }
 404                     $package_page .= "</table>\n";
 405                     $package_page .= "</div> <!-- end pdownload -->\n";
 406
 407                     #
 408                     # more information
 409                     #
 410                     $package_page .= pmoreinfo( name => $pkg, data => $page,
 411                                                 opts => $opts,
 412                                                 env => \%FTP_SITES,
 413                                                 bugreports => 1,
 414                                                 changesandcopy => 1, maintainers => 1,
 415                                                 search => 1, is_source => 1 );
 416
 417                 } # else (unless $opts->{source})
 418             } # else (unless @results)
 419         } # else (unless (@results || @non_results ))
 420     }
 421
 422 #    use Data::Dumper;
 423 #    debug( "Final page object:\n".Dumper($page), 3 ) if DEBUG;
 424
 425     my $title = $opts->{source} ?
 426         _g( "Details of source package <em>%s</em> in %s" ) :
 427         _g( "Details of package <em>%s</em> in %s" ) ;
 428     my $title_tag = $opts->{source} ?
 429         _g( "Details of source package %s in %s" ) :
 430         _g( "Details of package %s in %s" ) ;
 431     %$html_header = ( title => sprintf( $title, $pkg, $suite ) ,
 432                       lang => $opts->{lang},
 433                       desc => $short_desc,
 434                       keywords => "$suite, $archive, $section, $subsection, $version",
 435                       title_tag => sprintf( $title_tag, $pkg, $suite ),
 436                       print_search_field => 'packages',
 437                       search_field_values => {
 438                           keywords => '',
 439                           searchon => $opts->{source} ? 'sourcenames' : 'names',
 440                           arch => 'any',
 441                           suite => 'all',
 442                           section => 'all',
 443                           exact => 0,
 444                           debug => $opts->{debug},
 445                       },
 446                       );
 447
 448     $$page_content = $package_page;
 449 }
 450
 451 1;
 452