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                                                [ _g( "Source:" ),
 157                                                  _g( "Source package building this package" ),
 158                                                  "$ROOT/$suite/source/".$page->get_src('package'),
 159                                                  $page->get_src('package') ],
 160                                                );
 161
 162                         my $v_str = $version;
 163                         my $multiple_versions = grep { $_ ne $version } values %$versions;
 164                         $v_str .= _g(" and others") if $multiple_versions;
 165                         my $title .= sprintf( _g( "Package: %s (%s)" ), $pkg, $v_str );
 166                         $title .=  " ".marker( $archive ) if $archive ne 'us';
 167                         $title .=  " ".marker( $subsection ) if $subsection eq 'non-US'
 168                             and $archive ne 'non-US'; # non-US/security
 169                         $title .=  " ".marker( $section ) if $section ne 'main';
 170                         $package_page .= title( $title );
 171
 172                         if (my $provided_by = $page->{provided_by}) {
 173                             note( _g( "This is also a virtual package provided by ").join( ', ', map { "<a href=\"$ROOT/$suite/$_\">$_</a>"  } @$provided_by) );
 174                         }
 175
 176                         if ($suite eq "experimental") {
 177                             note( _g( "Experimental package"),
 178                                   _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>"
 179                                   );
 180                         }
 181                         if ($subsection eq "debian-installer") {
 182                             note( _g( "debian-installer udeb package"),
 183                                   _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.' )
 184                                   );
 185                         }
 186                         $package_page .= pdesc( $short_desc, $long_desc );
 187
 188                         #
 189                         # display dependencies
 190                         #
 191                         my $dep_list;
 192                         $dep_list = print_deps( \%packages, $opts, $pkg,
 193                                                 $page->get_dep_field('depends'),
 194                                                 'depends' );
 195                         $dep_list .= print_deps( \%packages, $opts, $pkg,
 196                                                  $page->get_dep_field('recommends'),
 197                                                  'recommends' );
 198                         $dep_list .= print_deps( \%packages, $opts, $pkg,
 199                                                  $page->get_dep_field('suggests'),
 200                                                  'suggests' );
 201
 202                         if ( $dep_list ) {
 203                             $package_page .= "<div id=\"pdeps\">\n";
 204                             $package_page .= sprintf( "<h2>"._g( "Other Packages Related to %s" )."</h2>\n", $pkg );
 205                             if ($suite eq "experimental") {
 206                                 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/" ) );
 207                             }
 208
 209                             $package_page .= pdeplegend( [ 'dep',  _g( 'depends' ) ],
 210                                                          [ 'rec',  _g( 'recommends' ) ],
 211                                                          [ 'sug',  _g( 'suggests' ) ], );
 212
 213                             $package_page .= $dep_list;
 214                             $package_page .= "</div> <!-- end pdeps -->\n";
 215                         }
 216
 217                         #
 218                         # Download package
 219                         #
 220                         my $encodedpack = uri_escape( $pkg );
 221                         $package_page .= "<div id=\"pdownload\">";
 222                         $package_page .= sprintf( "<h2>"._g( "Download %s\n" )."</h2>",
 223                                                   $pkg ) ;
 224                         $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";
 225                         $package_page .= "<caption class=\"hidecss\">"._g("Download for all available architectures")."</caption>\n";
 226                         $package_page .= "<tr>\n";
 227                         $package_page .= "<th>"._g("Architecture")."</th>";
 228                         $package_page .= "<th>"._g("Version")."</th>"
 229                             if $multiple_versions;
 230                         $package_page .= "<th>"._g( "Package Size")."</th><th>"._g("Installed Size")."</th><th>"._g("Files")."</th></tr>\n";
 231                         foreach my $a ( @archs ) {
 232                             $package_page .= "<tr>\n";
 233                             $package_page .=  "<th><a href=\"$ROOT/$suite/$encodedpkg/$a/download";
 234                             $package_page .=  "\">$a</a></th>\n";
 235                             $package_page .= "<td>".$versions->{$a}."</td>"
 236                                 if $multiple_versions;
 237                             $package_page .= '<td class="size">';
 238                             $package_page .=  floor(($sizes_deb->{$a}/102.4)+0.5)/10 . "&nbsp;kB";
 239                             $package_page .= '</td><td class="size">';
 240                             $package_page .=  $sizes_inst->{$a} . "&nbsp;kB";
 241                             $package_page .= "</td>\n<td>";
 242                             if ( $suite ne "experimental" ) {
 243                                 $package_page .= sprintf( "[<a href=\"%s\">"._g( "list of files" )."</a>]\n",
 244                                                           "$ROOT/$suite/$encodedpkg/$a/filelist", $pkg );
 245                             } else {
 246                                 $package_page .= _g( "no current information" );
 247                             }
 248                             $package_page .= "</td>\n</tr>";
 249                         }
 250                         $package_page .= "</table>\n";
 251                         $package_page .= "</div> <!-- end pdownload -->\n";
 252
 253                         #
 254                         # more information
 255                         #
 256                         $package_page .= pmoreinfo( name => $pkg, data => $page,
 257                                                     opts => $opts,
 258                                                     env => \%FTP_SITES,
 259                                                     bugreports => 1, sourcedownload => 1,
 260                                                     changesandcopy => 1, maintainers => 1,
 261                                                     search => 1 );
 262                     } else { # unless $page->is_virtual
 263                         $short_desc = _g( "virtual package" );
 264
 265                         $$menu .= simple_menu( [ _g( "Distribution:" ),
 266                                                  _g( "Overview over this distribution" ),
 267                                                  "$ROOT/",
 268                                                  $suite ],
 269                                                [ _g( "Section:" ),
 270                                                  _g( "All packages in this section" ),
 271                                                  "$ROOT/$suite/virtual/",
 272
 273                                                  'virtual' ], );
 274
 275                         $package_page .= title( sprintf( _g( "Virtual Package: %s" ),
 276                                                          $pkg ) );
 277
 278                         my $policy_url = 'http://www.debian.org/doc/debian-policy/';
 279                         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>.' ),
 280                                        $policy_url, $policy_url ));
 281
 282                         $package_page .= sprintf( "<h2>"._g( "Packages providing %s" )."</h2>",                              $pkg );
 283                         my $provided_by = $page->{provided_by};
 284                         $package_page .= pkg_list( \%packages, $opts, $provided_by, 'en');
 285
 286                     } # else (unless $page->is_virtual)
 287                 } else { # unless $opts->{source}
 288                     for my $entry (@results) {
 289                         debug( join(":", @$entry), 1 ) if DEBUG;
 290                         my (undef, $archive, undef, $section, $subsection,
 291                             $priority, $version) = @$entry;
 292
 293                         my $data = $sources_all{"$archive $suite $pkg"};
 294                         $page->merge_data($pkg, $suite, $archive, $data)
 295                             or debug( "Merging $pkg $version FAILED", 2 ) if DEBUG;
 296                     }
 297                     $version = $page->{version};
 298
 299                     my $st1 = new Benchmark;
 300                     my $std = timediff($st1, $st0);
 301                     debug( "Data search and merging took ".timestr($std) ) if DEBUG;
 302
 303                     $archive = $page->get_newest( 'archive' );
 304                     $section = $page->get_newest( 'section' );
 305                     $subsection = $page->get_newest( 'subsection' );
 306
 307                     $$menu .= simple_menu( [ _g( "Distribution:" ),
 308                                              _g( "Overview over this suite" ),
 309                                              "/$suite/",
 310                                              $suite ],
 311                                            [ _g( "Section:" ),
 312                                              _g( "All packages in this section" ),
 313                                              "/$suite/$subsection/",
 314                                              $subsection ],
 315                                            );
 316
 317                     my $title .= sprintf( _g( "Source Package: %s (%s)" ),
 318                                           $pkg, $version );
 319                     $title .=  " ".marker( $archive ) if $archive ne 'us';
 320                     $title .=  " ".marker( $subsection ) if $subsection eq 'non-US'
 321                         and $archive ne 'non-US'; # non-US/security
 322                     $title .=  " ".marker( $section ) if $section ne 'main';
 323                     $package_page .= title( $title );
 324
 325                     if ($suite eq "experimental") {
 326                         note( _g( "Experimental package"),
 327                               _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>"
 328                               );
 329                     }
 330                     if ($subsection eq "debian-installer") {
 331                         note( _g( "debian-installer udeb package"),
 332                               _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.' )
 333                               );
 334                     }
 335
 336                     my $binaries = find_binaries( $pkg, $archive, $suite, \%src2bin );
 337                     if ($binaries && @$binaries) {
 338                         $package_page .= '<div class="pdesc">';
 339                         $package_page .= _g( "The following binary packages are built from this source package:" );
 340                         $package_page .= pkg_list( \%packages, $opts, $binaries, 'en' );
 341                         $package_page .= '</div> <!-- end pdesc -->';
 342                     }
 343
 344                     #
 345                     # display dependencies
 346                     #
 347                     my $dep_list;
 348                     $dep_list = print_deps( \%packages, $opts, $pkg,
 349                                             $page->get_dep_field('build-depends'),
 350                                             'build-depends' );
 351                     $dep_list .= print_deps( \%packages, $opts, $pkg,
 352                                              $page->get_dep_field('build-depends-indep'),
 353                                              'build-depends-indep' );
 354
 355                     if ( $dep_list ) {
 356                         $package_page .= "<div id=\"pdeps\">\n";
 357                         $package_page .= sprintf( "<h2>"._g( "Other Packages Related to %s" )."</h2>\n", $pkg );
 358                         if ($suite eq "experimental") {
 359                             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/" ) );
 360
 361                         }
 362
 363                         $package_page .= pdeplegend( [ 'adep',  _g( 'build-depends' ) ],
 364                                                      [ 'idep',  _g( 'build-depends-indep' ) ],
 365                                                      );
 366
 367                         $package_page .= $dep_list;
 368                         $package_page .= "</div> <!-- end pdeps -->\n";
 369                     }
 370
 371                     #
 372                     # Source package download
 373                     #
 374                     $package_page .= "<div id=\"pdownload\">\n";
 375                     $package_page .= sprintf( "<h2>"._g( "Download %s" )."</h2>\n",
 376                                               $pkg ) ;
 377
 378                     my $source_files = $page->get_src( 'files' );
 379                     my $source_dir = $page->get_src( 'directory' );
 380
 381                     $package_page .= sprintf( '<table summary="'._g('Download information for the files of this source package' ).'">'.
 382                                               "<tr><th>%s</th><th>%s</th><th>%s</th>",
 383                                               _g("File"),
 384                                               _g("Size (in kB)"),
 385                                               _g("md5sum") );
 386                     foreach( @$source_files ) {
 387                         my ($src_file_md5, $src_file_size, $src_file_name)
 388                             = split /\s+/, $_;
 389                         my $src_url;
 390                         for ($archive) {
 391                             /security/o &&  do {
 392                                 $src_url = $FTP_SITES{security}; last };
 393                             /volatile/o &&  do {
 394                                 $src_url = $FTP_SITES{volatile}; last };
 395                             /backports/o &&  do {
 396
 397                                 $src_url = $FTP_SITES{backports}; last };
 398                             /non-us/io  &&  do {
 399                                 $src_url = $FTP_SITES{'non-US'}; last };
 400                             $src_url = $FTP_SITES{us};
 401                         }
 402                         $src_url .= "/$source_dir/$src_file_name";
 403
 404                         $package_page .= "<tr><td><a href=\"$src_url\">$src_file_name</a></td>\n"
 405                             ."<td>".sprintf("%.1f", (floor(($src_file_size/102.4)+0.5)/10))."</td>\n"
 406                             ."<td class=\"md5sum\">$src_file_md5</td></tr>";
 407                     }
 408                     $package_page .= "</table>\n";
 409                     $package_page .= "</div> <!-- end pdownload -->\n";
 410
 411                     #
 412                     # more information
 413                     #
 414                     $package_page .= pmoreinfo( name => $pkg, data => $page,
 415                                                 opts => $opts,
 416                                                 env => \%FTP_SITES,
 417                                                 bugreports => 1,
 418                                                 changesandcopy => 1, maintainers => 1,
 419                                                 search => 1, is_source => 1 );
 420
 421                 } # else (unless $opts->{source})
 422             } # else (unless @results)
 423         } # else (unless (@results || @non_results ))
 424     }
 425
 426 #    use Data::Dumper;
 427 #    debug( "Final page object:\n".Dumper($page), 3 ) if DEBUG;
 428
 429     my $title = $opts->{source} ?
 430         _g( "Details of source package <em>%s</em> in %s" ) :
 431         _g( "Details of package <em>%s</em> in %s" ) ;
 432     my $title_tag = $opts->{source} ?
 433         _g( "Details of source package %s in %s" ) :
 434         _g( "Details of package %s in %s" ) ;
 435     %$html_header = ( title => sprintf( $title, $pkg, $suite ) ,
 436                       lang => $opts->{lang},
 437                       desc => $short_desc,
 438                       keywords => "$suite, $archive, $section, $subsection, $version",
 439                       title_tag => sprintf( $title_tag, $pkg, $suite ),
 440                       print_search_field => 'packages',
 441                       search_field_values => {
 442                           keywords => '',
 443                           searchon => $opts->{source} ? 'sourcenames' : 'names',
 444                           arch => 'any',
 445                           suite => 'all',
 446                           section => 'all',
 447                           exact => 0,
 448                           debug => $opts->{debug},
 449                       },
 450                       );
 451
 452     $$page_content = $package_page;
 453 }
 454
 455 1;
 456