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) {
80 foreach (suites_sort(keys %all_suites)) {
82 $$menu .= "[ <strong>$_</strong> ] ";
84 $$menu .= "[ <a href=\"$ROOT/$_/$encodedpkg\">$_</a> ] ";
90 fatal_error( _g( "Package not available in this suite." ) );
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;
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;
106 $page->add_provided_by([split /\s+/, $provided_by]);
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 )
119 my $st1 = new Benchmark;
120 my $std = timediff($st1, $st0);
121 debug( "Data search and merging took ".timestr($std) ) if DEBUG;
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;
134 # process description
136 my $desc = $descriptions{$did};
137 $short_desc = encode_entities( $1, "<>&\"" )
138 if $desc =~ s/^(.*)$//m;
139 my $long_desc = encode_entities( $desc, "<>&\"" );
141 $long_desc =~ s,((ftp|http|https)://[\S~-]+?/?)((\>\;)?[)]?[']?[:.\,]?(\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 );
149 $$menu .= simple_menu( [ _g( "Distribution:" ),
150 _g( "Overview over this suite" ),
154 _g( "All packages in this section" ),
155 "$ROOT/$suite/$subsection/",
158 _g( "Source package building this package" ),
159 "$ROOT/$suite/source/".$page->get_src('package'),
160 $page->get_src('package') ],
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 );
173 if (my $provided_by = $page->{provided_by}) {
174 note( _g( "This is also a virtual package provided by ").join( ', ', map { "<a href=\"$ROOT/$suite/$_\">$_</a>" } @$provided_by) );
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>"
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.' )
187 $package_page .= pdesc( $short_desc, $long_desc );
190 # display dependencies
193 $dep_list = print_deps( \%packages, $opts, $pkg,
194 $page->get_dep_field('depends'),
196 $dep_list .= print_deps( \%packages, $opts, $pkg,
197 $page->get_dep_field('recommends'),
199 $dep_list .= print_deps( \%packages, $opts, $pkg,
200 $page->get_dep_field('suggests'),
204 $package_page .= "<div id=\"pdeps\">\n";
205 $package_page .= sprintf( "<h2>"._g( "Other Packages Related to %s" )."</h2>\n", $pkg );
206 if ($suite eq "experimental") {
207 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/" ) );
210 $package_page .= pdeplegend( [ 'dep', _g( 'depends' ) ],
211 [ 'rec', _g( 'recommends' ) ],
212 [ 'sug', _g( 'suggests' ) ], );
214 $package_page .= $dep_list;
215 $package_page .= "</div> <!-- end pdeps -->\n";
221 my $encodedpack = uri_escape( $pkg );
222 $package_page .= "<div id=\"pdownload\">";
223 $package_page .= sprintf( "<h2>"._g( "Download %s\n" )."</h2>",
225 $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";
226 $package_page .= "<caption class=\"hidecss\">"._g("Download for all available architectures")."</caption>\n";
227 $package_page .= "<tr>\n";
228 $package_page .= "<th>"._g("Architecture")."</th>";
229 $package_page .= "<th>"._g("Version")."</th>"
230 if $multiple_versions;
231 $package_page .= "<th>"._g( "Package Size")."</th><th>"._g("Installed Size")."</th><th>"._g("Files")."</th></tr>\n";
232 foreach my $a ( @archs ) {
233 $package_page .= "<tr>\n";
234 $package_page .= "<th><a href=\"$ROOT/$suite/$encodedpkg/$a/download";
235 $package_page .= "\">$a</a></th>\n";
236 $package_page .= "<td>".$versions->{$a}."</td>"
237 if $multiple_versions;
238 $package_page .= '<td class="size">';
239 $package_page .= floor(($sizes_deb->{$a}/102.4)+0.5)/10 . " kB";
240 $package_page .= '</td><td class="size">';
241 $package_page .= $sizes_inst->{$a} . " kB";
242 $package_page .= "</td>\n<td>";
243 if ( $suite ne "experimental" ) {
244 $package_page .= sprintf( "[<a href=\"%s\">"._g( "list of files" )."</a>]\n",
245 "$ROOT/$suite/$encodedpkg/$a/filelist", $pkg );
247 $package_page .= _g( "no current information" );
249 $package_page .= "</td>\n</tr>";
251 $package_page .= "</table>\n";
252 $package_page .= "</div> <!-- end pdownload -->\n";
257 $package_page .= pmoreinfo( name => $pkg, data => $page,
260 bugreports => 1, sourcedownload => 1,
261 changesandcopy => 1, maintainers => 1,
263 } else { # unless $page->is_virtual
264 $short_desc = _g( "virtual package" );
266 $$menu .= simple_menu( [ _g( "Distribution:" ),
267 _g( "Overview over this distribution" ),
271 _g( "All packages in this section" ),
272 "$ROOT/$suite/virtual/",
276 $package_page .= title( sprintf( _g( "Virtual Package: %s" ),
279 my $policy_url = 'http://www.debian.org/doc/debian-policy/';
280 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>.' ),
281 $policy_url, $policy_url ));
283 $package_page .= sprintf( "<h2>"._g( "Packages providing %s" )."</h2>", $pkg );
284 my $provided_by = $page->{provided_by};
285 $package_page .= pkg_list( \%packages, $opts, $provided_by, 'en');
287 } # else (unless $page->is_virtual)
288 } else { # unless $opts->{source}
289 for my $entry (@results) {
290 debug( join(":", @$entry), 1 ) if DEBUG;
291 my (undef, $archive, undef, $section, $subsection,
292 $priority, $version) = @$entry;
294 my $data = $sources_all{"$archive $suite $pkg"};
295 $page->merge_data($pkg, $suite, $archive, $data)
296 or debug( "Merging $pkg $version FAILED", 2 ) if DEBUG;
298 $version = $page->{version};
300 my $st1 = new Benchmark;
301 my $std = timediff($st1, $st0);
302 debug( "Data search and merging took ".timestr($std) ) if DEBUG;
304 $archive = $page->get_newest( 'archive' );
305 $section = $page->get_newest( 'section' );
306 $subsection = $page->get_newest( 'subsection' );
308 $$menu .= simple_menu( [ _g( "Distribution:" ),
309 _g( "Overview over this suite" ),
313 _g( "All packages in this section" ),
314 "/$suite/$subsection/",
318 my $title .= sprintf( _g( "Source Package: %s (%s)" ),
320 $title .= " ".marker( $archive ) if $archive ne 'us';
321 $title .= " ".marker( $subsection ) if $subsection eq 'non-US'
322 and $archive ne 'non-US'; # non-US/security
323 $title .= " ".marker( $section ) if $section ne 'main';
324 $package_page .= title( $title );
326 if ($suite eq "experimental") {
327 note( _g( "Experimental package"),
328 _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 if ($subsection eq "debian-installer") {
332 note( _g( "debian-installer udeb package"),
333 _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.' )
337 my $binaries = find_binaries( $pkg, $archive, $suite, \%src2bin );
338 if ($binaries && @$binaries) {
339 $package_page .= '<div class="pdesc">';
340 $package_page .= _g( "The following binary packages are built from this source package:" );
341 $package_page .= pkg_list( \%packages, $opts, $binaries, 'en' );
342 $package_page .= '</div> <!-- end pdesc -->';
346 # display dependencies
349 $dep_list = print_deps( \%packages, $opts, $pkg,
350 $page->get_dep_field('build-depends'),
352 $dep_list .= print_deps( \%packages, $opts, $pkg,
353 $page->get_dep_field('build-depends-indep'),
354 'build-depends-indep' );
357 $package_page .= "<div id=\"pdeps\">\n";
358 $package_page .= sprintf( "<h2>"._g( "Other Packages Related to %s" )."</h2>\n", $pkg );
359 if ($suite eq "experimental") {
360 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/" ) );
364 $package_page .= pdeplegend( [ 'adep', _g( 'build-depends' ) ],
365 [ 'idep', _g( 'build-depends-indep' ) ],
368 $package_page .= $dep_list;
369 $package_page .= "</div> <!-- end pdeps -->\n";
373 # Source package download
375 $package_page .= "<div id=\"pdownload\">\n";
376 $package_page .= sprintf( "<h2>"._g( "Download %s" )."</h2>\n",
379 my $source_files = $page->get_src( 'files' );
380 my $source_dir = $page->get_src( 'directory' );
382 $package_page .= sprintf( '<table summary="'._g('Download information for the files of this source package' ).'">'.
383 "<tr><th>%s</th><th>%s</th><th>%s</th>",
387 foreach( @$source_files ) {
388 my ($src_file_md5, $src_file_size, $src_file_name)
393 $src_url = $FTP_SITES{security}; last };
395 $src_url = $FTP_SITES{volatile}; last };
398 $src_url = $FTP_SITES{backports}; last };
400 $src_url = $FTP_SITES{'non-US'}; last };
401 $src_url = $FTP_SITES{us};
403 $src_url .= "/$source_dir/$src_file_name";
405 $package_page .= "<tr><td><a href=\"$src_url\">$src_file_name</a></td>\n"
406 ."<td>".sprintf("%.1f", (floor(($src_file_size/102.4)+0.5)/10))."</td>\n"
407 ."<td class=\"md5sum\">$src_file_md5</td></tr>";
409 $package_page .= "</table>\n";
410 $package_page .= "</div> <!-- end pdownload -->\n";
415 $package_page .= pmoreinfo( name => $pkg, data => $page,
419 changesandcopy => 1, maintainers => 1,
420 search => 1, is_source => 1 );
422 } # else (unless $opts->{source})
423 } # else (unless @results)
424 } # else (unless (@results || @non_results ))
428 # debug( "Final page object:\n".Dumper($page), 3 ) if DEBUG;
430 my $title = $opts->{source} ?
431 _g( "Details of source package <em>%s</em> in %s" ) :
432 _g( "Details of package <em>%s</em> in %s" ) ;
433 my $title_tag = $opts->{source} ?
434 _g( "Details of source package %s in %s" ) :
435 _g( "Details of package %s in %s" ) ;
436 %$html_header = ( title => sprintf( $title, $pkg, $suite ) ,
437 lang => $opts->{lang},
439 keywords => "$suite, $archive, $section, $subsection, $version",
440 title_tag => sprintf( $title_tag, $pkg, $suite ),
441 print_search_field => 'packages',
442 search_field_values => {
444 searchon => $opts->{source} ? 'sourcenames' : 'names',
449 debug => $opts->{debug},
453 $$page_content = $package_page;