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 );
148 my @menu = ( [ _g( "Distribution:" ),
149 _g( "Overview over this suite" ),
153 _g( "All packages in this section" ),
154 "$ROOT/$suite/$subsection/",
156 my $source = $page->get_src('package');
157 push @menu, [ _g( "Source:" ),
158 _g( "Source package building this package" ),
159 "$ROOT/$suite/source/$source",
160 $source ] if $source;
161 $$menu .= simple_menu( @menu );
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 );
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=\"$ROOT/$suite/$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">';
236 $package_page .= floor(($sizes_deb->{$a}/102.4)+0.5)/10 . " kB";
237 $package_page .= '</td><td class="size">';
238 $package_page .= $sizes_inst->{$a} . " kB";
239 $package_page .= "</td>\n<td>";
240 if ( $suite ne "experimental" ) {
241 $package_page .= sprintf( "[<a href=\"%s\">"._g( "list of files" )."</a>]\n",
242 "$ROOT/$suite/$encodedpkg/$a/filelist", $pkg );
244 $package_page .= _g( "no current information" );
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 = _g( "virtual package" );
263 $$menu .= simple_menu( [ _g( "Distribution:" ),
264 _g( "Overview over this distribution" ),
268 _g( "All packages in this section" ),
269 "$ROOT/$suite/virtual/",
273 $package_page .= title( sprintf( _g( "Virtual Package: %s" ),
276 my $policy_url = 'http://www.debian.org/doc/debian-policy/';
277 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>.' ),
278 $policy_url, $policy_url ));
280 $package_page .= sprintf( "<h2>"._g( "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 ) if DEBUG;
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 ) if DEBUG;
295 $version = $page->{version};
297 my $st1 = new Benchmark;
298 my $std = timediff($st1, $st0);
299 debug( "Data search and merging took ".timestr($std) ) if DEBUG;
301 $archive = $page->get_newest( 'archive' );
302 $section = $page->get_newest( 'section' );
303 $subsection = $page->get_newest( 'subsection' );
305 $$menu .= simple_menu( [ _g( "Distribution:" ),
306 _g( "Overview over this suite" ),
310 _g( "All packages in this section" ),
311 "$ROOT/$suite/$subsection/",
315 my $title .= sprintf( _g( "Source Package: %s (%s)" ),
317 $title .= " ".marker( $archive ) if $archive ne 'us';
318 $title .= " ".marker( $subsection ) if $subsection eq 'non-US'
319 and $archive ne 'non-US'; # non-US/security
320 $title .= " ".marker( $section ) if $section ne 'main';
321 $package_page .= title( $title );
323 if ($suite eq "experimental") {
324 note( _g( "Experimental package"),
325 _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>"
328 if ($subsection eq "debian-installer") {
329 note( _g( "debian-installer udeb package"),
330 _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.' )
334 my $binaries = find_binaries( $pkg, $archive, $suite, \%src2bin );
335 if ($binaries && @$binaries) {
336 $package_page .= '<div class="pdesc">';
337 $package_page .= _g( "The following binary packages are built from this source package:" );
338 $package_page .= pkg_list( \%packages, $opts, $binaries, 'en' );
339 $package_page .= '</div> <!-- end pdesc -->';
343 # display dependencies
346 $dep_list = print_deps( \%packages, $opts, $pkg,
347 $page->get_dep_field('build-depends'),
349 $dep_list .= print_deps( \%packages, $opts, $pkg,
350 $page->get_dep_field('build-depends-indep'),
351 'build-depends-indep' );
354 $package_page .= "<div id=\"pdeps\">\n";
355 $package_page .= sprintf( "<h2>"._g( "Other Packages Related to %s" )."</h2>\n", $pkg );
357 $package_page .= pdeplegend( [ 'adep', _g( 'build-depends' ) ],
358 [ 'idep', _g( 'build-depends-indep' ) ],
361 $package_page .= $dep_list;
362 $package_page .= "</div> <!-- end pdeps -->\n";
366 # Source package download
368 $package_page .= "<div id=\"pdownload\">\n";
369 $package_page .= sprintf( "<h2>"._g( "Download %s" )."</h2>\n",
372 my $source_files = $page->get_src( 'files' );
373 my $source_dir = $page->get_src( 'directory' );
375 $package_page .= sprintf( '<table summary="'._g('Download information for the files of this source package' ).'">'.
376 "<tr><th>%s</th><th>%s</th><th>%s</th>",
380 foreach( @$source_files ) {
381 my ($src_file_md5, $src_file_size, $src_file_name)
384 for ("$suite/$archive") {
386 $src_url = $FTP_SITES{security}; last };
388 $src_url = $FTP_SITES{volatile}; last };
391 $src_url = $FTP_SITES{backports}; last };
393 $src_url = $FTP_SITES{'non-US'}; last };
394 $src_url = $FTP_SITES{us};
396 $src_url .= "/$source_dir/$src_file_name";
398 $package_page .= "<tr><td><a href=\"$src_url\">$src_file_name</a></td>\n"
399 ."<td>".sprintf("%.1f", (floor(($src_file_size/102.4)+0.5)/10))."</td>\n"
400 ."<td class=\"md5sum\">$src_file_md5</td></tr>";
402 $package_page .= "</table>\n";
403 $package_page .= "</div> <!-- end pdownload -->\n";
408 $package_page .= pmoreinfo( name => $pkg, data => $page,
412 changesandcopy => 1, maintainers => 1,
413 search => 1, is_source => 1 );
415 } # else (unless $opts->{source})
416 } # else (unless @results)
417 } # else (unless (@results || @non_results ))
421 # debug( "Final page object:\n".Dumper($page), 3 ) if DEBUG;
423 my $title = $opts->{source} ?
424 _g( "Details of source package <em>%s</em> in %s" ) :
425 _g( "Details of package <em>%s</em> in %s" ) ;
426 my $title_tag = $opts->{source} ?
427 _g( "Details of source package %s in %s" ) :
428 _g( "Details of package %s in %s" ) ;
429 %$html_header = ( title => sprintf( $title, $pkg, $suite ) ,
430 lang => $opts->{lang},
432 keywords => "$suite, $archive, $section, $subsection, $version",
433 title_tag => sprintf( $title_tag, $pkg, $suite ),
434 print_search_field => 'packages',
435 search_field_values => {
437 searchon => $opts->{source} ? 'sourcenames' : 'names',
442 debug => $opts->{debug},
446 $$page_content = $package_page;