1 package Packages::DoShow;
10 use Benchmark ':hireswallclock';
14 use Packages::Config qw( $DBDIR $ROOT @SUITES @ARCHIVES @SECTIONS
15 @ARCHITECTURES %FTP_SITES $SEARCH_URL );
16 use Packages::I18N::Locale;
19 use Packages::Search qw( :all );
21 use Packages::Page ();
22 use Packages::SrcPage ();
24 our @ISA = qw( Exporter );
25 our @EXPORT = qw( do_show );
28 my ($params, $opts, $html_header, $menu, $page_content) = @_;
30 if ($params->{errors}{package}) {
31 fatal_error( _g( "package not valid or not specified" ) );
33 if ($params->{errors}{suite}) {
34 fatal_error( _g( "suite not valid or not specified" ) );
36 if (@{$opts->{suite}} > 1) {
37 fatal_error( sprintf( _g( "more than one suite specified for show (%s)" ), "@{$opts->{suite}}" ) );
40 my $pkg = $opts->{package};
41 my $encodedpkg = uri_escape( $pkg );
42 my $suite = $opts->{suite}[0];
43 my $archive = $opts->{archive}[0] ||'';
45 my $DL_URL = "$pkg/download";
46 my $FILELIST_URL = "$pkg/files";
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;
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( _g( "No such package." )."<br>".
73 sprintf( _g( '<a href="%s">Search for the package</a>' ), make_search_url('','keywords='.uri_escape($pkg)) ) );
76 foreach (@results, @non_results) {
81 foreach (suites_sort(keys %all_suites)) {
83 $$menu .= "[ <strong>$_</strong> ] ";
85 $$menu .= "[ <a href=\"".make_url($encodedpkg,'',{suite=>$_})."\">$_</a> ] ";
91 fatal_error( _g( "Package not available in this suite." ) );
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;
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;
107 $page->add_provided_by([split /\s+/, $provided_by]);
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 )
120 my $st1 = new Benchmark;
121 my $std = timediff($st1, $st0);
122 debug( "Data search and merging took ".timestr($std) ) if DEBUG;
124 my $did = $page->get_newest( 'description' );
125 $section = $page->get_newest( 'section' );
126 $subsection = $page->get_newest( 'subsection' );
127 my $filenames = $page->get_arch_field( 'filename' );
128 my $file_md5sums = $page->get_arch_field( 'md5sum' );
129 my $archives = $page->get_arch_field( 'archive' );
130 my $versions = $page->get_arch_field( 'version' );
131 my $sizes_inst = $page->get_arch_field( 'installed-size' );
132 my $sizes_deb = $page->get_arch_field( 'size' );
133 my @archs = sort $page->get_architectures;
135 # process description
137 my $desc = $descriptions{$did};
138 $short_desc = encode_entities( $1, "<>&\"" )
139 if $desc =~ s/^(.*)$//m;
140 my $long_desc = encode_entities( $desc, "<>&\"" );
142 $long_desc =~ s,((ftp|http|https)://[\S~-]+?/?)((\>\;)?[)]?[']?[:.\,]?(\s|$)),<a href=\"$1\">$1</a>$3,go; # syntax highlighting -> '];
143 $long_desc =~ s/\A //o;
144 $long_desc =~ s/\n /\n/sgo;
145 $long_desc =~ s/\n.\n/\n<p>\n/go;
146 $long_desc =~ s/(((\n|\A) [^\n]*)+)/\n<pre>$1\n<\/pre>/sgo;
147 my @menu = ( [ _g( "Distribution:" ),
148 _g( "Overview over this suite" ),
152 _g( "All packages in this section" ),
153 make_url("$subsection/",''),
155 push @menu, [ _g( "Source:" ),
156 _g( "Source package building this package" ),
157 make_url($source,'',{source=>'source'}),
158 $source ] if $source;
159 $$menu .= simple_menu( @menu );
161 my $v_str = $version;
162 my $multiple_versions = grep { $_ ne $version } values %$versions;
163 $v_str .= _g(" and others") if $multiple_versions;
164 my $title .= sprintf( _g( "Package: %s (%s)" ), $pkg, $v_str );
165 $title .= " ".marker( $archive ) if $archive ne 'us';
166 $title .= " ".marker( $subsection ) if $subsection eq 'non-US'
167 and $archive ne 'non-US'; # non-US/security
168 $title .= " ".marker( $section ) if $section ne 'main';
169 $package_page .= title( $title );
171 if (my $provided_by = $page->{provided_by}) {
172 note( _g( "This is also a virtual package provided by ").join( ', ', map { "<a href=\"".make_url($_,'')."\">$_</a>" } @$provided_by) );
175 if ($suite eq "experimental") {
176 note( _g( "Experimental package"),
177 _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>"
180 if ($subsection eq "debian-installer") {
181 note( _g( "debian-installer udeb package"),
182 _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.' )
185 $package_page .= pdesc( $short_desc, $long_desc );
188 # display dependencies
191 $dep_list = print_deps( \%packages, $opts, $pkg,
192 $page->get_dep_field('depends'),
194 $dep_list .= print_deps( \%packages, $opts, $pkg,
195 $page->get_dep_field('recommends'),
197 $dep_list .= print_deps( \%packages, $opts, $pkg,
198 $page->get_dep_field('suggests'),
202 $package_page .= "<div id=\"pdeps\">\n";
203 $package_page .= sprintf( "<h2>"._g( "Other Packages Related to %s" )."</h2>\n", $pkg );
205 $package_page .= pdeplegend( [ 'dep', _g( 'depends' ) ],
206 [ 'rec', _g( 'recommends' ) ],
207 [ 'sug', _g( 'suggests' ) ], );
209 $package_page .= $dep_list;
210 $package_page .= "</div> <!-- end pdeps -->\n";
216 my $encodedpack = uri_escape( $pkg );
217 $package_page .= "<div id=\"pdownload\">";
218 $package_page .= sprintf( "<h2>"._g( "Download %s\n" )."</h2>",
220 $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";
221 $package_page .= "<caption class=\"hidecss\">"._g("Download for all available architectures")."</caption>\n";
222 $package_page .= "<tr>\n";
223 $package_page .= "<th>"._g("Architecture")."</th>";
224 $package_page .= "<th>"._g("Version")."</th>"
225 if $multiple_versions;
226 $package_page .= "<th>"._g( "Package Size")."</th><th>"._g("Installed Size")."</th><th>"._g("Files")."</th></tr>\n";
227 foreach my $a ( @archs ) {
228 $package_page .= "<tr>\n";
229 $package_page .= "<th><a href=\"".make_url("$encodedpkg/$a/download",'');
230 $package_page .= "\">$a</a></th>\n";
231 $package_page .= "<td>".$versions->{$a}."</td>"
232 if $multiple_versions;
233 $package_page .= '<td class="size">';
235 $package_page .= sprintf(_g('%.1f kB'),
236 floor(($sizes_deb->{$a}/102.4)+0.5)/10);
237 $package_page .= '</td><td class="size">';
239 $package_page .= sprintf(_g('%d kB'),
241 $package_page .= "</td>\n<td>";
242 if ( ($suite ne "experimental")
243 && ($subsection ne 'debian-installer')) {
244 $package_page .= sprintf( "[<a href=\"%s\">"._g( "list of files" )."</a>]\n",
245 make_url("$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 make_url("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 make_url("$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 );
360 $package_page .= pdeplegend( [ 'adep', _g( 'build-depends' ) ],
361 [ 'idep', _g( 'build-depends-indep' ) ],
364 $package_page .= $dep_list;
365 $package_page .= "</div> <!-- end pdeps -->\n";
369 # Source package download
371 $package_page .= "<div id=\"pdownload\">\n";
372 $package_page .= sprintf( "<h2>"._g( "Download %s" )."</h2>\n",
375 my $source_files = $page->get_src( 'files' );
376 my $source_dir = $page->get_src( 'directory' );
378 $package_page .= sprintf( '<table summary="'._g('Download information for the files of this source package' ).'">'.
379 "<tr><th>%s</th><th>%s</th><th>%s</th>",
383 foreach( @$source_files ) {
384 my ($src_file_md5, $src_file_size, $src_file_name)
386 (my $server = lc $archive) =~ s/-//go; # non-US hack
387 my $src_url = $FTP_SITES{$server}
389 $src_url .= "/$source_dir/$src_file_name";
391 $package_page .= "<tr><td><a href=\"$src_url\">$src_file_name</a></td>\n"
392 ."<td>".sprintf("%.1f", (floor(($src_file_size/102.4)+0.5)/10))."</td>\n"
393 ."<td class=\"md5sum\">$src_file_md5</td></tr>";
395 $package_page .= "</table>\n";
396 $package_page .= "</div> <!-- end pdownload -->\n";
401 $package_page .= pmoreinfo( name => $pkg, data => $page,
405 changesandcopy => 1, maintainers => 1,
406 search => 1, is_source => 1 );
408 } # else (unless $opts->{source})
409 } # else (unless @results)
410 } # else (unless (@results || @non_results ))
414 # debug( "Final page object:\n".Dumper($page), 3 ) if DEBUG;
416 my $title = $opts->{source} ?
417 _g( "Details of source package <em>%s</em> in %s" ) :
418 _g( "Details of package <em>%s</em> in %s" ) ;
419 my $title_tag = $opts->{source} ?
420 _g( "Details of source package %s in %s" ) :
421 _g( "Details of package %s in %s" ) ;
422 %$html_header = ( title => sprintf( $title, $pkg, $suite ) ,
423 lang => $opts->{lang},
425 keywords => "$suite, $archive, $section, $subsection, $version",
426 title_tag => sprintf( $title_tag, $pkg, $suite ),
427 print_search_field => 'packages',
428 search_field_values => {
430 searchon => $opts->{source} ? 'sourcenames' : 'names',
435 debug => $opts->{debug},
439 $$page_content = $package_page;