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