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