1 package Packages::DoShow;
9 use Benchmark ':hireswallclock';
13 use Packages::Config qw( $DBDIR $ROOT @SUITES @ARCHIVES @SECTIONS
14 @ARCHITECTURES %FTP_SITES $SEARCH_URL );
15 use Packages::I18N::Locale;
18 use Packages::Search qw( :all );
20 use Packages::Page ();
21 use Packages::SrcPage ();
23 our @ISA = qw( Exporter );
24 our @EXPORT = qw( do_show );
27 my ($params, $opts, $html_header, $menu, $page_content) = @_;
29 if ($params->{errors}{package}) {
30 fatal_error( _g( "package not valid or not specified" ) );
32 if ($params->{errors}{suite}) {
33 fatal_error( _g( "suite not valid or not specified" ) );
35 if (@{$opts->{suite}} > 1) {
36 fatal_error( sprintf( _g( "more than one suite specified for show (%s)" ), "@{$opts->{suite}}" ) );
39 my $pkg = $opts->{package};
40 my $encodedpkg = uri_escape( $pkg );
41 my $suite = $opts->{suite}[0];
42 my $archive = $opts->{archive}[0] ||'';
44 my $DL_URL = "$pkg/download";
45 my $FILELIST_URL = "$pkg/files";
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;
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: $!";
64 unless ($opts->{source}) {
65 read_entry_all( \%packages, $pkg, \@results, \@non_results, $opts );
67 read_src_entry_all( \%sources, $pkg, \@results, \@non_results, $opts );
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" ) );
75 foreach (@results, @non_results) {
78 if ($a =~ /^(?:us|security|non-US)$/o) {
81 $all_suites{"$s/$a"}++;
84 foreach (suites_sort(keys %all_suites)) {
85 if (("$suite/$archive" eq $_)
86 || (!$all_suites{"$suite/$archive"} && ($suite eq $_))) {
87 $$menu .= "[ <strong>$_</strong> ] ";
90 "[ <a href=\"$ROOT/$_/$encodedpkg\">$_</a> ] ";
96 fatal_error( _g( "Package not available in this suite." ) );
98 unless ($opts->{source}) {
99 for my $entry (@results) {
100 debug( join(":", @$entry), 1 ) if DEBUG;
101 my (undef, $archive, undef, $arch, $section, $subsection,
102 $priority, $version, $provided_by) = @$entry;
104 if ($arch ne 'virtual') {
105 my %data = split /\000/, $packages_all{"$pkg $arch $version"};
106 $data{package} = $pkg;
107 $data{architecture} = $arch;
108 $data{version} = $version;
109 $page->merge_package(\%data) or debug( "Merging $pkg $arch $version FAILED", 2 ) if DEBUG;
111 $page->add_provided_by([split /\s+/, $provided_by]);
115 unless ($page->is_virtual()) {
116 $version = $page->{newest};
117 my $source = $page->get_newest( 'source' );
118 $archive = $page->get_newest( 'archive' );
119 debug( "find source package: source=$source", 1) if DEBUG;
120 my $src_data = $sources_all{"$archive $suite $source"};
121 $page->add_src_data( $source, $src_data )
124 my $st1 = new Benchmark;
125 my $std = timediff($st1, $st0);
126 debug( "Data search and merging took ".timestr($std) ) if DEBUG;
128 my $did = $page->get_newest( 'description' );
129 $section = $page->get_newest( 'section' );
130 $subsection = $page->get_newest( 'subsection' );
131 my $filenames = $page->get_arch_field( 'filename' );
132 my $file_md5sums = $page->get_arch_field( 'md5sum' );
133 my $archives = $page->get_arch_field( 'archive' );
134 my $versions = $page->get_arch_field( 'version' );
135 my $sizes_inst = $page->get_arch_field( 'installed-size' );
136 my $sizes_deb = $page->get_arch_field( 'size' );
137 my @archs = sort $page->get_architectures;
139 # process description
141 my $desc = $descriptions{$did};
142 $short_desc = encode_entities( $1, "<>&\"" )
143 if $desc =~ s/^(.*)$//m;
144 my $long_desc = encode_entities( $desc, "<>&\"" );
146 $long_desc =~ s,((ftp|http|https)://[\S~-]+?/?)((\>\;)?[)]?[']?[:.\,]?(\s|$)),<a href=\"$1\">$1</a>$3,go; # syntax highlighting -> '];
147 $long_desc =~ s/\A //o;
148 $long_desc =~ s/\n /\n/sgo;
149 $long_desc =~ s/\n.\n/\n<p>\n/go;
150 $long_desc =~ s/(((\n|\A) [^\n]*)+)/\n<pre>$1\n<\/pre>/sgo;
151 # $long_desc = conv_desc( $lang, $long_desc );
152 # $short_desc = conv_desc( $lang, $short_desc );
154 $$menu .= simple_menu( [ _g( "Distribution:" ),
155 _g( "Overview over this suite" ),
159 _g( "All packages in this section" ),
160 "$ROOT/$suite/$subsection/",
164 my $v_str = $version;
165 my $multiple_versions = grep { $_ ne $version } values %$versions;
166 $v_str .= " (and others)" if $multiple_versions;
167 my $title .= sprintf( _g( "Package: %s (%s)" ), $pkg, $v_str );
168 $title .= " ".marker( $archive ) if $archive ne 'us';
169 $title .= " ".marker( $subsection ) if $subsection eq 'non-US'
170 and $archive ne 'non-US'; # non-US/security
171 $title .= " ".marker( $section ) if $section ne 'main';
172 $package_page .= title( $title );
174 if (my $provided_by = $page->{provided_by}) {
175 note( _g( "This is also a virtual package provided by ").join( ', ', map { "<a href=\"$ROOT/$suite/$_\">$_</a>" } @$provided_by) );
178 if ($suite eq "experimental") {
179 note( _g( "Experimental package"),
180 _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>"
183 if ($subsection eq "debian-installer") {
184 note( _g( "debian-installer udeb package"),
185 _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.' )
188 $package_page .= pdesc( $short_desc, $long_desc );
191 # display dependencies
194 $dep_list = print_deps( \%packages, $opts, $pkg,
195 $page->get_dep_field('depends'),
197 $dep_list .= print_deps( \%packages, $opts, $pkg,
198 $page->get_dep_field('recommends'),
200 $dep_list .= print_deps( \%packages, $opts, $pkg,
201 $page->get_dep_field('suggests'),
205 $package_page .= "<div id=\"pdeps\">\n";
206 $package_page .= sprintf( "<h2>"._g( "Other Packages Related to %s" )."</h2>\n", $pkg );
207 if ($suite eq "experimental") {
208 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/" ) );
211 $package_page .= pdeplegend( [ 'dep', _g( 'depends' ) ],
212 [ 'rec', _g( 'recommends' ) ],
213 [ 'sug', _g( 'suggests' ) ], );
215 $package_page .= $dep_list;
216 $package_page .= "</div> <!-- end pdeps -->\n";
222 my $encodedpack = uri_escape( $pkg );
223 $package_page .= "<div id=\"pdownload\">";
224 $package_page .= sprintf( "<h2>"._g( "Download %s\n" )."</h2>",
226 $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";
227 $package_page .= "<caption class=\"hidecss\">"._g("Download for all available architectures")."</caption>\n";
228 $package_page .= "<tr>\n";
229 $package_page .= "<th>"._g("Architecture")."</th>";
230 $package_page .= "<th>"._g("Version")."</th>"
231 if $multiple_versions;
232 $package_page .= "<th>"._g( "Package Size")."</th><th>"._g("Installed Size")."</th><th>"._g("Files")."</th></tr>\n";
233 foreach my $a ( @archs ) {
234 $package_page .= "<tr>\n";
235 $package_page .= "<th><a href=\"$ROOT/$suite/$encodedpkg/$a/download";
236 $package_page .= "\">$a</a></th>\n";
237 $package_page .= "<td>".$versions->{$a}."</td>"
238 if $multiple_versions;
239 $package_page .= '</td><td class="size">';
240 $package_page .= floor(($sizes_deb->{$a}/102.4)+0.5)/10 . " kB";
241 $package_page .= '</td><td class="size">';
242 $package_page .= $sizes_inst->{$a} . " kB";
243 $package_page .= "</td>\n<td>";
244 if ( $suite ne "experimental" ) {
245 $package_page .= sprintf( "[<a href=\"%s\">"._g( "list of files" )."</a>]\n",
246 "$ROOT/$suite/$encodedpkg/$a/filelist", $pkg );
248 $package_page .= _g( "no current information" );
250 $package_page .= "</td>\n</tr>";
252 $package_page .= "</table>\n";
253 $package_page .= "</div> <!-- end pdownload -->\n";
258 $package_page .= pmoreinfo( name => $pkg, data => $page,
261 bugreports => 1, sourcedownload => 1,
262 changesandcopy => 1, maintainers => 1,
264 } else { # unless $page->is_virtual
265 $short_desc = _g( "virtual package" );
267 $$menu .= simple_menu( [ _g( "Distribution:" ),
268 _g( "Overview over this distribution" ),
272 _g( "All packages in this section" ),
273 "$ROOT/$suite/virtual/",
277 $package_page .= title( sprintf( _g( "Virtual Package: %s" ),
280 my $policy_url = 'http://www.debian.org/doc/debian-policy/';
281 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>.' ),
282 $policy_url, $policy_url ));
284 $package_page .= sprintf( "<h2>"._g( "Packages providing %s" )."</h2>", $pkg );
285 my $provided_by = $page->{provided_by};
286 $package_page .= pkg_list( \%packages, $opts, $provided_by, 'en');
288 } # else (unless $page->is_virtual)
289 } else { # unless $opts->{source}
290 for my $entry (@results) {
291 debug( join(":", @$entry), 1 ) if DEBUG;
292 my (undef, $archive, undef, $section, $subsection,
293 $priority, $version) = @$entry;
295 my $data = $sources_all{"$archive $suite $pkg"};
296 $page->merge_data($pkg, $suite, $archive, $data)
297 or debug( "Merging $pkg $version FAILED", 2 ) if DEBUG;
299 $version = $page->{version};
301 my $st1 = new Benchmark;
302 my $std = timediff($st1, $st0);
303 debug( "Data search and merging took ".timestr($std) ) if DEBUG;
305 $archive = $page->get_newest( 'archive' );
306 $section = $page->get_newest( 'section' );
307 $subsection = $page->get_newest( 'subsection' );
309 $$menu .= simple_menu( [ _g( "Distribution:" ),
310 _g( "Overview over this suite" ),
314 _g( "All packages in this section" ),
315 "/$suite/$subsection/",
319 my $title .= sprintf( _g( "Source Package: %s (%s)" ),
321 $title .= " ".marker( $archive ) if $archive ne 'us';
322 $title .= " ".marker( $subsection ) if $subsection eq 'non-US'
323 and $archive ne 'non-US'; # non-US/security
324 $title .= " ".marker( $section ) if $section ne 'main';
325 $package_page .= title( $title );
327 if ($suite eq "experimental") {
328 note( _g( "Experimental package"),
329 _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>"
332 if ($subsection eq "debian-installer") {
333 note( _g( "debian-installer udeb package"),
334 _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.' )
338 my $binaries = find_binaries( $pkg, $archive, $suite, \%src2bin );
339 if ($binaries && @$binaries) {
340 $package_page .= '<div class="pdesc">';
341 $package_page .= _g( "The following binary packages are built from this source package:" );
342 $package_page .= pkg_list( \%packages, $opts, $binaries, 'en' );
343 $package_page .= '</div> <!-- end pdesc -->';
347 # display dependencies
350 $dep_list = print_deps( \%packages, $opts, $pkg,
351 $page->get_dep_field('build-depends'),
353 $dep_list .= print_deps( \%packages, $opts, $pkg,
354 $page->get_dep_field('build-depends-indep'),
355 'build-depends-indep' );
358 $package_page .= "<div id=\"pdeps\">\n";
359 $package_page .= sprintf( "<h2>"._g( "Other Packages Related to %s" )."</h2>\n", $pkg );
360 if ($suite eq "experimental") {
361 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/" ) );
365 $package_page .= pdeplegend( [ 'adep', _g( 'build-depends' ) ],
366 [ 'idep', _g( 'build-depends-indep' ) ],
369 $package_page .= $dep_list;
370 $package_page .= "</div> <!-- end pdeps -->\n";
374 # Source package download
376 $package_page .= "<div id=\"pdownload\">\n";
377 $package_page .= sprintf( "<h2>"._g( "Download %s" )."</h2>\n",
380 my $source_files = $page->get_src( 'files' );
381 my $source_dir = $page->get_src( 'directory' );
383 $package_page .= sprintf( '<table summary="'._g('Download information for the files of this source package' ).'">'.
384 "<tr><th>%s</th><th>%s</th><th>%s</th>",
388 foreach( @$source_files ) {
389 my ($src_file_md5, $src_file_size, $src_file_name)
394 $src_url = $FTP_SITES{security}; last };
396 $src_url = $FTP_SITES{volatile}; last };
399 $src_url = $FTP_SITES{backports}; last };
401 $src_url = $FTP_SITES{'non-US'}; last };
402 $src_url = $FTP_SITES{us};
404 $src_url .= "/$source_dir/$src_file_name";
406 $package_page .= "<tr><td><a href=\"$src_url\">$src_file_name</a></td>\n"
407 ."<td>".sprintf("%.1f", (floor(($src_file_size/102.4)+0.5)/10))."</td>\n"
408 ."<td class=\"md5sum\">$src_file_md5</td></tr>";
410 $package_page .= "</table>\n";
411 $package_page .= "</div> <!-- end pdownload -->\n";
416 $package_page .= pmoreinfo( name => $pkg, data => $page,
420 changesandcopy => 1, maintainers => 1,
421 search => 1, is_source => 1 );
423 } # else (unless $opts->{source})
424 } # else (unless @results)
425 } # else (unless (@results || @non_results ))
429 # debug( "Final page object:\n".Dumper($page), 3 ) if DEBUG;
431 my $title = $opts->{source} ?
432 _g( "Details of source package <em>%s</em> in %s" ) :
433 _g( "Details of package <em>%s</em> in %s" ) ;
434 my $title_tag = $opts->{source} ?
435 _g( "Details of source package %s in %s" ) :
436 _g( "Details of package %s in %s" ) ;
437 %$html_header = ( title => sprintf( $title, $pkg, $suite ) ,
438 lang => $opts->{lang},
440 keywords => "$suite, $archive, $section, $subsection, $version",
441 title_tag => sprintf( $title_tag, $pkg, $suite ),
442 print_search_field => 'packages',
443 search_field_values => {
445 searchon => $opts->{source} ? 'sourcenames' : 'names',
450 debug => $opts->{debug},
454 $$page_content = $package_page;