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>' ), "$SEARCH_URL/$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=>$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 my $source = $page->get_src('package');
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 );
189 # display dependencies
192 $dep_list = print_deps( \%packages, $opts, $pkg,
193 $page->get_dep_field('depends'),
195 $dep_list .= print_deps( \%packages, $opts, $pkg,
196 $page->get_dep_field('recommends'),
198 $dep_list .= print_deps( \%packages, $opts, $pkg,
199 $page->get_dep_field('suggests'),
203 $package_page .= "<div id=\"pdeps\">\n";
204 $package_page .= sprintf( "<h2>"._g( "Other Packages Related to %s" )."</h2>\n", $pkg );
206 $package_page .= pdeplegend( [ 'dep', _g( 'depends' ) ],
207 [ 'rec', _g( 'recommends' ) ],
208 [ 'sug', _g( 'suggests' ) ], );
210 $package_page .= $dep_list;
211 $package_page .= "</div> <!-- end pdeps -->\n";
217 my $encodedpack = uri_escape( $pkg );
218 $package_page .= "<div id=\"pdownload\">";
219 $package_page .= sprintf( "<h2>"._g( "Download %s\n" )."</h2>",
221 $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";
222 $package_page .= "<caption class=\"hidecss\">"._g("Download for all available architectures")."</caption>\n";
223 $package_page .= "<tr>\n";
224 $package_page .= "<th>"._g("Architecture")."</th>";
225 $package_page .= "<th>"._g("Version")."</th>"
226 if $multiple_versions;
227 $package_page .= "<th>"._g( "Package Size")."</th><th>"._g("Installed Size")."</th><th>"._g("Files")."</th></tr>\n";
228 foreach my $a ( @archs ) {
229 $package_page .= "<tr>\n";
230 $package_page .= "<th><a href=\"".make_url("$encodedpkg/$a/download",'');
231 $package_page .= "\">$a</a></th>\n";
232 $package_page .= "<td>".$versions->{$a}."</td>"
233 if $multiple_versions;
234 $package_page .= '<td class="size">';
236 $package_page .= sprintf(_g('%.1f kB'),
237 floor(($sizes_deb->{$a}/102.4)+0.5)/10);
238 $package_page .= '</td><td class="size">';
240 $package_page .= sprintf(_g('%d 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 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)
387 for ("$suite/$archive") {
389 $src_url = $FTP_SITES{security}; last };
391 $src_url = $FTP_SITES{volatile}; last };
394 $src_url = $FTP_SITES{backports}; last };
396 $src_url = $FTP_SITES{'non-US'}; last };
397 $src_url = $FTP_SITES{us};
399 $src_url .= "/$source_dir/$src_file_name";
401 $package_page .= "<tr><td><a href=\"$src_url\">$src_file_name</a></td>\n"
402 ."<td>".sprintf("%.1f", (floor(($src_file_size/102.4)+0.5)/10))."</td>\n"
403 ."<td class=\"md5sum\">$src_file_md5</td></tr>";
405 $package_page .= "</table>\n";
406 $package_page .= "</div> <!-- end pdownload -->\n";
411 $package_page .= pmoreinfo( name => $pkg, data => $page,
415 changesandcopy => 1, maintainers => 1,
416 search => 1, is_source => 1 );
418 } # else (unless $opts->{source})
419 } # else (unless @results)
420 } # else (unless (@results || @non_results ))
424 # debug( "Final page object:\n".Dumper($page), 3 ) if DEBUG;
426 my $title = $opts->{source} ?
427 _g( "Details of source package <em>%s</em> in %s" ) :
428 _g( "Details of package <em>%s</em> in %s" ) ;
429 my $title_tag = $opts->{source} ?
430 _g( "Details of source package %s in %s" ) :
431 _g( "Details of package %s in %s" ) ;
432 %$html_header = ( title => sprintf( $title, $pkg, $suite ) ,
433 lang => $opts->{lang},
435 keywords => "$suite, $archive, $section, $subsection, $version",
436 title_tag => sprintf( $title_tag, $pkg, $suite ),
437 print_search_field => 'packages',
438 search_field_values => {
440 searchon => $opts->{source} ? 'sourcenames' : 'names',
445 debug => $opts->{debug},
449 $$page_content = $package_page;