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 my @tags = split(/, /, $page->get_newest( 'tag' ));
126 $section = $page->get_newest( 'section' );
127 $subsection = $page->get_newest( 'subsection' );
128 my $filenames = $page->get_arch_field( 'filename' );
129 my $file_md5sums = $page->get_arch_field( 'md5sum' );
130 my $archives = $page->get_arch_field( 'archive' );
131 my $versions = $page->get_arch_field( 'version' );
132 my $sizes_inst = $page->get_arch_field( 'installed-size' );
133 my $sizes_deb = $page->get_arch_field( 'size' );
134 my @archs = sort $page->get_architectures;
136 # process description
138 my $desc = $descriptions{$did};
139 $short_desc = encode_entities( $1, "<>&\"" )
140 if $desc =~ s/^(.*)$//m;
141 my $long_desc = encode_entities( $desc, "<>&\"" );
143 $long_desc =~ s,((ftp|http|https)://[\S~-]+?/?)((\>\;)?[)]?[']?[:.\,]?(\s|$)),<a href=\"$1\">$1</a>$3,go; # syntax highlighting -> '];
144 $long_desc =~ s/\A //o;
145 $long_desc =~ s/\n /\n/sgo;
146 $long_desc =~ s/\n.\n/\n<p>\n/go;
147 $long_desc =~ s/(((\n|\A) [^\n]*)+)/\n<pre>$1\n<\/pre>/sgo;
148 my @menu = ( [ _g( "Distribution:" ),
149 _g( "Overview over this suite" ),
153 _g( "All packages in this section" ),
154 make_url("$subsection/",''),
156 push @menu, [ _g( "Source:" ),
157 _g( "Source package building this package" ),
158 make_url($source,'',{source=>'source'}),
159 $source ] if $source;
160 $$menu .= simple_menu( @menu );
162 my $v_str = $version;
163 my $multiple_versions = grep { $_ ne $version } values %$versions;
164 $v_str .= _g(" and others") if $multiple_versions;
165 my $title .= sprintf( _g( "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 if (my $provided_by = $page->{provided_by}) {
173 note( _g( "This is also a virtual package provided by ").join( ', ', map { "<a href=\"".make_url($_,'')."\">$_</a>" } @$provided_by) );
176 if ($suite eq "experimental") {
177 note( _g( "Experimental package"),
178 _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>"
181 if ($subsection eq "debian-installer") {
182 note( _g( "debian-installer udeb package"),
183 _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.' )
186 $package_page .= pdesc( $short_desc, $long_desc );
187 $package_page .= ptags( $pkg, @tags ) if @tags;
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 );
207 $package_page .= pdeplegend( [ 'dep', _g( 'depends' ) ],
208 [ 'rec', _g( 'recommends' ) ],
209 [ 'sug', _g( 'suggests' ) ], );
211 $package_page .= $dep_list;
212 $package_page .= "</div> <!-- end pdeps -->\n";
218 my $encodedpack = uri_escape( $pkg );
219 $package_page .= "<div id=\"pdownload\">";
220 $package_page .= sprintf( "<h2>"._g( "Download %s\n" )."</h2>",
222 $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";
223 $package_page .= "<caption class=\"hidecss\">"._g("Download for all available architectures")."</caption>\n";
224 $package_page .= "<tr>\n";
225 $package_page .= "<th>"._g("Architecture")."</th>";
226 $package_page .= "<th>"._g("Version")."</th>"
227 if $multiple_versions;
228 $package_page .= "<th>"._g( "Package Size")."</th><th>"._g("Installed Size")."</th><th>"._g("Files")."</th></tr>\n";
229 foreach my $a ( @archs ) {
230 $package_page .= "<tr>\n";
231 $package_page .= "<th><a href=\"".make_url("$encodedpkg/$a/download",'');
232 $package_page .= "\">$a</a></th>\n";
233 $package_page .= "<td>".$versions->{$a}."</td>"
234 if $multiple_versions;
235 $package_page .= '<td class="size">';
237 $package_page .= sprintf(_g('%.1f kB'),
238 floor(($sizes_deb->{$a}/102.4)+0.5)/10);
239 $package_page .= '</td><td class="size">';
241 $package_page .= sprintf(_g('%d kB'),
243 $package_page .= "</td>\n<td>";
244 if ( ($suite ne "experimental")
245 && ($subsection ne 'debian-installer')) {
246 $package_page .= sprintf( "[<a href=\"%s\">"._g( "list of files" )."</a>]\n",
247 make_url("$encodedpkg/$a/filelist",''), $pkg );
249 $package_page .= _g( "no current information" );
251 $package_page .= "</td>\n</tr>";
253 $package_page .= "</table>\n";
254 $package_page .= "</div> <!-- end pdownload -->\n";
259 $package_page .= pmoreinfo( name => $pkg, data => $page,
262 bugreports => 1, sourcedownload => 1,
263 changesandcopy => 1, maintainers => 1,
265 } else { # unless $page->is_virtual
266 $short_desc = _g( "virtual package" );
268 $$menu .= simple_menu( [ _g( "Distribution:" ),
269 _g( "Overview over this distribution" ),
273 _g( "All packages in this section" ),
274 make_url("virtual/",''),
278 $package_page .= title( sprintf( _g( "Virtual Package: %s" ),
281 my $policy_url = 'http://www.debian.org/doc/debian-policy/';
282 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>.' ),
283 $policy_url, $policy_url ));
285 $package_page .= sprintf( "<h2>"._g( "Packages providing %s" )."</h2>", $pkg );
286 my $provided_by = $page->{provided_by};
287 $package_page .= pkg_list( \%packages, $opts, $provided_by, 'en');
289 } # else (unless $page->is_virtual)
290 } else { # unless $opts->{source}
291 for my $entry (@results) {
292 debug( join(":", @$entry), 1 ) if DEBUG;
293 my (undef, $archive, undef, $section, $subsection,
294 $priority, $version) = @$entry;
296 my $data = $sources_all{"$archive $suite $pkg"};
297 $page->merge_data($pkg, $suite, $archive, $data)
298 or debug( "Merging $pkg $version FAILED", 2 ) if DEBUG;
300 $version = $page->{version};
302 my $st1 = new Benchmark;
303 my $std = timediff($st1, $st0);
304 debug( "Data search and merging took ".timestr($std) ) if DEBUG;
306 $archive = $page->get_newest( 'archive' );
307 $section = $page->get_newest( 'section' );
308 $subsection = $page->get_newest( 'subsection' );
310 $$menu .= simple_menu( [ _g( "Distribution:" ),
311 _g( "Overview over this suite" ),
315 _g( "All packages in this section" ),
316 make_url("$subsection/",''),
320 my $title .= sprintf( _g( "Source Package: %s (%s)" ),
322 $title .= " ".marker( $archive ) if $archive ne 'us';
323 $title .= " ".marker( $subsection ) if $subsection eq 'non-US'
324 and $archive ne 'non-US'; # non-US/security
325 $title .= " ".marker( $section ) if $section ne 'main';
326 $package_page .= title( $title );
328 if ($suite eq "experimental") {
329 note( _g( "Experimental package"),
330 _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>"
333 if ($subsection eq "debian-installer") {
334 note( _g( "debian-installer udeb package"),
335 _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.' )
339 my $binaries = find_binaries( $pkg, $archive, $suite, \%src2bin );
340 if ($binaries && @$binaries) {
341 $package_page .= '<div class="pdesc">';
342 $package_page .= _g( "The following binary packages are built from this source package:" );
343 $package_page .= pkg_list( \%packages, $opts, $binaries, 'en' );
344 $package_page .= '</div> <!-- end pdesc -->';
348 # display dependencies
351 $dep_list = print_deps( \%packages, $opts, $pkg,
352 $page->get_dep_field('build-depends'),
354 $dep_list .= print_deps( \%packages, $opts, $pkg,
355 $page->get_dep_field('build-depends-indep'),
356 'build-depends-indep' );
359 $package_page .= "<div id=\"pdeps\">\n";
360 $package_page .= sprintf( "<h2>"._g( "Other Packages Related to %s" )."</h2>\n", $pkg );
362 $package_page .= pdeplegend( [ 'adep', _g( 'build-depends' ) ],
363 [ 'idep', _g( '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>"._g( "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 summary="'._g('Download information for the files of this source package' ).'">'.
381 "<tr><th>%s</th><th>%s</th><th>%s</th>",
385 foreach( @$source_files ) {
386 my ($src_file_md5, $src_file_size, $src_file_name)
388 (my $server = lc $archive) =~ s/-//go; # non-US hack
389 my $src_url = $FTP_SITES{$server}
391 $src_url .= "/$source_dir/$src_file_name";
393 $package_page .= "<tr><td><a href=\"$src_url\">$src_file_name</a></td>\n"
394 ."<td>".sprintf("%.1f", (floor(($src_file_size/102.4)+0.5)/10))."</td>\n"
395 ."<td class=\"md5sum\">$src_file_md5</td></tr>";
397 $package_page .= "</table>\n";
398 $package_page .= "</div> <!-- end pdownload -->\n";
403 $package_page .= pmoreinfo( name => $pkg, data => $page,
407 changesandcopy => 1, maintainers => 1,
408 search => 1, is_source => 1 );
410 } # else (unless $opts->{source})
411 } # else (unless @results)
412 } # else (unless (@results || @non_results ))
416 # debug( "Final page object:\n".Dumper($page), 3 ) if DEBUG;
418 my $title = $opts->{source} ?
419 _g( "Details of source package <em>%s</em> in %s" ) :
420 _g( "Details of package <em>%s</em> in %s" ) ;
421 my $title_tag = $opts->{source} ?
422 _g( "Details of source package %s in %s" ) :
423 _g( "Details of package %s in %s" ) ;
424 %$html_header = ( title => sprintf( $title, $pkg, $suite ) ,
425 lang => $opts->{lang},
427 keywords => "$suite, $archive, $section, $subsection, $version",
428 title_tag => sprintf( $title_tag, $pkg, $suite ),
429 print_search_field => 'packages',
430 search_field_values => {
432 searchon => $opts->{source} ? 'sourcenames' : 'names',
437 debug => $opts->{debug},
441 $$page_content = $package_page;