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