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>' ), make_search_url('','keywords='.uri_escape($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                         my @tags = split(/, /, $page->get_newest( 'tag' ));
 126                         $section = $page->get_newest( 'section' );
 127                         $subsection = $page->get_newest( 'subsection' );
 128                         my $filenames = $page->get_arch_field( 'filename' );
 129                         my $file_md5sums = $page->get_arch_field( 'md5sum' );
 130                         my $archives = $page->get_arch_field( 'archive' );
 131                         my $versions = $page->get_arch_field( 'version' );
 132                         my $sizes_inst = $page->get_arch_field( 'installed-size' );
 133                         my $sizes_deb = $page->get_arch_field( 'size' );
 134                         my @archs = sort $page->get_architectures;
 135
 136                         # process description
 137                         #
 138                         my $desc = $descriptions{$did};
 139                         $short_desc = encode_entities( $1, "<>&\"" )
 140                             if $desc =~ s/^(.*)$//m;
 141                         my $long_desc = encode_entities( $desc, "<>&\"" );
 142
 143                         $long_desc =~ s,((ftp|http|https)://[\S~-]+?/?)((\&gt\;)?[)]?[']?[:.\,]?(\s|$)),<a href=\"$1\">$1</a>$3,go; # syntax highlighting -> '];
 144                         $long_desc =~ s/\A //o;
 145                         $long_desc =~ s/\n /\n/sgo;
 146                         $long_desc =~ s/\n.\n/\n<p>\n/go;
 147                         $long_desc =~ s/(((\n|\A) [^\n]*)+)/\n<pre>$1\n<\/pre>/sgo;
 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                         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                         $package_page .= ptags( $pkg, @tags ) if @tags;
 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 size
 237                             $package_page .=  sprintf(_g('%.1f&nbsp;kB'),
 238                                                       floor(($sizes_deb->{$a}/102.4)+0.5)/10);
 239                             $package_page .= '</td><td class="size">';
 240                             # installed size
 241                             $package_page .=  sprintf(_g('%d&nbsp;kB'),
 242                                                       $sizes_inst->{$a});
 243                             $package_page .= "</td>\n<td>";
 244                             if ( ($suite ne "experimental")
 245                                  && ($subsection ne 'debian-installer')) {
 246                                 $package_page .= sprintf( "[<a href=\"%s\">"._g( "list of files" )."</a>]\n",
 247                                                           make_url("$encodedpkg/$a/filelist",''), $pkg );
 248                             } else {
 249                                 $package_page .= _g( "no current information" );
 250                             }
 251                             $package_page .= "</td>\n</tr>";
 252                         }
 253                         $package_page .= "</table>\n";
 254                         $package_page .= "</div> <!-- end pdownload -->\n";
 255
 256                         #
 257                         # more information
 258                         #
 259                         $package_page .= pmoreinfo( name => $pkg, data => $page,
 260                                                     opts => $opts,
 261                                                     env => \%FTP_SITES,
 262                                                     bugreports => 1, sourcedownload => 1,
 263                                                     changesandcopy => 1, maintainers => 1,
 264                                                     search => 1 );
 265                     } else { # unless $page->is_virtual
 266                         $short_desc = _g( "virtual package" );
 267
 268                         $$menu .= simple_menu( [ _g( "Distribution:" ),
 269                                                  _g( "Overview over this distribution" ),
 270                                                  make_url('/',''),
 271                                                  $suite ],
 272                                                [ _g( "Section:" ),
 273                                                  _g( "All packages in this section" ),
 274                                                  make_url("virtual/",''),
 275
 276                                                  'virtual' ], );
 277
 278                         $package_page .= title( sprintf( _g( "Virtual Package: %s" ),
 279                                                          $pkg ) );
 280
 281                         my $policy_url = 'http://www.debian.org/doc/debian-policy/';
 282                         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>.' ),
 283                                        $policy_url, $policy_url ));
 284
 285                         $package_page .= sprintf( "<h2>"._g( "Packages providing %s" )."</h2>",                              $pkg );
 286                         my $provided_by = $page->{provided_by};
 287                         $package_page .= pkg_list( \%packages, $opts, $provided_by, 'en');
 288
 289                     } # else (unless $page->is_virtual)
 290                 } else { # unless $opts->{source}
 291                     for my $entry (@results) {
 292                         debug( join(":", @$entry), 1 ) if DEBUG;
 293                         my (undef, $archive, undef, $section, $subsection,
 294                             $priority, $version) = @$entry;
 295
 296                         my $data = $sources_all{"$archive $suite $pkg"};
 297                         $page->merge_data($pkg, $suite, $archive, $data)
 298                             or debug( "Merging $pkg $version FAILED", 2 ) if DEBUG;
 299                     }
 300                     $version = $page->{version};
 301
 302                     my $st1 = new Benchmark;
 303                     my $std = timediff($st1, $st0);
 304                     debug( "Data search and merging took ".timestr($std) ) if DEBUG;
 305
 306                     $archive = $page->get_newest( 'archive' );
 307                     $section = $page->get_newest( 'section' );
 308                     $subsection = $page->get_newest( 'subsection' );
 309
 310                     $$menu .= simple_menu( [ _g( "Distribution:" ),
 311                                              _g( "Overview over this suite" ),
 312                                              make_url('/',''),
 313                                              $suite ],
 314                                            [ _g( "Section:" ),
 315                                              _g( "All packages in this section" ),
 316                                              make_url("$subsection/",''),
 317                                              $subsection ],
 318                                            );
 319
 320                     my $title .= sprintf( _g( "Source Package: %s (%s)" ),
 321                                           $pkg, $version );
 322                     $title .=  " ".marker( $archive ) if $archive ne 'us';
 323                     $title .=  " ".marker( $subsection ) if $subsection eq 'non-US'
 324                         and $archive ne 'non-US'; # non-US/security
 325                     $title .=  " ".marker( $section ) if $section ne 'main';
 326                     $package_page .= title( $title );
 327
 328                     if ($suite eq "experimental") {
 329                         note( _g( "Experimental package"),
 330                               _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>"
 331                               );
 332                     }
 333                     if ($subsection eq "debian-installer") {
 334                         note( _g( "debian-installer udeb package"),
 335                               _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.' )
 336                               );
 337                     }
 338
 339                     my $binaries = find_binaries( $pkg, $archive, $suite, \%src2bin );
 340                     if ($binaries && @$binaries) {
 341                         $package_page .= '<div class="pdesc">';
 342                         $package_page .= _g( "The following binary packages are built from this source package:" );
 343                         $package_page .= pkg_list( \%packages, $opts, $binaries, 'en' );
 344                         $package_page .= '</div> <!-- end pdesc -->';
 345                     }
 346
 347                     #
 348                     # display dependencies
 349                     #
 350                     my $dep_list;
 351                     $dep_list = print_deps( \%packages, $opts, $pkg,
 352                                             $page->get_dep_field('build-depends'),
 353                                             'build-depends' );
 354                     $dep_list .= print_deps( \%packages, $opts, $pkg,
 355                                              $page->get_dep_field('build-depends-indep'),
 356                                              'build-depends-indep' );
 357
 358                     if ( $dep_list ) {
 359                         $package_page .= "<div id=\"pdeps\">\n";
 360                         $package_page .= sprintf( "<h2>"._g( "Other Packages Related to %s" )."</h2>\n", $pkg );
 361
 362                         $package_page .= pdeplegend( [ 'adep',  _g( 'build-depends' ) ],
 363                                                      [ 'idep',  _g( 'build-depends-indep' ) ],
 364                                                      );
 365
 366                         $package_page .= $dep_list;
 367                         $package_page .= "</div> <!-- end pdeps -->\n";
 368                     }
 369
 370                     #
 371                     # Source package download
 372                     #
 373                     $package_page .= "<div id=\"pdownload\">\n";
 374                     $package_page .= sprintf( "<h2>"._g( "Download %s" )."</h2>\n",
 375                                               $pkg ) ;
 376
 377                     my $source_files = $page->get_src( 'files' );
 378                     my $source_dir = $page->get_src( 'directory' );
 379
 380                     $package_page .= sprintf( '<table summary="'._g('Download information for the files of this source package' ).'">'.
 381                                               "<tr><th>%s</th><th>%s</th><th>%s</th>",
 382                                               _g("File"),
 383                                               _g("Size (in kB)"),
 384                                               _g("md5sum") );
 385                     foreach( @$source_files ) {
 386                         my ($src_file_md5, $src_file_size, $src_file_name)
 387                             = split /\s+/, $_;
 388                         (my $server = lc $archive) =~ s/-//go; # non-US hack
 389                         my $src_url = $FTP_SITES{$server}
 390                             || $FTP_SITES{us};
 391                         $src_url .= "/$source_dir/$src_file_name";
 392
 393                         $package_page .= "<tr><td><a href=\"$src_url\">$src_file_name</a></td>\n"
 394                             ."<td>".sprintf("%.1f", (floor(($src_file_size/102.4)+0.5)/10))."</td>\n"
 395                             ."<td class=\"md5sum\">$src_file_md5</td></tr>";
 396                     }
 397                     $package_page .= "</table>\n";
 398                     $package_page .= "</div> <!-- end pdownload -->\n";
 399
 400                     #
 401                     # more information
 402                     #
 403                     $package_page .= pmoreinfo( name => $pkg, data => $page,
 404                                                 opts => $opts,
 405                                                 env => \%FTP_SITES,
 406                                                 bugreports => 1,
 407                                                 changesandcopy => 1, maintainers => 1,
 408                                                 search => 1, is_source => 1 );
 409
 410                 } # else (unless $opts->{source})
 411             } # else (unless @results)
 412         } # else (unless (@results || @non_results ))
 413     }
 414
 415 #    use Data::Dumper;
 416 #    debug( "Final page object:\n".Dumper($page), 3 ) if DEBUG;
 417
 418     my $title = $opts->{source} ?
 419         _g( "Details of source package <em>%s</em> in %s" ) :
 420         _g( "Details of package <em>%s</em> in %s" ) ;
 421     my $title_tag = $opts->{source} ?
 422         _g( "Details of source package %s in %s" ) :
 423         _g( "Details of package %s in %s" ) ;
 424     %$html_header = ( title => sprintf( $title, $pkg, $suite ) ,
 425                       lang => $opts->{lang},
 426                       desc => $short_desc,
 427                       keywords => "$suite, $archive, $section, $subsection, $version",
 428                       title_tag => sprintf( $title_tag, $pkg, $suite ),
 429                       print_search_field => 'packages',
 430                       search_field_values => {
 431                           keywords => '',
 432                           searchon => $opts->{source} ? 'sourcenames' : 'names',
 433                           arch => 'any',
 434                           suite => 'all',
 435                           section => 'all',
 436                           exact => 0,
 437                           debug => $opts->{debug},
 438                       },
 439                       );
 440
 441     $$page_content = $package_page;
 442 }
 443
 444 1;
 445