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