lib/Packages/DoShow.pm

   1 package Packages::DoShow;
   2
   3 use strict;
   4 use warnings;
   5
   6 use POSIX;
   7 use URI::Escape;
   8 use HTML::Entities;
   9 use DB_File;
  10 use Benchmark ':hireswallclock';
  11 use Exporter;
  12
  13 use Deb::Versions;
  14 use Packages::Config qw( $DBDIR $ROOT @SUITES @ARCHIVES @SECTIONS
  15                          @ARCHITECTURES %FTP_SITES $SEARCH_URL );
  16 use Packages::I18N::Locale;
  17 use Packages::CGI;
  18 use Packages::DB;
  19 use Packages::Search qw( :all );
  20 use Packages::HTML;
  21 use Packages::Page ();
  22 use Packages::SrcPage ();
  23
  24 our @ISA = qw( Exporter );
  25 our @EXPORT = qw( do_show );
  26
  27 sub do_show {
  28     my ($params, $opts, $html_header, $menu, $page_content) = @_;
  29
  30     if ($params->{errors}{package}) {
  31         fatal_error( _g( "package not valid or not specified" ) );
  32     }
  33     if ($params->{errors}{suite}) {
  34         fatal_error( _g( "suite not valid or not specified" ) );
  35     }
  36     if (@{$opts->{suite}} > 1) {
  37         fatal_error( sprintf( _g( "more than one suite specified for show (%s)" ), "@{$opts->{suite}}" ) );
  38     }
  39
  40     my $pkg = $opts->{package};
  41     my $encodedpkg = uri_escape( $pkg );
  42     my $suite = $opts->{suite}[0];
  43     my $archive = $opts->{archive}[0] ||'';
  44
  45     my $DL_URL = "$pkg/download";
  46     my $FILELIST_URL = "$pkg/files";
  47
  48     our (%packages_all, %sources_all);
  49     my (@results, @non_results);
  50     my $page = $opts->{source} ?
  51         new Packages::SrcPage( $pkg ) :
  52         new Packages::Page( $pkg );
  53     my $package_page = "";
  54     my ($short_desc, $version, $section, $subsection) = ("")x5;
  55
  56     my $st0 = new Benchmark;
  57     unless (@Packages::CGI::fatal_errors) {
  58         tie %packages_all, 'DB_File', "$DBDIR/packages_all_$suite.db",
  59         O_RDONLY, 0666, $DB_BTREE
  60             or die "couldn't tie DB $DBDIR/packages_all_$suite.db: $!";
  61         tie %sources_all, 'DB_File', "$DBDIR/sources_all_$suite.db",
  62         O_RDONLY, 0666, $DB_BTREE
  63             or die "couldn't tie DB $DBDIR/sources_all_$suite.db: $!";
  64
  65         unless ($opts->{source}) {
  66             read_entry_all( \%packages, $pkg, \@results, \@non_results, $opts );
  67         } else {
  68             read_src_entry_all( \%sources, $pkg, \@results, \@non_results, $opts );
  69         }
  70
  71         unless (@results || @non_results ) {
  72             fatal_error( _g( "No such package." )."<br>".
  73                          sprintf( _g( '<a href="%s">Search for the package</a>' ), "$SEARCH_URL/$pkg" ) );
  74         } else {
  75             my %all_suites;
  76             foreach (@results, @non_results) {
  77                 my $a = $_->[1];
  78                 my $s = $_->[2];
  79                 $all_suites{$s}++;
  80             }
  81             foreach (suites_sort(keys %all_suites)) {
  82                 if ($suite eq $_) {
  83                     $$menu .= "[ <strong>$_</strong> ] ";
  84                 } else {
  85                     $$menu .= "[ <a href=\"".make_url($encodedpkg,'',{suite=>$_})."\">$_</a> ] ";
  86                 }
  87             }
  88             $$menu .= '<br>';
  89
  90             unless (@results) {
  91                 fatal_error( _g( "Package not available in this suite." ) );
  92             } else {
  93                 unless ($opts->{source}) {
  94                     for my $entry (@results) {
  95                         debug( join(":", @$entry), 1 ) if DEBUG;
  96                         my (undef, $archive, undef, $arch, $section, $subsection,
  97                             $priority, $version, $provided_by) = @$entry;
  98
  99                         if ($arch ne 'virtual') {
 100                             my %data = split /\000/, $packages_all{"$pkg $arch $version"};
 101                             $data{package} = $pkg;
 102                             $data{architecture} = $arch;
 103                             $data{version} = $version;
 104                             $page->merge_package(\%data)
 105                                 or debug( "Merging $pkg $arch $version FAILED", 2 ) if DEBUG;
 106                         } else {
 107                             $page->add_provided_by([split /\s+/, $provided_by]);
 108                         }
 109                     }
 110
 111                     unless ($page->is_virtual()) {
 112                         $version = $page->{newest};
 113                         my $source = $page->get_newest( 'source' );
 114                         $archive = $page->get_newest( 'archive' );
 115                         debug( "find source package: source=$source", 1) if DEBUG;
 116                         my $src_data = $sources_all{"$archive $suite $source"};
 117                         $page->add_src_data( $source, $src_data )
 118                             if $src_data;
 119
 120                         my $st1 = new Benchmark;
 121                         my $std = timediff($st1, $st0);
 122                         debug( "Data search and merging took ".timestr($std) ) if DEBUG;
 123
 124                         my $did = $page->get_newest( 'description' );
 125                         $section = $page->get_newest( 'section' );
 126                         $subsection = $page->get_newest( 'subsection' );
 127                         my $filenames = $page->get_arch_field( 'filename' );
 128                         my $file_md5sums = $page->get_arch_field( 'md5sum' );
 129                         my $archives = $page->get_arch_field( 'archive' );
 130                         my $versions = $page->get_arch_field( 'version' );
 131                         my $sizes_inst = $page->get_arch_field( 'installed-size' );
 132                         my $sizes_deb = $page->get_arch_field( 'size' );
 133                         my @archs = sort $page->get_architectures;
 134
 135                         # process description
 136                         #
 137                         my $desc = $descriptions{$did};
 138                         $short_desc = encode_entities( $1, "<>&\"" )
 139                             if $desc =~ s/^(.*)$//m;
 140                         my $long_desc = encode_entities( $desc, "<>&\"" );
 141
 142                         $long_desc =~ s,((ftp|http|https)://[\S~-]+?/?)((\&gt\;)?[)]?[']?[:.\,]?(\s|$)),<a href=\"$1\">$1</a>$3,go; # syntax highlighting -> '];
 143                         $long_desc =~ s/\A //o;
 144                         $long_desc =~ s/\n /\n/sgo;
 145                         $long_desc =~ s/\n.\n/\n<p>\n/go;
 146                         $long_desc =~ s/(((\n|\A) [^\n]*)+)/\n<pre>$1\n<\/pre>/sgo;
 147                         my @menu = ( [ _g( "Distribution:" ),
 148                                        _g( "Overview over this suite" ),
 149                                        make_url("/",''),
 150                                        $suite ],
 151                                      [ _g( "Section:" ),
 152                                        _g( "All packages in this section" ),
 153                                        make_url("$subsection/",''),
 154                                        $subsection ], );
 155                         push @menu, [ _g( "Source:" ),
 156                                       _g( "Source package building this package" ),
 157                                       make_url($source,'',{source=>'source'}),
 158                                       $source ] if $source;
 159                         $$menu .= simple_menu( @menu );
 160
 161                         my $v_str = $version;
 162                         my $multiple_versions = grep { $_ ne $version } values %$versions;
 163                         $v_str .= _g(" and others") if $multiple_versions;
 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                         if (my $provided_by = $page->{provided_by}) {
 172                             note( _g( "This is also a virtual package provided by ").join( ', ', map { "<a href=\"".make_url($_,'')."\">$_</a>"  } @$provided_by) );
 173                         }
 174
 175                         if ($suite eq "experimental") {
 176                             note( _g( "Experimental package"),
 177                                   _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>"
 178                                   );
 179                         }
 180                         if ($subsection eq "debian-installer") {
 181                             note( _g( "debian-installer udeb package"),
 182                                   _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.' )
 183                                   );
 184                         }
 185                         $package_page .= pdesc( $short_desc, $long_desc );
 186
 187                         #
 188                         # display dependencies
 189                         #
 190                         my $dep_list;
 191                         $dep_list = print_deps( \%packages, $opts, $pkg,
 192                                                 $page->get_dep_field('depends'),
 193                                                 'depends' );
 194                         $dep_list .= print_deps( \%packages, $opts, $pkg,
 195                                                  $page->get_dep_field('recommends'),
 196                                                  'recommends' );
 197                         $dep_list .= print_deps( \%packages, $opts, $pkg,
 198                                                  $page->get_dep_field('suggests'),
 199                                                  'suggests' );
 200
 201                         if ( $dep_list ) {
 202                             $package_page .= "<div id=\"pdeps\">\n";
 203                             $package_page .= sprintf( "<h2>"._g( "Other Packages Related to %s" )."</h2>\n", $pkg );
 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=\"".make_url("$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 class="size">';
 234                             # package size
 235                             $package_page .=  sprintf(_g('%.1f&nbsp;kB'),
 236                                                       floor(($sizes_deb->{$a}/102.4)+0.5)/10);
 237                             $package_page .= '</td><td class="size">';
 238                             # installed size
 239                             $package_page .=  sprintf(_g('%d&nbsp;kB'),
 240                                                       $sizes_inst->{$a});
 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                                                           make_url("$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                                                  make_url('/',''),
 268                                                  $suite ],
 269                                                [ _g( "Section:" ),
 270                                                  _g( "All packages in this section" ),
 271                                                  make_url("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                                              make_url('/',''),
 310                                              $suite ],
 311                                            [ _g( "Section:" ),
 312                                              _g( "All packages in this section" ),
 313                                              make_url("$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
 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 $server = lc $archive) =~ s/-//go; # non-US hack
 386                         my $src_url = $FTP_SITES{$server}
 387                             || $FTP_SITES{us};
 388                         $src_url .= "/$source_dir/$src_file_name";
 389
 390                         $package_page .= "<tr><td><a href=\"$src_url\">$src_file_name</a></td>\n"
 391                             ."<td>".sprintf("%.1f", (floor(($src_file_size/102.4)+0.5)/10))."</td>\n"
 392                             ."<td class=\"md5sum\">$src_file_md5</td></tr>";
 393                     }
 394                     $package_page .= "</table>\n";
 395                     $package_page .= "</div> <!-- end pdownload -->\n";
 396
 397                     #
 398                     # more information
 399                     #
 400                     $package_page .= pmoreinfo( name => $pkg, data => $page,
 401                                                 opts => $opts,
 402                                                 env => \%FTP_SITES,
 403                                                 bugreports => 1,
 404                                                 changesandcopy => 1, maintainers => 1,
 405                                                 search => 1, is_source => 1 );
 406
 407                 } # else (unless $opts->{source})
 408             } # else (unless @results)
 409         } # else (unless (@results || @non_results ))
 410     }
 411
 412 #    use Data::Dumper;
 413 #    debug( "Final page object:\n".Dumper($page), 3 ) if DEBUG;
 414
 415     my $title = $opts->{source} ?
 416         _g( "Details of source package <em>%s</em> in %s" ) :
 417         _g( "Details of package <em>%s</em> in %s" ) ;
 418     my $title_tag = $opts->{source} ?
 419         _g( "Details of source package %s in %s" ) :
 420         _g( "Details of package %s in %s" ) ;
 421     %$html_header = ( title => sprintf( $title, $pkg, $suite ) ,
 422                       lang => $opts->{lang},
 423                       desc => $short_desc,
 424                       keywords => "$suite, $archive, $section, $subsection, $version",
 425                       title_tag => sprintf( $title_tag, $pkg, $suite ),
 426                       print_search_field => 'packages',
 427                       search_field_values => {
 428                           keywords => '',
 429                           searchon => $opts->{source} ? 'sourcenames' : 'names',
 430                           arch => 'any',
 431                           suite => 'all',
 432                           section => 'all',
 433                           exact => 0,
 434                           debug => $opts->{debug},
 435                       },
 436                       );
 437
 438     $$page_content = $package_page;
 439 }
 440
 441 1;
 442