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;
  10 use Exporter;
  11
  12 use Deb::Versions;
  13 use Packages::Config qw( $DBDIR $ROOT @SUITES @ARCHIVES @SECTIONS
  14                          @ARCHITECTURES %FTP_SITES );
  15 use Packages::CGI;
  16 use Packages::DB;
  17 use Packages::Search qw( :all );
  18 use Packages::HTML;
  19 use Packages::Page ();
  20 use Packages::SrcPage ();
  21
  22 our @ISA = qw( Exporter );
  23 our @EXPORT = qw( do_show );
  24
  25 sub do_show {
  26     my ($params, $opts, $html_header, $menu, $page_content) = @_;
  27
  28     if ($params->{errors}{package}) {
  29         fatal_error( "package not valid or not specified" );
  30     }
  31     if ($params->{errors}{suite}) {
  32         fatal_error( "suite not valid or not specified" );
  33     }
  34     if (@{$opts->{suite}} > 1) {
  35         fatal_error( "more than one suite specified for show (@{$opts->{suite}})" );
  36     }
  37
  38     my $pkg = $opts->{package};
  39     my $encodedpkg = uri_escape( $pkg );
  40     my $suite = $opts->{suite}[0];
  41     my $archive = $opts->{archive}[0] ||'';
  42
  43     my $DL_URL = "$pkg/download";
  44     my $FILELIST_URL = "$pkg/files";
  45
  46     our (%packages_all, %sources_all);
  47     my (@results, @non_results);
  48     my $page = $opts->{source} ?
  49         new Packages::SrcPage( $pkg ) :
  50         new Packages::Page( $pkg );
  51     my $package_page = "";
  52     my ($short_desc, $version, $section, $subsection) = ("")x5;
  53
  54     sub gettext { return $_[0]; };
  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( "No such package".
  73                          "{insert link to search page with substring search}" );
  74         } else {
  75             my %all_suites;
  76             foreach (@results, @non_results) {
  77                 my $a = $_->[1];
  78                 my $s = $_->[2];
  79                 if ($a =~ /^(?:us|security|non-US)$/o) {
  80                     $all_suites{$s}++;
  81                 } else {
  82                     $all_suites{"$s/$a"}++;
  83                 }
  84             }
  85             foreach (suites_sort(keys %all_suites)) {
  86                 if (("$suite/$archive" eq $_)
  87                     || (!$all_suites{"$suite/$archive"} && ($suite eq $_))) {
  88                     $$menu .= "[ <strong>$_</strong> ] ";
  89                 } else {
  90                     $$menu .=
  91                         "[ <a href=\"$ROOT/$_/$encodedpkg\">$_</a> ] ";
  92                 }
  93             }
  94             $$menu .= '<br>';
  95
  96             unless (@results) {
  97                 fatal_error( "Package not available in this suite" );
  98             } else {
  99                 unless ($opts->{source}) {
 100                     for my $entry (@results) {
 101                         debug( join(":", @$entry), 1 );
 102                         my (undef, $archive, undef, $arch, $section, $subsection,
 103                             $priority, $version, $provided_by) = @$entry;
 104
 105                         if ($arch ne 'virtual') {
 106                             my %data = split /\000/, $packages_all{"$pkg $arch $version"};
 107                             $data{package} = $pkg;
 108                             $data{architecture} = $arch;
 109                             $data{version} = $version;
 110                             $page->merge_package(\%data) or debug( "Merging $pkg $arch $version FAILED", 2 );
 111                         } else {
 112                             $page->add_provided_by([split /\s+/, $provided_by]);
 113                         }
 114                     }
 115
 116                     unless ($page->is_virtual()) {
 117                         $version = $page->{newest};
 118                         my $source = $page->get_newest( 'source' );
 119                         $archive = $page->get_newest( 'archive' );
 120                         debug( "find source package: source=$source", 1);
 121                         my $src_data = $sources_all{"$archive $suite $source"};
 122                         $page->add_src_data( $source, $src_data )
 123                             if $src_data;
 124
 125                         my $st1 = new Benchmark;
 126                         my $std = timediff($st1, $st0);
 127                         debug( "Data search and merging took ".timestr($std) );
 128
 129                         my ($v_str, $v_str_arch, $v_str_arr) = $page->get_version_string();
 130                         my $did = $page->get_newest( 'description' );
 131                         $section = $page->get_newest( 'section' );
 132                         $subsection = $page->get_newest( 'subsection' );
 133                         my $filenames = $page->get_arch_field( 'filename' );
 134                         my $file_md5sums = $page->get_arch_field( 'md5sum' );
 135                         my $archives = $page->get_arch_field( 'archive' );
 136                         my $sizes_inst = $page->get_arch_field( 'installed-size' );
 137                         my $sizes_deb = $page->get_arch_field( 'size' );
 138                         my @archs = sort $page->get_architectures;
 139
 140                         # process description
 141                         #
 142                         my $desc = $descriptions{$did};
 143                         $short_desc = encode_entities( $1, "<>&\"" )
 144                             if $desc =~ s/^(.*)$//m;
 145                         my $long_desc = encode_entities( $desc, "<>&\"" );
 146
 147                         $long_desc =~ s,((ftp|http|https)://[\S~-]+?/?)((\&gt\;)?[)]?[']?[:.\,]?(\s|$)),<a href=\"$1\">$1</a>$3,go; # syntax highlighting -> '];
 148                         $long_desc =~ s/\A //o;
 149                         $long_desc =~ s/\n /\n/sgo;
 150                         $long_desc =~ s/\n.\n/\n<p>\n/go;
 151                         $long_desc =~ s/(((\n|\A) [^\n]*)+)/\n<pre>$1\n<\/pre>/sgo;
 152 #           $long_desc = conv_desc( $lang, $long_desc );
 153 #           $short_desc = conv_desc( $lang, $short_desc );
 154
 155                         $$menu .= simple_menu( [ gettext( "Distribution:" ),
 156                                                  gettext( "Overview over this suite" ),
 157                                                  "$ROOT/$suite/",
 158                                                  $suite ],
 159                                                [ gettext( "Section:" ),
 160                                                  gettext( "All packages in this section" ),
 161                                                  "$ROOT/$suite/$subsection/",
 162                                                  $subsection ],
 163                                                );
 164
 165                         my $title .= sprintf( gettext( "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                         $package_page .= "<h2>".gettext( "Versions:" )." $v_str_arch</h2>\n"
 173                             unless $version eq $v_str;
 174                         if (my $provided_by = $page->{provided_by}) {
 175                             note( gettext( "This is also a virtual package provided by ").join( ', ', map { "<a href=\"$ROOT/$suite/$_\">$_</a>"  } @$provided_by) );
 176                         }
 177
 178                         if ($suite eq "experimental") {
 179                             note( gettext( "Experimental package"),
 180                                   gettext( "Warning: This package is from the <span class=\"pred\">experimental</span> 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><p>".
 181                                   gettext( "Users of experimental packages are encouraged to contact the package maintainers directly in case of problems." )
 182                                   );
 183                         }
 184                         if ($subsection eq "debian-installer") {
 185                             note( gettext( "debian-installer udeb package"),
 186                                   gettext( "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." )
 187                                   );
 188                         }
 189                         $package_page .= pdesc( $short_desc, $long_desc );
 190
 191                         #
 192                         # display dependencies
 193                         #
 194                         my $dep_list;
 195                         $dep_list = print_deps( \%packages, $opts, $pkg,
 196                                                 $page->get_dep_field('depends'),
 197                                                 'depends' );
 198                         $dep_list .= print_deps( \%packages, $opts, $pkg,
 199                                                  $page->get_dep_field('recommends'),
 200                                                  'recommends' );
 201                         $dep_list .= print_deps( \%packages, $opts, $pkg,
 202                                                  $page->get_dep_field('suggests'),
 203                                                  'suggests' );
 204
 205                         if ( $dep_list ) {
 206                             $package_page .= "<div id=\"pdeps\">\n";
 207                             $package_page .= sprintf( "<h2>".gettext( "Other Packages Related to %s" )."</h2>\n", $pkg );
 208                             if ($suite eq "experimental") {
 209                                 note( gettext( "Note that the \"<span class=\"pred\">experimental</span>\" distribution is not self-contained; missing dependencies are likely found in the \"<a href=\"/unstable/\">unstable</a>\" distribution." ) );
 210                             }
 211
 212                             $package_page .= pdeplegend( [ 'dep',  gettext( 'depends' ) ],
 213                                                          [ 'rec',  gettext( 'recommends' ) ],
 214                                                          [ 'sug',  gettext( 'suggests' ) ], );
 215
 216                             $package_page .= $dep_list;
 217                             $package_page .= "</div> <!-- end pdeps -->\n";
 218                         }
 219
 220                         #
 221                         # Download package
 222                         #
 223                         my $encodedpack = uri_escape( $pkg );
 224                         $package_page .= "<div id=\"pdownload\">";
 225                         $package_page .= sprintf( "<h2>".gettext( "Download %s\n" )."</h2>",
 226                                                   $pkg ) ;
 227                         $package_page .= "<table border=\"1\" summary=\"".gettext("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";
 228                         $package_page .= "<caption class=\"hidecss\">".gettext("Download for all available architectures")."</caption>\n";
 229                         $package_page .= "<tr>\n";
 230                         $package_page .= "<th>".gettext("Architecture")."</th><th>".gettext("Files")."</th><th>".gettext( "Package Size")."</th><th>".gettext("Installed Size")."</th></tr>\n";
 231                         foreach my $a ( @archs ) {
 232                             $package_page .= "<tr>\n";
 233                             $package_page .=  "<th><a href=\"$ROOT/$suite/$encodedpkg/$a/download";
 234                             $package_page .=  "\">$a</a></th>\n";
 235                             $package_page .= "<td>";
 236                             if ( $suite ne "experimental" ) {
 237                                 $package_page .= sprintf( "[<a href=\"%s\">".gettext( "list of files" )."</a>]\n",
 238                                                           "$ROOT/$suite/$encodedpkg/$a/filelist", $pkg );
 239                             } else {
 240                                 $package_page .= gettext( "no current information" );
 241                             }
 242                             $package_page .= "</td>\n<td align=right>"; #FIXME: css
 243                             $package_page .=  floor(($sizes_deb->{$a}/102.4)+0.5)/10 . "&nbsp;kB";
 244                             $package_page .= "</td>\n<td align=right>"; #FIXME: css
 245                             $package_page .=  $sizes_inst->{$a} . "&nbsp;kB";
 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 = gettext( "virtual package" );
 262
 263                         $$menu .= simple_menu( [ gettext( "Distribution:" ),
 264                                                  gettext( "Overview over this distribution" ),
 265                                                  "$ROOT/",
 266                                                  $suite ],
 267                                                [ gettext( "Section:" ),
 268                                                  gettext( "All packages in this section" ),
 269                                                  "$ROOT/$suite/virtual/",
 270
 271                                                  'virtual' ], );
 272
 273                         $package_page .= title( sprintf( gettext( "Virtual Package: %s" ),
 274                                                          $pkg ) );
 275
 276                         my $policy_url = 'http://www.debian.org/doc/debian-policy/';
 277                         note( sprintf( gettext( "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>".gettext( "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 );
 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 );
 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) );
 300
 301                     my ($v_str, $v_str_arr) = $page->get_version_string();
 302                     $archive = $page->get_newest( 'archive' );
 303                     $section = $page->get_newest( 'section' );
 304                     $subsection = $page->get_newest( 'subsection' );
 305
 306                     $$menu .= simple_menu( [ gettext( "Distribution:" ),
 307                                              gettext( "Overview over this suite" ),
 308                                              "/$suite/",
 309                                              $suite ],
 310                                            [ gettext( "Section:" ),
 311                                              gettext( "All packages in this section" ),
 312                                              "/$suite/$subsection/",
 313                                              $subsection ],
 314                                            );
 315
 316                     my $title .= sprintf( gettext( "Source Package: %s (%s)" ),
 317                                           $pkg, $v_str );
 318                     $title .=  " ".marker( $archive ) if $archive ne 'us';
 319                     $title .=  " ".marker( $subsection ) if $subsection eq 'non-US'
 320                         and $archive ne 'non-US'; # non-US/security
 321                     $title .=  " ".marker( $section ) if $section ne 'main';
 322                     $package_page .= title( $title );
 323
 324                     if ($suite eq "experimental") {
 325                         note( gettext( "Experimental package"),
 326                               gettext( "Warning: This package is from the <span class=\"pred\">experimental</span> 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><p>".
 327                               gettext( "Users of experimental packages are encouraged to contact the package maintainers directly in case of problems." )
 328                               );
 329                     }
 330                     if ($subsection eq "debian-installer") {
 331                         note( gettext( "debian-installer udeb package"),
 332                               gettext( "Warning: This package is intended for the use in building <a href=\"http://www.debian.org/devel/debian-installer\">debian-installer</a> images only. Do not install it on a normal Debian system." )
 333                               );
 334                     }
 335
 336                     my $binaries = find_binaries( $pkg, $archive, $suite, \%src2bin );
 337                     if ($binaries && @$binaries) {
 338                         $package_page .= '<div class="pdesc">';
 339                         $package_page .= gettext( "The following binary packages are built from this source package:" );
 340                         $package_page .= pkg_list( \%packages, $opts, $binaries, 'en' );
 341                         $package_page .= '</div> <!-- end pdesc -->';
 342                     }
 343
 344                     #
 345                     # display dependencies
 346                     #
 347                     my $dep_list;
 348                     $dep_list = print_src_deps( \%packages, $opts, $pkg,
 349                                                 $page->get_dep_field('build-depends'),
 350                                                 'build-depends' );
 351                     $dep_list .= print_src_deps( \%packages, $opts, $pkg,
 352                                                  $page->get_dep_field('build-depends-indep'),
 353                                                  'build-depends-indep' );
 354
 355                     if ( $dep_list ) {
 356                         $package_page .= "<div id=\"pdeps\">\n";
 357                         $package_page .= sprintf( "<h2>".gettext( "Other Packages Related to %s" )."</h2>\n", $pkg );
 358                         if ($suite eq "experimental") {
 359                             note( gettext( "Note that the \"<span class=\"pred\">experimental</span>\" distribution is not self-contained; missing dependencies are likely found in the \"<a href=\"/unstable/\">unstable</a>\" distribution." ) );
 360                         }
 361
 362                         $package_page .= pdeplegend( [ 'adep',  gettext( 'build-depends' ) ],
 363                                                      [ 'idep',  gettext( '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>".gettext( "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 cellspacing=\"0\" cellpadding=\"2\" summary=\"Download information for the files of this source package\">\n"
 381                                               ."<tr><th>%s</th><th>%s</th><th>%s</th>",
 382                                               gettext("File"),
 383                                               gettext("Size (in kB)"),
 384                                               gettext("md5sum") );
 385                     foreach( @$source_files ) {
 386                         my ($src_file_md5, $src_file_size, $src_file_name)
 387                             = split /\s+/, $_;
 388                         my $src_url;
 389                         for ($archive) {
 390                             /security/o &&  do {
 391                                 $src_url = $FTP_SITES{security}; last };
 392                             /volatile/o &&  do {
 393                                 $src_url = $FTP_SITES{volatile}; last };
 394                             /backports/o &&  do {
 395                                 $src_url = $FTP_SITES{backports}; last };
 396                             /non-us/io  &&  do {
 397                                 $src_url = $FTP_SITES{'non-US'}; last };
 398                             $src_url = $FTP_SITES{us};
 399                         }
 400                         $src_url .= "/$source_dir/$src_file_name";
 401
 402                         $package_page .= "<tr><td><a href=\"$src_url\">$src_file_name</a></td>\n"
 403                             ."<td class=\"dotalign\">".sprintf("%.1f", (floor(($src_file_size/102.4)+0.5)/10))."</td>\n"
 404                             ."<td>$src_file_md5</td></tr>";
 405                     }
 406                     $package_page .= "</table>\n";
 407                     $package_page .= "</div> <!-- end pdownload -->\n";
 408
 409                     #
 410                     # more information
 411                     #
 412                     $package_page .= pmoreinfo( name => $pkg, data => $page,
 413                                                 opts => $opts,
 414                                                 env => \%FTP_SITES,
 415                                                 bugreports => 1,
 416                                                 changesandcopy => 1, maintainers => 1,
 417                                                 search => 1, is_source => 1 );
 418
 419                 } # else (unless $opts->{source})
 420             } # else (unless @results)
 421         } # else (unless (@results || @non_results ))
 422     }
 423
 424 #    use Data::Dumper;
 425 #    debug( "Final page object:\n".Dumper($page), 3 );
 426
 427     my $title = $opts->{source} ?
 428         "Details of source package <em>$pkg</em> in $suite"  :
 429         "Details of package <em>$pkg</em> in $suite" ;
 430     my $title_tag = $opts->{source} ?
 431         "Details of source package $pkg in $suite"  :
 432         "Details of package $pkg in $suite" ;
 433     %$html_header = ( title => $title ,
 434                       lang => 'en',
 435                       desc => $short_desc,
 436                       keywords => "$suite, $archive, $section, $subsection, $version",
 437                       title_tag => "Details of package $pkg in $suite",
 438                       print_search_field => 'packages',
 439                       search_field_values => {
 440                           keywords => '',
 441                           searchon => 'names',
 442                           arch => 'any',
 443                           suite => 'all',
 444                           section => 'all',
 445                           exact => 0,
 446                           debug => $opts->{debug},
 447                       },
 448                       );
 449
 450     $$page_content = $package_page;
 451 }
 452
 453 1;
 454