1 package Packages::DoShow;
13 use Packages::Config qw( $DBDIR $ROOT @SUITES @ARCHIVES @SECTIONS
14 @ARCHITECTURES %FTP_SITES );
17 use Packages::Search qw( :all );
19 use Packages::Page ();
20 use Packages::SrcPage ();
22 our @ISA = qw( Exporter );
23 our @EXPORT = qw( do_show );
26 my ($params, $opts, $html_header, $menu, $page_content) = @_;
28 if ($params->{errors}{package}) {
29 fatal_error( "package not valid or not specified" );
31 if ($params->{errors}{suite}) {
32 fatal_error( "suite not valid or not specified" );
34 if (@{$opts->{suite}} > 1) {
35 fatal_error( "more than one suite specified for show (@{$opts->{suite}})" );
38 my $pkg = $opts->{package};
39 my $encodedpkg = uri_escape( $pkg );
40 my $suite = $opts->{suite}[0];
41 my $archive = $opts->{archive}[0] ||'';
43 my $DL_URL = "$pkg/download";
44 my $FILELIST_URL = "$pkg/files";
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;
54 sub gettext { return $_[0]; };
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: $!";
65 unless ($opts->{source}) {
66 read_entry_all( \%packages, $pkg, \@results, \@non_results, $opts );
68 read_src_entry_all( \%sources, $pkg, \@results, \@non_results, $opts );
71 unless (@results || @non_results ) {
72 fatal_error( "No such package".
73 "{insert link to search page with substring search}" );
76 foreach (@results, @non_results) {
79 if ($a =~ /^(?:us|security|non-US)$/o) {
82 $all_suites{"$s/$a"}++;
85 foreach (suites_sort(keys %all_suites)) {
86 if (("$suite/$archive" eq $_)
87 || (!$all_suites{"$suite/$archive"} && ($suite eq $_))) {
88 $$menu .= "[ <strong>$_</strong> ] ";
91 "[ <a href=\"$ROOT/$_/$encodedpkg\">$_</a> ] ";
97 fatal_error( "Package not available in this suite" );
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;
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 );
112 $page->add_provided_by([split /\s+/, $provided_by]);
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 )
125 my $st1 = new Benchmark;
126 my $std = timediff($st1, $st0);
127 debug( "Data search and merging took ".timestr($std) );
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;
140 # process description
142 my $desc = $descriptions{$did};
143 $short_desc = encode_entities( $1, "<>&\"" )
144 if $desc =~ s/^(.*)$//m;
145 my $long_desc = encode_entities( $desc, "<>&\"" );
147 $long_desc =~ s,((ftp|http|https)://[\S~-]+?/?)((\>\;)?[)]?[']?[:.\,]?(\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 );
155 $$menu .= simple_menu( [ gettext( "Distribution:" ),
156 gettext( "Overview over this suite" ),
159 [ gettext( "Section:" ),
160 gettext( "All packages in this section" ),
161 "$ROOT/$suite/$subsection/",
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 );
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) );
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." )
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." )
189 $package_page .= pdesc( $short_desc, $long_desc );
192 # display dependencies
195 $dep_list = print_deps( \%packages, $opts, $pkg,
196 $page->get_dep_field('depends'),
198 $dep_list .= print_deps( \%packages, $opts, $pkg,
199 $page->get_dep_field('recommends'),
201 $dep_list .= print_deps( \%packages, $opts, $pkg,
202 $page->get_dep_field('suggests'),
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." ) );
212 $package_page .= pdeplegend( [ 'dep', gettext( 'depends' ) ],
213 [ 'rec', gettext( 'recommends' ) ],
214 [ 'sug', gettext( 'suggests' ) ], );
216 $package_page .= $dep_list;
217 $package_page .= "</div> <!-- end pdeps -->\n";
223 my $encodedpack = uri_escape( $pkg );
224 $package_page .= "<div id=\"pdownload\">";
225 $package_page .= sprintf( "<h2>".gettext( "Download %s\n" )."</h2>",
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 );
240 $package_page .= gettext( "no current information" );
242 $package_page .= "</td>\n<td align=right>"; #FIXME: css
243 $package_page .= floor(($sizes_deb->{$a}/102.4)+0.5)/10 . " kB";
244 $package_page .= "</td>\n<td align=right>"; #FIXME: css
245 $package_page .= $sizes_inst->{$a} . " kB";
246 $package_page .= "</td>\n</tr>";
248 $package_page .= "</table>\n";
249 $package_page .= "</div> <!-- end pdownload -->\n";
254 $package_page .= pmoreinfo( name => $pkg, data => $page,
257 bugreports => 1, sourcedownload => 1,
258 changesandcopy => 1, maintainers => 1,
260 } else { # unless $page->is_virtual
261 $short_desc = gettext( "virtual package" );
263 $$menu .= simple_menu( [ gettext( "Distribution:" ),
264 gettext( "Overview over this distribution" ),
267 [ gettext( "Section:" ),
268 gettext( "All packages in this section" ),
269 "$ROOT/$suite/virtual/",
273 $package_page .= title( sprintf( gettext( "Virtual Package: %s" ),
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 ));
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');
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;
291 my $data = $sources_all{"$archive $suite $pkg"};
292 $page->merge_data($pkg, $suite, $archive, $data)
293 or debug( "Merging $pkg $version FAILED", 2 );
295 $version = $page->{version};
297 my $st1 = new Benchmark;
298 my $std = timediff($st1, $st0);
299 debug( "Data search and merging took ".timestr($std) );
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' );
306 $$menu .= simple_menu( [ gettext( "Distribution:" ),
307 gettext( "Overview over this suite" ),
310 [ gettext( "Section:" ),
311 gettext( "All packages in this section" ),
312 "/$suite/$subsection/",
316 my $title .= sprintf( gettext( "Source Package: %s (%s)" ),
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 );
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." )
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." )
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 -->';
345 # display dependencies
348 $dep_list = print_src_deps( \%packages, $opts, $pkg,
349 $page->get_dep_field('build-depends'),
351 $dep_list .= print_src_deps( \%packages, $opts, $pkg,
352 $page->get_dep_field('build-depends-indep'),
353 'build-depends-indep' );
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." ) );
362 $package_page .= pdeplegend( [ 'adep', gettext( 'build-depends' ) ],
363 [ 'idep', gettext( 'build-depends-indep' ) ],
366 $package_page .= $dep_list;
367 $package_page .= "</div> <!-- end pdeps -->\n";
371 # Source package download
373 $package_page .= "<div id=\"pdownload\">\n";
374 $package_page .= sprintf( "<h2>".gettext( "Download %s" )."</h2>\n",
377 my $source_files = $page->get_src( 'files' );
378 my $source_dir = $page->get_src( 'directory' );
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>",
383 gettext("Size (in kB)"),
385 foreach( @$source_files ) {
386 my ($src_file_md5, $src_file_size, $src_file_name)
391 $src_url = $FTP_SITES{security}; last };
393 $src_url = $FTP_SITES{volatile}; last };
395 $src_url = $FTP_SITES{backports}; last };
397 $src_url = $FTP_SITES{'non-US'}; last };
398 $src_url = $FTP_SITES{us};
400 $src_url .= "/$source_dir/$src_file_name";
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>";
406 $package_page .= "</table>\n";
407 $package_page .= "</div> <!-- end pdownload -->\n";
412 $package_page .= pmoreinfo( name => $pkg, data => $page,
416 changesandcopy => 1, maintainers => 1,
417 search => 1, is_source => 1 );
419 } # else (unless $opts->{source})
420 } # else (unless @results)
421 } # else (unless (@results || @non_results ))
425 # debug( "Final page object:\n".Dumper($page), 3 );
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 ,
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 => {
446 debug => $opts->{debug},
450 $$page_content = $package_page;