use Packages::Config qw( $TOPDIR $DBDIR @ARCHIVES @SUITES );
use Packages::HTML;
use Packages::Page;
+use Packages::Sections;
&Packages::Config::init( './' );
sub gettext { return $_[0]; }
sub dgettext { return $_[1]; }
#use Data::Dumper;
#print STDERR Dumper($sections, $subsections, $priorities);
-my %sections_descs = (
- 'admin' => [ "Administration Utilities",
- "Utilities to administer system resources, manage user accounts, etc." ],
- 'base' => [ "Base Utilities",
- "Basic needed utilities of every Debian system." ],
- 'comm' => [ "Communication Programs",
- "Software to use your modem in the old fashioned style." ],
- 'devel' => [ "Development",
- "Development utilities, compilers, development environments, libraries, etc." ],
- 'doc' => [ "Documentation",
- "FAQs, HOWTOs and other documents trying to explain everything related to Debian, and software needed to browse documentation (man, info, etc)." ],
- 'editors' => [ "Editors",
- "Software to edit files. Programming environments." ],
- 'electronics' => [ "Electronics",
- "Electronics utilities." ],
- 'embedded' => [ "Embedded software",
- "Software suitable for use in embedded applications." ],
- 'games' => [ "Games",
- "Programs to spend a nice time with after all this setting up." ],
- 'gnome' => [ "GNOME",
- "The GNOME desktop environment, a powerful, easy to use set of integrated applications." ],
- 'graphics' => [ "Graphics",
- "Editors, viewers, converters... Everything to become an artist." ],
- 'hamradio' => [ "Ham Radio",
- "Software for ham radio." ],
- 'interpreters' => [ "Interpreters",
- "All kind of interpreters for interpreted languages. Macro processors." ],
- 'kde' => [ "KDE",
- "The K Desktop Environment, a powerful, easy to use set of integrated applications." ],
- 'libs' => [ "Libraries",
- "Libraries to make other programs work. They provide special features to developers." ],
- 'libdevel' => [ "Library development",
- "Libraries necessary for developers to write programs that use them." ],
- 'mail' => [ "Mail",
- "Programs to route, read, and compose E-mail messages." ],
- 'math' => [ "Mathematics",
- "Math software." ],
- 'misc' => [ "Miscellaneous",
- "Miscellaneous utilities that didn\'t fit well anywhere else." ],
- 'net' => [ "Network",
- "Daemons and clients to connect your Debian GNU/Linux system to the world." ],
- 'news' => [ "Newsgroups",
- "Software to access Usenet, to set up news servers, etc." ],
- 'non-US' => [ "Software restricted in the U.S.",
- "These packages probably may not be used in or distributed from the U.S. due to software patents. You should check the regulations in your country before using this software." ],
- 'oldlibs' => [ "Old Libraries",
- "Old versions of libraries, kept for backward compatibility with old applications." ],
- 'otherosfs' => [ "Other OS\'s and file systems",
- "Software to run programs compiled for other operating system, and to use their filesystems." ],
- 'perl' => [ "Perl",
- "Everything about Perl, an interpreted scripting language." ],
- 'python' => [ "Python",
- "Everything about Python, an interpreted, interactive object oriented language." ],
- 'science' => [ "Science",
- "Basic tools for scientific work" ],
- 'shells' => [ "Shells",
- "Command shells. Friendly user interfaces for beginners." ],
- 'sound' => [ "Sound",
- "Utilities to deal with sound: mixers, players, recorders, CD players, etc." ],
- 'tex' => [ "TeX",
- "The famous typesetting software and related programs." ],
- 'text' => [ "Text Processing",
- "Utilities to format and print text documents." ],
- 'utils' => [ "Utilities",
- "Utilities for file/disk manipulation, backup and archive tools, system monitoring, input systems, etc." ],
- 'virtual' => [ "Virtual packages",
- "Virtual packages." ],
- 'web' => [ "Web Software",
- "Web servers, browsers, proxies, download tools etc." ],
- 'x11' => [ "X Window System software",
- "X servers, libraries, fonts, window managers, terminal emulators and many related applications." ],
- 'debian-installer' => [ "debian-installer udeb packages",
- "Special packages for building customized debian-installer variants. Do not install them on a normal system!" ],
- );
-
my (%pages);
--- /dev/null
+#!/usr/bin/perl -T
+# $Id: search_packages.pl 91 2006-02-10 22:18:31Z jeroen $
+# dispatcher.pl -- CGI interface for packages.debian.org
+#
+# Copyright (C) 2004-2006 Frank Lichtenheld
+#
+# use is allowed under the terms of the GNU Public License (GPL)
+# see http://www.fsf.org/copyleft/gpl.html for a copy of the license
+
+use strict;
+use warnings;
+
+use lib '../lib';
+use CGI;
+use POSIX;
+use URI::Escape;
+use HTML::Entities;
+use DB_File;
+use Benchmark;
+
+use Deb::Versions;
+use Packages::Config qw( $DBDIR $ROOT $SEARCH_CGI $SEARCH_PAGE
+ @SUITES @SECTIONS @ARCHIVES @ARCHITECTURES );
+use Packages::CGI;
+use Packages::DB;
+use Packages::Search qw( :all );
+use Packages::HTML ();
+use Packages::Sections;
+
+use Packages::DoSearch;
+use Packages::DoShow;
+use Packages::DoDownload;
+use Packages::DoFilelist;
+
+&Packages::CGI::reset;
+
+$ENV{PATH} = "/bin:/usr/bin";
+
+# Read in all the variables set by the form
+my $input;
+if ($ARGV[0] && ($ARGV[0] eq 'php')) {
+ $input = new CGI(\*STDIN);
+} else {
+ $input = new CGI;
+}
+
+my $pet0 = new Benchmark;
+my $tet0 = new Benchmark;
+# use this to disable debugging in production mode completly
+my $debug_allowed = 1;
+my $debug = $debug_allowed && $input->param("debug");
+$debug = 0 if !defined($debug) || $debug !~ /^\d+$/o;
+$Packages::CGI::debug = $debug;
+
+&Packages::Config::init( '../' );
+&Packages::DB::init();
+
+my $what_to_do = 'show';
+my $source = 0;
+if (my $path = $input->path_info()) {
+ my @components = grep { $_ } map { lc $_ } split /\/+/, $path;
+
+ debug( "components[0]=$components[0]", 2 );
+ if ($components[0] eq 'search') {
+ shift @components;
+ $what_to_do = 'search';
+ }
+ if ($components[0] eq 'source') {
+ shift @components;
+ $input->param( 'source', 1 );
+ }
+ if (@components == 0) {
+ # we just hope we get the information through our parameters...
+ } elsif (@components == 1) {
+ $what_to_do = 'search';
+ } else {
+
+ for ($components[-1]) {
+ /^(changelog|copyright|download|filelist)$/ && do {
+ pop @components;
+ $what_to_do = $1;
+ last;
+ };
+ }
+
+ my %SUITES = map { $_ => 1 } @SUITES;
+ my %SUITES_ALIAS = ( woody => 'oldstable',
+ sarge => 'stable',
+ etch => 'testing',
+ sid => 'unstable', );
+ my %SECTIONS = map { $_ => 1 } @SECTIONS;
+ my %ARCHIVES = map { $_ => 1 } @ARCHIVES;
+ my %ARCHITECTURES = map { $_ => 1 } (@ARCHITECTURES, 'all');
+ my %params_set;
+ sub set_param_once {
+ my ($cgi, $params_set, $key, $val) = @_;
+ if ($params_set->{$key}++) {
+ fatal_error( "$key set more than once in path" );
+ } else {
+ $cgi->param( $key, $val );
+ }
+ }
+
+ my @tmp;
+ foreach (@components) {
+ if ($SUITES{$_}) {
+ set_param_once( $input, \%params_set, 'suite', $_);
+#possible conflicts with package names
+# } elsif (my $s = $SUITES_ALIAS{$_}) {
+# set_param_once( $input, \%params_set, 'suite', $s);
+ } elsif ($SECTIONS{$_}) {
+ set_param_once( $input, \%params_set, 'section', $_);
+ } elsif ($ARCHIVES{$_}) {
+ set_param_once( $input, \%params_set, 'archive', $_);
+ } elsif ($ARCHITECTURES{$_}) {
+ set_param_once( $input, \%params_set, 'arch', $_);
+ } elsif ($sections_descs{$_}) {
+ set_param_once( $input, \%params_set, 'subsection', $_);
+ } elsif ($_ eq 'source') {
+ set_param_once( $input, \%params_set, 'source', 1);
+ } else {
+ push @tmp, $_;
+ }
+ }
+ @components = @tmp;
+
+ if (@components > 1) {
+ fatal_error( "two or more packages specified (@components)" );
+ }
+ } # else if (@components == 1)
+
+ if (@components) {
+ $input->param( 'keywords', $components[0] );
+ $input->param( 'package', $components[0] );
+ }
+}
+
+my ( $pkg, @suites, @sections, @subsections, @archives, @archs );
+
+my %params_def = ( keywords => { default => undef,
+ match => '^\s*([-+\@\s\w\/.:]+)\s*$',
+ },
+ package => { default => undef,
+ match => '^([\w.+-]+)$',
+ var => \$pkg },
+ suite => { default => 'all', match => '^([\w-]+)$',
+ array => ',', var => \@suites,
+ replace => { all => \@SUITES } },
+ archive => { default => ($what_to_do eq 'search') ?
+ 'all' : 'default',
+ match => '^([\w-]+)$',
+ array => ',', var => \@archives,
+ replace => { all => \@ARCHIVES,
+ default => [qw(us security non-US)]} },
+ exact => { default => 0, match => '^(\w+)$', },
+ source => { default => 0, match => '^(\d+)$', },
+ searchon => { default => 'names', match => '^(\w+)$', },
+ section => { default => 'all', match => '^([\w-]+)$',
+ alias => 'release', array => ',',
+ var => \@sections,
+ replace => { all => \@SECTIONS } },
+ subsection => { default => 'default', match => '^([\w-]+)$',
+ array => ',', var => \@subsections,
+ replace => { default => [] } },
+ arch => { default => 'any', match => '^(\w+)$',
+ array => ',', var => \@archs, replace =>
+ { any => \@ARCHITECTURES } },
+ );
+my %opts;
+my %params = Packages::Search::parse_params( $input, \%params_def, \%opts );
+
+$opts{h_suites} = { map { $_ => 1 } @suites };
+$opts{h_sections} = { map { $_ => 1 } @sections };
+$opts{h_archives} = { map { $_ => 1 } @archives };
+$opts{h_archs} = { map { $_ => 1 } @archs };
+
+if ((($opts{searchon} eq 'names') && $opts{source}) ||
+ ($opts{searchon} eq 'sourcenames')) {
+ $opts{source} = 1;
+ $opts{searchon} = 'names',
+ $opts{searchon_form} = 'sourcenames';
+}
+
+my $pet1 = new Benchmark;
+my $petd = timediff($pet1, $pet0);
+debug( "Parameter evaluation took ".timestr($petd) );
+
+print $input->header( -charset => 'utf-8' );
+
+my (%html_header, $menu, $page_content);
+unless (@Packages::CGI::fatal_errors) {
+ no strict 'refs';
+ &{"do_$what_to_do"}( \%params, \%opts, \%html_header,
+ \$menu, \$page_content );
+} else {
+ %html_header = ( title => 'Error',
+ lang => 'en',
+ print_title => 1,
+ print_search_field => 'packages',
+ search_field_values => {
+ keywords => 'search for a package',
+ searchon => 'default',
+ arch => 'any',
+ suite => 'all',
+ section => 'all',
+ exact => 1,
+ debug => $debug,
+ },
+ );
+}
+
+print Packages::HTML::header( %html_header );
+
+print $menu||'';
+print_errors();
+print_hints();
+print_msgs();
+print_debug();
+print_notes();
+
+unless (@Packages::CGI::fatal_errors) {
+ print $page_content;
+}
+
+my $tet1 = new Benchmark;
+my $tetd = timediff($tet1, $tet0);
+print "Total page evaluation took ".timestr($tetd)."<br>"
+ if $debug_allowed;
+
+my $trailer = Packages::HTML::trailer( $ROOT );
+$trailer =~ s/LAST_MODIFIED_DATE/gmtime()/e; #FIXME
+print $trailer;
+
+# vim: ts=8 sw=4
+
# RewriteRule ^/$ http://www.debian.org/distrib/packages
RewriteRule ^/([^/+]*)([+])([^/]*)$ "/$1%%{%}2B$3" [N]
- RewriteRule ^/src:([^/]+)$ http://packages.debian.net/cgi-bin/search_packages.pl?searchon=sourcenames&version=all&exact=1&keywords=$1 [R,L,NE]
- RewriteRule ^/file:(.+)$ http://packages.debian.org/cgi-bin/search_contents.pl?word=$1&searchmode=searchfiles [R,L,NE]
- RewriteRule ^/dirs:(.+)$ http://packages.debian.org/cgi-bin/search_contents.pl?word=$1&searchmode=searchfilesanddirs [R,L,NE]
- RewriteRule ^/word:(.+)$ http://packages.debian.org/cgi-bin/search_contents.pl?word=$1&searchmode=searchword [R,L,NE]
- RewriteRule ^/list:([^/]+)$ http://packages.debian.org/cgi-bin/search_contents.pl?word=$1&searchmode=filelist [R,L,NE]
-
- RewriteRule ^/([^/]+)$ /cgi-bin/search_packages.pl?searchon=names&version=all&exact=1&keywords=$1 [PT]
- RewriteRule ^/search/([^/]+)$ /cgi-bin/search_packages.pl?searchon=names&version=all&exact=1&keywords=$1 [PT]
- RewriteRule ^/search/(.+)/([^/]+)$ /cgi-bin/search_packages.pl?searchon=names&version=all&exact=1&keywords=$2&path=$1 [PT]
- RewriteRule ^/(.+)/([^/]+)$ /cgi-bin/show_package.pl?searchon=names&version=all&exact=1&package=$2&path=$1 [PT]
+ RewriteRule ^/src:([^/]+)$ /search/source/$1 [R,L,NE]
+
+ RewriteRule ^/(.+)$ /cgi-bin/dispatcher.pl/$1 [PT]
# In case we need to disable the site again
#
}
sub print_errors {
return unless @fatal_errors || @errors;
- print '<div style="background-color:#F99;font-weight:bold;padding:0.5em;margin:0;">';
+ print '<div style="margin:.2em;background-color:#F99;font-weight:bold;padding:0.5em;margin:0;">';
foreach ((@fatal_errors, @errors)) {
print "<p>ERROR: $_</p>";
}
}
sub print_debug {
return unless $debug && @debug;
- print '<div style="font-size:80%;border:solid thin grey">';
+ print '<div style="margin:.2em;font-size:80%;border:solid thin grey">';
print '<h2>Debugging:</h2><pre>';
foreach (@debug) {
print "$_\n";
}
sub print_hints {
return unless @hints;
- print '<div>';
+ print '<div style="margin:.2em;">';
foreach (@hints) {
print "<p style=\"background-color:#FF9;padding:0.5em;margin:0\">$_</p>";
}
foreach (@notes) {
my ( $title, $note ) = @$_;
- print '<div style="border: solid thin black; background-color: #ccf">';
+ print '<div style="margin:.2em;border: solid thin black; background-color: #bdf">';
if ($note) {
print "<h2 class=\"pred\">$title</h2>";
} else {
--- /dev/null
+package Packages::DoDownload;
+
+use strict;
+use warnings;
+
+use CGI ();
+use DB_File;
+use Benchmark;
+use Exporter;
+
+use Deb::Versions;
+use Packages::HTML ();
+use Packages::Search qw( :all );
+use Packages::Config qw( $HOME $DBDIR @SUITES @ARCHIVES @SECTIONS @ARCHITECTURES );
+use Packages::CGI;
+use Packages::DB;
+
+our @ISA = qw( Exporter );
+our @EXPORT = qw( do_download );
+
+# TODO: find a way to get the U.S. mirror list from a more authoritive
+# location automatically. might not be overly smart to automatize it
+# completely, since I hand pick sites that are up-to-date, fast, and
+# have HTTP on a reasonably short URL
+# -- Joy
+
+# hint:
+# grep-dctrl -F Site,Alias -e '(udel|bigfoot|kernel|crosslink|internap|cerias|lcs.mit|progeny)' Mirrors.masterlist | timestamps/archive_mirror_check.py
+our @north_american_sites = (
+ "ftp.us.debian.org/debian",
+ "http.us.debian.org/debian",
+ "ftp.debian.org/debian",
+# "ftp.ca.debian.org/debian",
+ "ftp.egr.msu.edu/debian",
+ "mirrors.kernel.org/debian",
+ "archive.progeny.com/debian",
+ "debian.crosslink.net/debian",
+ "ftp-mirror.internap.com/pub/debian",
+ "ftp.cerias.purdue.edu/pub/os/debian",
+ "ftp.lug.udel.edu/debian",
+ "debian.lcs.mit.edu/debian",
+ "debian.teleglobe.net",
+ "debian.rutgers.edu",
+ "debian.oregonstate.edu/debian",
+ );
+our @european_sites = (
+ "ftp.de.debian.org/debian",
+ "ftp.at.debian.org/debian",
+ "ftp.bg.debian.org/debian",
+ "ftp.cz.debian.org/debian",
+ "ftp.dk.debian.org/debian",
+ "ftp.ee.debian.org/debian",
+ "ftp.fi.debian.org/debian",
+ "ftp.fr.debian.org/debian",
+ "ftp.hr.debian.org/debian",
+ "ftp.hu.debian.org/debian",
+ "ftp.ie.debian.org/debian",
+ "ftp.is.debian.org/debian",
+ "ftp.it.debian.org/debian",
+ "ftp.nl.debian.org/debian",
+ "ftp.no.debian.org/debian",
+ "ftp.pl.debian.org/debian",
+ "ftp.si.debian.org/debian",
+ "ftp.es.debian.org/debian",
+ "ftp.se.debian.org/debian",
+ "ftp.tr.debian.org/debian",
+ "ftp.uk.debian.org/debian",
+ );
+our @south_american_sites = (
+ "ftp.br.debian.org/debian",
+ "ftp.cl.debian.org/debian",
+ );
+our @australian_sites = (
+ "ftp.au.debian.org/debian",
+ "ftp.wa.au.debian.org/debian",
+ "ftp.nz.debian.org/debian",
+ );
+our @asian_sites = (
+ "ftp.jp.debian.org/debian",
+# "ftp.kr.debian.org/debian",
+ "linux.csie.nctu.edu.tw/debian",
+ "debian.linux.org.tw/debian",
+ "linux.cdpa.nsysu.edu.tw/debian",
+ );
+
+our @volatile_european_sites = (
+ "volatile.debian.net/debian-volatile",
+ "ftp2.de.debian.org/debian-volatile",
+ "ftp.sk.debian.org/debian-volatile",
+ );
+our @backports_european_sites = (
+ "www.backports.org/debian",
+ "debian.sil.at/backports.org/",
+ "backports.debian.or.at/backports.org",
+ "mirror.realroute.net/backports.org",
+ "backports.cisbg.com",
+ "backports.linuxdediziert.de/backports.org",
+ "debian.netcologne.de/debian-backports",
+ "ftp.de.debian.org/backports.org",
+ "mirror.buildd.net/backports.org",
+ "ftp.estpak.ee/backports.org",
+ "debian.acantho.net/backports.org",
+ "backports.essentkabel.com/backports.org",
+ "backports.sipo.nl",
+ "ftp.tuke.sk",
+ );
+our @backports_asian_sites = (
+ "backports.mithril-linux.org",
+ );
+our @backports_australian_sites = (
+ "mirror.linux.org.au/backports.org",
+ );
+our @amd64_european_sites = (
+ "amd64.debian.net/debian",
+ "ftp.de.debian.org/debian-amd64/debian",
+ "bach.hpc2n.umu.se/debian-amd64/debian",
+ "bytekeeper.as28747.net/debian-amd64/debian",
+ "mirror.switch.ch/debian-amd64/debian",
+ "ftp.nl.debian.org/debian-amd64/debian",
+ );
+our @amd64_asian_sites = (
+ "hanzubon.jp/debian-amd64/debian",
+ );
+our @amd64_north_american_sites = (
+ "mirror.espri.arizona.edu/debian-amd64/debian",
+ );
+our @kfreebsd_north_american_sites = (
+ "www.gtlib.gatech.edu/pub/gnuab/debian",
+ );
+our @kfreebsd_european_sites = (
+ # master site, aka ftp.gnuab.org
+ "kfreebsd-gnu.debian.net/debian",
+ "ftp.easynet.be/ftp/gnuab/debian",
+ "ftp.de.debian.org/debian-kfreebsd",
+ );
+our @nonus_north_american_sites = (
+# "ftp.ca.debian.org/debian-non-US",
+ "debian.yorku.ca/debian/non-US",
+ "mirror.direct.ca/linux/debian-non-US",
+ );
+our @nonus_european_sites = (
+ "non-us.debian.org/debian-non-US",
+ "ftp.de.debian.org/debian-non-US",
+ "ftp.at.debian.org/debian-non-US",
+ "ftp.bg.debian.org/debian-non-US",
+ "ftp.cz.debian.org/debian-non-US",
+ "ftp.fi.debian.org/debian-non-US",
+ "ftp.fr.debian.org/debian-non-US",
+ "ftp.hr.debian.org/debian-non-US",
+ "ftp.hu.debian.org/debian-non-US",
+ "ftp.ie.debian.org/debian-non-US",
+ "ftp.is.debian.org/debian-non-US",
+ "ftp.it.debian.org/debian-non-US",
+ "ftp.nl.debian.org/debian-non-US",
+ "ftp.no.debian.org/debian-non-US",
+ "ftp.pl.debian.org/debian/non-US",
+ "ftp.si.debian.org/debian-non-US",
+ "ftp.es.debian.org/debian-non-US",
+ "ftp.se.debian.org/debian-non-US",
+ "ftp.tr.debian.org/debian-non-US",
+ "ftp.uk.debian.org/debian/non-US",
+ );
+our @nonus_australian_sites = (
+ "ftp.au.debian.org/debian-non-US",
+ "ftp.wa.au.debian.org/debian-non-US",
+ "ftp.nz.debian.org/debian-non-US",
+ );
+our @nonus_asian_sites = (
+ "ftp.jp.debian.org/debian-non-US",
+# "ftp.kr.debian.org/debian-non-US",
+ "linux.csie.nctu.edu.tw/debian-non-US",
+ "debian.linux.org.tw/debian-non-US",
+ "linux.cdpa.nsysu.edu.tw/debian-non-US",
+ );
+our @nonus_south_american_sites = (
+ "ftp.br.debian.org/debian-non-US",
+ "ftp.cl.debian.org/debian-non-US",
+ );
+
+# list of architectures
+our %arches = (
+ i386 => 'Intel x86',
+ m68k => 'Motorola 680x0',
+ sparc => 'SPARC',
+ alpha => 'Alpha',
+ powerpc => 'PowerPC',
+ arm => 'ARM',
+ hppa => 'HP PA-RISC',
+ ia64 => 'Intel IA-64',
+ mips => 'MIPS',
+ mipsel => 'MIPS (DEC)',
+ s390 => 'IBM S/390',
+ "hurd-i386" => 'Hurd (i386)',
+ amd64 => 'AMD64',
+ "kfreebsd-i386" => 'GNU/kFreeBSD (i386)'
+);
+
+sub do_download {
+ my ($params, $opts, $html_header, $menu, $page_content) = @_;
+
+ if ($params->{errors}{package}) {
+ fatal_error( "package not valid or not specified" );
+ }
+ if ($params->{errors}{suite}) {
+ fatal_error( "suite not valid or not specified" );
+ }
+ if ($params->{errors}{arch}) {
+ fatal_error( "arch not valid or not specified" );
+ }
+ if (@{$opts->{suite}} > 1) {
+ fatal_error( "more than one suite specified for download (@{$opts->{suite}})" );
+ }
+ if (@{$opts->{arch}} > 1) {
+ fatal_error( "more than one architecture specified for download (@{$opts->{arch}})" );
+ }
+
+ $opts->{h_sections} = { map { $_ => 1 } @SECTIONS };
+ my $pkg = $opts->{package};
+ my $suite = $opts->{suite}[0];
+ my $arch = $opts->{arch}[0] ||'';
+
+ our (%packages_all);
+ my (@results);
+ my ($final_result, $file, $filen, $md5sum, @file_components, $archive) = ("")x5;
+
+ sub gettext { return $_[0]; };
+
+ my $st0 = new Benchmark;
+ unless (@Packages::CGI::fatal_errors) {
+ tie %packages_all, 'DB_File', "$DBDIR/packages_all_$suite.db",
+ O_RDONLY, 0666, $DB_BTREE
+ or die "couldn't tie DB $DBDIR/packages_all_$suite.db: $!";
+
+ read_entry( \%packages, $pkg, \@results, $opts );
+
+ unless (@results) {
+ fatal_error( "No such package".
+ "{insert link to search page with substring search}" );
+ } else {
+ my $final_result = shift @results;
+ foreach (@results) {
+ if (version_cmp( $_->[7], $final_result->[7] ) > 0) {
+ $final_result = $_;
+ }
+ }
+
+ $archive = $final_result->[1];
+ my %data = split /\000/, $packages_all{"$pkg $arch $final_result->[7]"};
+ $file = $data{filename};
+ @file_components = split('/', $file);
+ $filen = pop(@file_components);
+
+ $md5sum = $data{md5sum};
+ }
+ }
+
+ my $arch_string = $arch ne 'all' ? "on $arches{$arch} machines" : "";
+
+ %$html_header = ( title => "Package Download Selection",
+ lang => "en",
+ print_title => 1 );
+
+ if ($file) {
+ $$page_content .= "<h2>Download Page for <kbd>$filen</kbd> $arch_string</h2>\n".
+ "<p>You can download the requested file from the <tt>";
+ $$page_content .= join( '/', @file_components).'/';
+ $$page_content .= "</tt> subdirectory at";
+ $$page_content .= $archive ne 'security' ? " any of these sites:" : ":";
+ $$page_content .= "</p>\n";
+
+ if ($archive eq 'security') {
+
+ $$page_content .= <<END;
+<ul>
+ <li><a href="http://security.debian.org/debian-security/$file">security.debian.org/debian-security</a></li>
+ </ul>
+
+ <p>Debian security updates are currently officially distributed only via
+ security.debian.org.</p>
+END
+;
+ } elsif ($arch eq 'amd64') {
+
+ $$page_content .= print_links( "North America", $file, @amd64_north_american_sites );
+ $$page_content .= print_links( "Europe", $file, @amd64_european_sites );
+# $$page_content .= print_links( "Australia and New Zealand", $file,
+# @nonus_australian_sites );
+ $$page_content .= print_links( "Asia", $file, @amd64_asian_sites );
+# $$page_content .= print_links( "South America", $file, @nonus_south_american_sites );
+
+ $$page_content .= <<END;
+<p>Note that AMD64 is not officialy included in the Debian archive
+ yet, but the AMD64 porter group keeps their archive in sync with
+ the official archive as close as possible. See the
+ <a href="http://www.debian.org/ports/amd64/">AMD64 ports page</a> for
+ current information.</p>
+END
+;
+ } elsif ($arch eq 'kfreebsd-i386') {
+
+ $$page_content .= print_links( "North America", $file, @kfreebsd_north_american_sites );
+ $$page_content .= print_links( "Europe", $file, @kfreebsd_european_sites );
+# $$page_content .= print_links( "Australia and New Zealand", $file,
+# @nonus_australian_sites );
+# $$page_content .= print_links( "Asia", $file, @amd64_asian_sites );
+# $$page_content .= print_links( "South America", $file, @nonus_south_american_sites );
+
+ $$page_content .= <<END;
+<p>Note that GNU/kFreeBSD is not officialy included in the Debian archive
+ yet, but the GNU/kFreeBSD porter group keeps their archive in sync with
+ the official archive as close as possible. See the
+ <a href="http://www.debian.org/ports/kfreebsd-gnu/">GNU/kFreeBSD ports page</a> for
+ current information.</p>
+END
+;
+ } elsif ($archive eq 'non-US') {
+
+ $$page_content .= print_links( "North America", $file, @nonus_north_american_sites );
+ $$page_content .= print_links( "Europe", $file, @nonus_european_sites );
+ $$page_content .= print_links( "Australia and New Zealand", $file,
+ @nonus_australian_sites );
+ $$page_content .= print_links( "Asia", $file, @nonus_asian_sites );
+ $$page_content .= print_links( "South America", $file, @nonus_south_american_sites );
+
+ $$page_content .= <<END;
+<p>If none of the above sites are fast enough for you, please see our
+ <a href="http://www.debian.org/mirror/list-non-US">complete mirror list</a>.</p>
+END
+;
+ } elsif ($archive eq 'backports') {
+
+# $$page_content .= print_links( "North America", $file, @nonus_north_american_sites );
+ $$page_content .= '<div class="cardleft">';
+ $$page_content .= print_links( "Europe", $file, @backports_european_sites );
+ $$page_content .= '</div><div class="cardright">';
+ $$page_content .= print_links( "Australia and New Zealand", $file,
+ @backports_australian_sites );
+ $$page_content .= print_links( "Asia", $file, @backports_asian_sites );
+# $$page_content .= print_links( "South America", $file, @nonus_south_american_sites );
+ $$page_content .= '</div>';
+
+ $$page_content .= <<END;
+<p style="clear:both">If none of the above sites are fast enough for you, please see our
+ <a href="http://www.backports.org/debian/README.mirrors.html">complete mirror list</a>.</p>
+END
+;
+ } elsif ($archive eq 'volatile') {
+
+# $$page_content .= print_links( "North America", $file, @nonus_north_american_sites );
+ $$page_content .=_links( "Europe", $file, @volatile_european_sites );
+# $$page_content .= print_links( "Australia and New Zealand", $file,
+# @nonus_australian_sites );
+# $$page_content .= print_links( "Asia", $file, @nonus_asian_sites );
+# $$page_content .= print_links( "South America", $file, @nonus_south_american_sites );
+
+ $$page_content .= <<END;
+<p>If none of the above sites are fast enough for you, please see our
+ <a href="http://volatile.debian.net/mirrors.html">complete mirror list</a>.</p>
+END
+;
+ } elsif ($archive eq 'us') {
+
+ $$page_content .= '<div class="cardleft">';
+ $$page_content .= print_links( "North America", $file, @north_american_sites );
+ $$page_content .= '</div><div class="cardright">';
+ $$page_content .= print_links( "Europe", $file, @european_sites );
+ $$page_content .= '</div><div class="cardleft">';
+ $$page_content .= print_links( "Australia and New Zealand", $file, @australian_sites );
+ $$page_content .= '</div><div class="cardright">';
+ $$page_content .= print_links( "Asia", $file, @asian_sites );
+ $$page_content .= '</div><div class="cardleft">';
+ $$page_content .= print_links( "South America", $file, @south_american_sites );
+ $$page_content .= '</div>';
+
+ $$page_content .= <<END;
+<p style="clear:both">If none of the above sites are fast enough for you, please see our
+ <a href="http://www.debian.org/mirror/list">complete mirror list</a>.</p>
+END
+;
+ }
+
+ $$page_content .= <<END;
+<p>Note that in some browsers you will need to tell your browser you want
+ the file saved to a file. For example, in Netscape or Mozilla, you should
+ hold the Shift key when you click on the URL.</p>
+END
+;
+ $$page_content .= "<p>The MD5sum for <tt>$filen</tt> is <strong>$md5sum</strong></p>\n"
+ if $md5sum;
+ }
+}
+
+sub print_links {
+ my ( $title, $file, @servers ) = @_;
+
+ my $str = "<p><em>$title</em></p>";
+ $str .= "<ul>";
+ foreach (@servers) {
+ $str .= "<li><a href=\"http://$_/$file\">$_</a></li>\n";
+ # $str .= "<li><a href=\"ftp://$_/$file\">$_</a></li>\n";
+ }
+ $str .= "</ul>";
+
+ return $str;
+}
+
+1;
--- /dev/null
+package Packages::DoFilelist;
+
+use strict;
+use warnings;
+
+use POSIX;
+use URI::Escape;
+use HTML::Entities;
+use DB_File;
+use Benchmark;
+use Exporter;
+
+use Deb::Versions;
+use Packages::Config qw( $DBDIR $ROOT @SUITES @ARCHIVES @SECTIONS
+ @ARCHITECTURES %FTP_SITES );
+use Packages::CGI;
+use Packages::DB;
+use Packages::Search qw( :all );
+use Packages::HTML;
+use Packages::Page ();
+use Packages::SrcPage ();
+
+our @ISA = qw( Exporter );
+our @EXPORT = qw( do_filelist );
+
+sub do_filelist {
+ my ($params, $opts, $html_header, $menu, $page_content) = @_;
+
+ if ($params->{errors}{package}) {
+ fatal_error( "package not valid or not specified" );
+ }
+ if ($params->{errors}{suite}) {
+ fatal_error( "suite not valid or not specified" );
+ }
+ if ($params->{errors}{arch}) {
+ fatal_error( "arch not valid or not specified" );
+ }
+
+ $$menu = '';
+ my $pkg = $opts->{package};
+ my $suite = $opts->{suite}[0];
+ my $arch = $opts->{arch}[0] ||'';
+
+ %$html_header = ( title => "Filelist of package <em>$pkg</em> in <em>$suite</em> of arch <em>$arch</em>",
+ title_tag => "Filelist of of package $pkg/$suite/$arch",
+ lang => 'en',
+ keywords => "debian, $suite, $arch, filelist",
+ print_title => 1,
+ );
+
+ unless (@Packages::CGI::fatal_errors) {
+ if (tie my %contents, 'DB_File', "$DBDIR/contents/filelists_${suite}_${arch}.db",
+ O_RDONLY, 0666, $DB_BTREE) {
+
+ unless (exists $contents{$pkg}) {
+ fatal_error( "No such package in this suite on this arch" );
+ } else {
+ my @files = unpack "L/(CC/a)", $contents{$pkg};
+ my $file = "";
+ $$page_content .= '<pre style="border-top:solid #BFC3DC thin;padding:.5em;">';
+ for (my $i=0; $i<scalar @files;) {
+ $file = substr($file, 0, $files[$i++]).$files[$i++];
+ $$page_content .= "$file\n";
+ }
+ $$page_content .= "</pre>";
+ }
+ } else {
+ fatal_error( "Invalid suite/arch combination" );
+ }
+ }
+}
+
+1;
--- /dev/null
+package Packages::DoSearch;
+
+use strict;
+use warnings;
+
+use Benchmark;
+use DB_File;
+use URI::Escape;
+use HTML::Entities;
+use Exporter;
+our @ISA = qw( Exporter );
+our @EXPORT = qw( do_search );
+
+use Deb::Versions;
+use Packages::Search qw( :all );
+use Packages::CGI;
+use Packages::DB;
+use Packages::Config qw( $DBDIR $SEARCH_URL $SEARCH_CGI $SEARCH_PAGE
+ @SUITES @ARCHIVES $ROOT );
+
+sub do_search {
+ my ($params, $opts, $html_header, $menu, $page_content) = @_;
+
+ if ($params->{errors}{keywords}) {
+ fatal_error( "keyword not valid or missing" );
+ } elsif (length($opts->{keywords}) < 2) {
+ fatal_error( "keyword too short (keywords need to have at least two characters)" );
+ }
+
+ $$menu = "";
+
+ my $keyword = $opts->{keywords};
+ my $searchon = $opts->{searchon};
+
+ # for URL construction
+ my $keyword_esc = uri_escape( $keyword );
+ my $suites_param = join ',', @{$params->{values}{suite}{no_replace}};
+ my $sections_param = join ',', @{$params->{values}{section}{no_replace}};
+ my $archs_param = join ',', @{$params->{values}{arch}{no_replace}};
+
+ # for output
+ my $keyword_enc = encode_entities $keyword || '';
+ my $searchon_enc = encode_entities $searchon;
+ my $suites_enc = encode_entities( join( ', ', @{$params->{values}{suite}{no_replace}} ) );
+ my $sections_enc = encode_entities( join( ', ', @{$params->{values}{section}{no_replace}} ) );
+ my $archs_enc = encode_entities( join( ', ', @{$params->{values}{arch}{no_replace}} ) );
+
+ my $st0 = new Benchmark;
+ my (@results, @non_results);
+
+ unless (@Packages::CGI::fatal_errors) {
+
+ if ($searchon eq 'names') {
+ if ($opts->{source}) {
+ do_names_search( $keyword, \%sources, $sp_obj,
+ \&read_src_entry_all, $opts,
+ \@results, \@non_results );
+ } else {
+ do_names_search( $keyword, \%packages, $p_obj,
+ \&read_entry_all, $opts,
+ \@results, \@non_results );
+ }
+# } elsif ($searchon eq 'contents') {
+# require "./search_contents.pl";
+# &contents($input);
+ } else {
+ do_names_search( $keyword, \%packages, $p_obj,
+ \&read_entry_all, $opts,
+ \@results, \@non_results );
+ do_fulltext_search( $keyword, "$DBDIR/descriptions.txt",
+ \%did2pkg, \%packages,
+ \&read_entry_all, $opts,
+ \@results, \@non_results );
+ }
+ }
+
+# use Data::Dumper;
+# debug( join( "", Dumper( \@results, \@non_results )) );
+ my $st1 = new Benchmark;
+ my $std = timediff($st1, $st0);
+ debug( "Search took ".timestr($std) );
+
+ my $suite_wording = $suites_enc eq "all" ? "all suites"
+ : "suite(s) <em>$suites_enc</em>";
+ my $section_wording = $sections_enc eq 'all' ? "all sections"
+ : "section(s) <em>$sections_enc</em>";
+ my $arch_wording = $archs_enc eq 'any' ? "all architectures"
+ : "architecture(s) <em>$archs_enc</em>";
+ if ($searchon eq "names") {
+ my $source_wording = $opts->{source} ? "source " : "";
+ my $exact_wording = $opts->{exact} ? "named" : "that names contain";
+ msg( "You have searched for ${source_wording}packages $exact_wording <em>$keyword_enc</em> in $suite_wording, $section_wording, and $arch_wording." );
+ } else {
+ my $exact_wording = $opts->{exact} ? "" : " (including subword matching)";
+ msg( "You have searched for <em>$keyword_enc</em> in packages names and descriptions in $suite_wording, $section_wording, and $arch_wording$exact_wording." );
+ }
+
+ if ($Packages::Search::too_many_hits) {
+ error( "Your search was too wide so we will only display exact matches. At least <em>$Packages::Search::too_many_hits</em> results have been omitted and will not be displayed. Please consider using a longer keyword or more keywords." );
+ }
+
+ if (!@Packages::CGI::fatal_errors && !@results) {
+ my $printed = 0;
+ if ($searchon eq "names") {
+ unless (@non_results) {
+ error( "Can't find that package." );
+ } else {
+ hint( "Can't find that package. ".
+ "<a href=\"$SEARCH_URL/$keyword_esc\">".
+ ($#non_results+1)."</a>".
+ " results have not been displayed due to the".
+ " search parameters." );
+ }
+
+ } else {
+ if (($suites_enc eq 'all')
+ && ($archs_enc eq 'any')
+ && ($sections_enc eq 'all')) {
+ error( "Can't find that string." );
+ } else {
+ error( "Can't find that string, at least not in that suite ($suites_enc, section $sections_enc) and on that architecture ($archs_enc)." );
+ }
+
+ if ($opts->{exact}) {
+ $printed++;
+ hint( "You have searched only for words exactly matching your keywords. You can try to search <a href=\"$SEARCH_CGI?exact=0;searchon=$searchon;suite=$suites_param;section=$sections_param;keywords=$keyword_esc;arch=$archs_param\">allowing subword matching</a>." );
+ }
+ }
+ hint( ( $printed ? "Or you" : "You" )." can try a different search on the <a href=\"$SEARCH_PAGE#search_packages\">Packages search page</a>." );
+
+ }
+
+ %$html_header = ( title => 'Package Search Results' ,
+ lang => 'en',
+ title_tag => 'Debian Package Search Results',
+ print_title => 1,
+ print_search_field => 'packages',
+ search_field_values => {
+ keywords => $keyword_enc,
+ searchon => $opts->{searchon_form},
+ arch => $archs_enc,
+ suite => $suites_enc,
+ section => $sections_enc,
+ exact => $opts->{exact},
+ debug => $opts->{debug},
+ },
+ );
+
+ $$page_content = '';
+ if (@results) {
+ my (%pkgs, %subsect, %sect, %archives, %desc, %binaries, %provided_by);
+
+ unless ($opts->{source}) {
+ foreach (@results) {
+ my ($pkg_t, $archive, $suite, $arch, $section, $subsection,
+ $priority, $version, $desc) = @$_;
+
+ my ($pkg) = $pkg_t =~ m/^(.+)/; # untaint
+ if ($arch ne 'virtual') {
+ my $real_archive;
+ if ($archive =~ /^(security|non-US)$/) {
+ $real_archive = $archive;
+ $archive = 'us';
+ }
+
+ $pkgs{$pkg}{$suite}{$archive}{$version}{$arch} = 1;
+ $subsect{$pkg}{$suite}{$archive}{$version} = $subsection;
+ $sect{$pkg}{$suite}{$archive}{$version} = $section
+ unless $section eq 'main';
+ $archives{$pkg}{$suite}{$archive}{$version} = $real_archive
+ if $real_archive;
+
+ $desc{$pkg}{$suite}{$archive}{$version} = $desc;
+ } else {
+ $provided_by{$pkg}{$suite}{$archive} = [ split /\s+/, $desc ];
+ }
+ }
+
+ my @pkgs = sort(keys %pkgs, keys %provided_by);
+ $$page_content .= print_packages( \%pkgs, \@pkgs, $opts, $keyword,
+ \&print_package, \%provided_by,
+ \%archives, \%sect, \%subsect,
+ \%desc );
+
+ } else { # unless $opts->{source}
+ foreach (@results) {
+ my ($pkg, $archive, $suite, $section, $subsection, $priority,
+ $version) = @$_;
+
+ my $real_archive = '';
+ if ($archive =~ /^(security|non-US)$/) {
+ $real_archive = $archive;
+ $archive = 'us';
+ }
+ if (($real_archive eq $archive) &&
+ $pkgs{$pkg}{$suite}{$archive} &&
+ (version_cmp( $pkgs{$pkg}{$suite}{$archive}, $version ) >= 0)) {
+ next;
+ }
+ $pkgs{$pkg}{$suite}{$archive} = $version;
+ $subsect{$pkg}{$suite}{$archive}{source} = $subsection;
+ $sect{$pkg}{$suite}{$archive}{source} = $section
+ unless $section eq 'main';
+ $archives{$pkg}{$suite}{$archive}{source} = $real_archive
+ if $real_archive;
+
+ $binaries{$pkg}{$suite}{$archive} = find_binaries( $pkg, $archive, $suite, \%src2bin );
+ }
+
+ my @pkgs = sort keys %pkgs;
+ $$page_content .= print_packages( \%pkgs, \@pkgs, $opts, $keyword,
+ \&print_src_package, \%archives,
+ \%sect, \%subsect, \%binaries );
+ } # else unless $opts->{source}
+ } # if @results
+} # sub do_search
+
+sub print_packages {
+ my ($pkgs, $pkgs_list, $opts, $keyword, $print_func, @func_args) = @_;
+
+ #my ($start, $end) = multipageheader( $input, scalar @pkgs, \%opts );
+ my $str .= "<p>Found <em>".(scalar @$pkgs_list)."</em> matching packages.";
+ #my $count = 0;
+
+ my $have_exact;
+ if (grep { $_ eq $keyword } @$pkgs_list) {
+ $have_exact = 1;
+ $str .= '<h2 style="padding:.3em;border-top:solid grey thin;border-bottom:solid grey thin;background-color:#bdf">Exact hits</h2>';
+ $str .= &$print_func( $keyword, $pkgs->{$keyword}||{},
+ map { $_->{$keyword}||{} } @func_args );
+ @$pkgs_list = grep { $_ ne $keyword } @$pkgs_list;
+ }
+
+ if (@$pkgs_list && (($opts->{searchon} ne 'names') || !$opts->{exact})) {
+ $str .= '<h2 style="padding:.3em;border-top:solid grey thin;border-bottom:solid grey thin;background-color:#bdf">Other hits</h2>'
+ if $have_exact;
+
+ foreach my $pkg (@$pkgs_list) {
+ #$count++;
+ #next if $count < $start or $count > $end;
+ $str .= &$print_func( $pkg, $pkgs->{$pkg}||{},
+ map { $_->{$pkg}||{} } @func_args );
+ }
+ } elsif (@$pkgs_list) {
+ $str .= "<p><a href=\"$SEARCH_URL/FIXME\">".
+ ($#{$pkgs_list}+1)."</a> results have not been displayed because you requested only exact matches.</p>";
+ }
+
+ return $str;
+}
+
+sub print_package {
+ my ($pkg, $pkgs, $provided_by, $archives, $sect, $subsect, $desc) = @_;
+
+ my $str = sprintf "<h3>Package %s</h3>\n", $pkg;
+ return $str;
+ $str .= "<ul>\n";
+ foreach my $suite (@SUITES) {
+ foreach my $archive (@ARCHIVES) {
+ next if $archive eq 'security';
+ next if $archive eq 'non-US';
+ my $path = $suite.(($archive ne 'us')?"/$archive":'');
+ if (exists $pkgs->{$suite}{$archive}) {
+ my %archs_printed;
+ my @versions = version_sort keys %{$pkgs->{$suite}{$archive}};
+ my $origin_str = "";
+ if ($sect->{$suite}{$archive}{$versions[0]}) {
+ $origin_str .= " [<span style=\"color:red\">$sect->$suite}{$archive}{$versions[0]}</span>]";
+ }
+ $str .= sprintf( "<li><a href=\"$ROOT/%s/%s\">%s</a> (%s): %s %s\n",
+ $path, $pkg, $path, $subsect->{$suite}{$archive}{$versions[0]},
+ $desc->{$suite}{$archive}{$versions[0]}, $origin_str );
+
+ foreach my $v (@versions) {
+ my $archive_str = "";
+ if ($archives->{$suite}{$archive}{$v}) {
+ $archive_str .= " [<span style=\"color:red\">$archives->{$suite}{$archive}{$v}</span>]";
+ }
+
+ my @archs_to_print = grep { !$archs_printed{$_} } sort keys %{$pkgs->{$suite}{$archive}{$v}};
+ $str .= sprintf( "<br>%s$archive_str: %s\n",
+ $v, join (" ", @archs_to_print ))
+ if @archs_to_print;
+ $archs_printed{$_}++ foreach @archs_to_print;
+ }
+ if (my $p = $provided_by->{$suite}{$archive}) {
+ $str .= '<br>also provided by: '.
+ join( ', ', map { "<a href=\"$ROOT/$path/$_\">$_</a>" } @$p);
+ }
+ $str .= "</li>\n";
+ } elsif (my $p = $provided_by->{$suite}{$archive}) {
+ $str .= sprintf( "<li><a href=\"$ROOT/%s/%s\">%s</a>: Virtual package<br>",
+ $path, $pkg, $path );
+ $str .= 'provided by: '.
+ join( ', ', map { "<a href=\"$ROOT/$path/$_\">$_</a>" } @$p);
+ }
+ }
+ }
+ $str .= "</ul>\n";
+ return $str;
+}
+
+sub print_src_package {
+ my ($pkg, $pkgs, $archives, $sect, $subsect, $binaries) = @_;
+
+ my $str = sprintf "<h3>Source package %s</h3>\n", $pkg;
+ $str .= "<ul>\n";
+ foreach my $suite (@SUITES) {
+ foreach my $archive (@ARCHIVES) {
+ if (exists $pkgs->{$suite}{$archive}) {
+ my $origin_str = "";
+ if ($sect->{$suite}{$archive}{source}) {
+ $origin_str .= " [<span style=\"color:red\">$sect->{$suite}{$archive}{source}</span>]";
+ }
+ if ($archives->{$suite}{$archive}{source}) {
+ $origin_str .= " [<span style=\"color:red\">$archives->{$suite}{$archive}{source}</span>]";
+ }
+ $str .= sprintf( "<li><a href=\"$ROOT/%s/source/%s\">%s</a> (%s): %s %s",
+ $suite.(($archive ne 'us')?"/$archive":''), $pkg, $suite.(($archive ne 'us')?"/$archive":''), $subsect->{$suite}{$archive}{source},
+ $pkgs->{$suite}{$archive}, $origin_str );
+
+ $str .= "<br>Binary packages: ";
+ my @bp_links;
+ foreach my $bp (@{$binaries->{$suite}{$archive}}) {
+ my $bp_link = sprintf( "<a href=\"$ROOT/%s/%s\">%s</a>",
+ $suite.(($archive ne 'us')?"/$archive":''), uri_escape( $bp ), $bp );
+ push @bp_links, $bp_link;
+ }
+ $str .= join( ", ", @bp_links );
+ $str .= "</li>\n";
+ }
+ }
+ }
+ $str .= "</ul>\n";
+ return $str;
+}
+
+1;
--- /dev/null
+package Packages::DoShow;
+
+use strict;
+
+use POSIX;
+use URI::Escape;
+use HTML::Entities;
+use DB_File;
+use Benchmark;
+use Exporter;
+
+use Deb::Versions;
+use Packages::Config qw( $DBDIR $ROOT @SUITES @ARCHIVES @SECTIONS
+ @ARCHITECTURES %FTP_SITES );
+use Packages::CGI;
+use Packages::DB;
+use Packages::Search qw( :all );
+use Packages::HTML;
+use Packages::Page ();
+use Packages::SrcPage ();
+
+our @ISA = qw( Exporter );
+our @EXPORT = qw( do_show );
+
+sub do_show {
+ my ($params, $opts, $html_header, $menu, $page_content) = @_;
+
+ if ($params->{errors}{package}) {
+ fatal_error( "package not valid or not specified" );
+ }
+ if ($params->{errors}{suite}) {
+ fatal_error( "suite not valid or not specified" );
+ }
+ if (@{$opts->{suite}} > 1) {
+ fatal_error( "more than one suite specified for show (@{$opts->{suite}})" );
+ }
+
+ my $pkg = $opts->{package};
+ my $encodedpkg = uri_escape( $pkg );
+ my $suite = $opts->{suite}[0];
+ my $archive = $opts->{archive}[0] ||'';
+
+ my $DL_URL = "$pkg/download";
+ my $FILELIST_URL = "$pkg/files";
+
+ our (%packages_all, %sources_all);
+ my (@results, @non_results);
+ my $page = $opts->{source} ?
+ new Packages::SrcPage( $pkg ) :
+ new Packages::Page( $pkg );
+ my $package_page = "";
+ my ($short_desc, $version, $section, $subsection) = ("")x5;
+
+ sub gettext { return $_[0]; };
+
+ my $st0 = new Benchmark;
+ unless (@Packages::CGI::fatal_errors) {
+ tie %packages_all, 'DB_File', "$DBDIR/packages_all_$suite.db",
+ O_RDONLY, 0666, $DB_BTREE
+ or die "couldn't tie DB $DBDIR/packages_all_$suite.db: $!";
+ tie %sources_all, 'DB_File', "$DBDIR/sources_all_$suite.db",
+ O_RDONLY, 0666, $DB_BTREE
+ or die "couldn't tie DB $DBDIR/sources_all_$suite.db: $!";
+
+ unless ($opts->{source}) {
+ read_entry_all( \%packages, $pkg, \@results, \@non_results, $opts );
+ } else {
+ read_src_entry_all( \%sources, $pkg, \@results, \@non_results, $opts );
+ }
+
+ unless (@results || @non_results ) {
+ fatal_error( "No such package".
+ "{insert link to search page with substring search}" );
+ } else {
+ my %all_suites;
+ foreach (@results, @non_results) {
+ my $a = $_->[1];
+ my $s = $_->[2];
+ if ($a =~ /^(?:us|security|non-US)$/o) {
+ $all_suites{$s}++;
+ } else {
+ $all_suites{"$s/$a"}++;
+ }
+ }
+ foreach (suites_sort(keys %all_suites)) {
+ if (("$suite/$archive" eq $_)
+ || (!$all_suites{"$suite/$archive"} && ($suite eq $_))) {
+ $$menu .= "[ <strong>$_</strong> ] ";
+ } else {
+ $$menu .=
+ "[ <a href=\"$ROOT/$_/$encodedpkg\">$_</a> ] ";
+ }
+ }
+ $$menu .= '<br>';
+
+ unless (@results) {
+ fatal_error( "Package not available in this suite" );
+ } else {
+ unless ($opts->{source}) {
+ for my $entry (@results) {
+ debug( join(":", @$entry), 1 );
+ my (undef, $archive, undef, $arch, $section, $subsection,
+ $priority, $version, $provided_by) = @$entry;
+
+ if ($arch ne 'virtual') {
+ my %data = split /\000/, $packages_all{"$pkg $arch $version"};
+ $data{package} = $pkg;
+ $data{architecture} = $arch;
+ $data{version} = $version;
+ $page->merge_package(\%data) or debug( "Merging $pkg $arch $version FAILED", 2 );
+ } else {
+ $page->add_provided_by([split /\s+/, $provided_by]);
+ }
+ }
+
+ unless ($page->is_virtual()) {
+ $version = $page->{newest};
+ my $source = $page->get_newest( 'source' );
+ $archive = $page->get_newest( 'archive' );
+ debug( "find source package: source=$source", 1);
+ my $src_data = $sources_all{"$archive $suite $source"};
+ $page->add_src_data( $source, $src_data )
+ if $src_data;
+
+ my $st1 = new Benchmark;
+ my $std = timediff($st1, $st0);
+ debug( "Data search and merging took ".timestr($std) );
+
+ my ($v_str, $v_str_arch, $v_str_arr) = $page->get_version_string();
+ my $did = $page->get_newest( 'description' );
+ $section = $page->get_newest( 'section' );
+ $subsection = $page->get_newest( 'subsection' );
+ my $filenames = $page->get_arch_field( 'filename' );
+ my $file_md5sums = $page->get_arch_field( 'md5sum' );
+ my $archives = $page->get_arch_field( 'archive' );
+ my $sizes_inst = $page->get_arch_field( 'installed-size' );
+ my $sizes_deb = $page->get_arch_field( 'size' );
+ my @archs = sort $page->get_architectures;
+
+ # process description
+ #
+ my $desc = $descriptions{$did};
+ $short_desc = encode_entities( $1, "<>&\"" )
+ if $desc =~ s/^(.*)$//m;
+ my $long_desc = encode_entities( $desc, "<>&\"" );
+
+ $long_desc =~ s,((ftp|http|https)://[\S~-]+?/?)((\>\;)?[)]?[']?[:.\,]?(\s|$)),<a href=\"$1\">$1</a>$3,go; # syntax highlighting -> '];
+ $long_desc =~ s/\A //o;
+ $long_desc =~ s/\n /\n/sgo;
+ $long_desc =~ s/\n.\n/\n<p>\n/go;
+ $long_desc =~ s/(((\n|\A) [^\n]*)+)/\n<pre>$1\n<\/pre>/sgo;
+# $long_desc = conv_desc( $lang, $long_desc );
+# $short_desc = conv_desc( $lang, $short_desc );
+
+ $$menu .= simple_menu( [ gettext( "Distribution:" ),
+ gettext( "Overview over this suite" ),
+ "$ROOT/$suite/",
+ $suite ],
+ [ gettext( "Section:" ),
+ gettext( "All packages in this section" ),
+ "$ROOT/$suite/$subsection/",
+ $subsection ],
+ );
+
+ my $title .= sprintf( gettext( "Package: %s (%s)" ), $pkg, $v_str );
+ $title .= " ".marker( $archive ) if $archive ne 'us';
+ $title .= " ".marker( $subsection ) if $subsection eq 'non-US'
+ and $archive ne 'non-US'; # non-US/security
+ $title .= " ".marker( $section ) if $section ne 'main';
+ $package_page .= title( $title );
+
+ $package_page .= "<h2>".gettext( "Versions:" )." $v_str_arch</h2>\n"
+ unless $version eq $v_str;
+ if (my $provided_by = $page->{provided_by}) {
+ note( gettext( "This is also a virtual package provided by ").join( ', ', map { "<a href=\"$ROOT/$suite/$_\">$_</a>" } @$provided_by) );
+ }
+
+ if ($suite eq "experimental") {
+ note( gettext( "Experimental package"),
+ gettext( "Warning: This package is from the <span class=\"pred\">experimental</span> 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><p>".
+ gettext( "Users of experimental packages are encouraged to contact the package maintainers directly in case of problems." )
+ );
+ }
+ if ($subsection eq "debian-installer") {
+ note( gettext( "debian-installer udeb package"),
+ gettext( "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." )
+ );
+ }
+ $package_page .= pdesc( $short_desc, $long_desc );
+
+ #
+ # display dependencies
+ #
+ my $dep_list;
+ $dep_list = print_deps( \%packages, $opts, $pkg,
+ $page->get_dep_field('depends'),
+ 'depends' );
+ $dep_list .= print_deps( \%packages, $opts, $pkg,
+ $page->get_dep_field('recommends'),
+ 'recommends' );
+ $dep_list .= print_deps( \%packages, $opts, $pkg,
+ $page->get_dep_field('suggests'),
+ 'suggests' );
+
+ if ( $dep_list ) {
+ $package_page .= "<div id=\"pdeps\">\n";
+ $package_page .= sprintf( "<h2>".gettext( "Other Packages Related to %s" )."</h2>\n", $pkg );
+ if ($suite eq "experimental") {
+ note( gettext( "Note that the \"<span class=\"pred\">experimental</span>\" distribution is not self-contained; missing dependencies are likely found in the \"<a href=\"/unstable/\">unstable</a>\" distribution." ) );
+ }
+
+ $package_page .= pdeplegend( [ 'dep', gettext( 'depends' ) ],
+ [ 'rec', gettext( 'recommends' ) ],
+ [ 'sug', gettext( 'suggests' ) ], );
+
+ $package_page .= $dep_list;
+ $package_page .= "</div> <!-- end pdeps -->\n";
+ }
+
+ #
+ # Download package
+ #
+ my $encodedpack = uri_escape( $pkg );
+ $package_page .= "<div id=\"pdownload\">";
+ $package_page .= sprintf( "<h2>".gettext( "Download %s\n" )."</h2>",
+ $pkg ) ;
+ $package_page .= "<table border=\"1\" summary=\"".gettext("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";
+ $package_page .= "<caption class=\"hidecss\">".gettext("Download for all available architectures")."</caption>\n";
+ $package_page .= "<tr>\n";
+ $package_page .= "<th>".gettext("Architecture")."</th><th>".gettext("Files")."</th><th>".gettext( "Package Size")."</th><th>".gettext("Installed Size")."</th></tr>\n";
+ foreach my $a ( @archs ) {
+ $package_page .= "<tr>\n";
+ $package_page .= "<th><a href=\"$ROOT/$suite/$encodedpkg/$a/download";
+ $package_page .= "\">$a</a></th>\n";
+ $package_page .= "<td>";
+ if ( $suite ne "experimental" ) {
+ $package_page .= sprintf( "[<a href=\"%s\">".gettext( "list of files" )."</a>]\n",
+ "$ROOT/$suite/$encodedpkg/$a/filelist", $pkg );
+ } else {
+ $package_page .= gettext( "no current information" );
+ }
+ $package_page .= "</td>\n<td align=right>"; #FIXME: css
+ $package_page .= floor(($sizes_deb->{$a}/102.4)+0.5)/10 . " kB";
+ $package_page .= "</td>\n<td align=right>"; #FIXME: css
+ $package_page .= $sizes_inst->{$a} . " kB";
+ $package_page .= "</td>\n</tr>";
+ }
+ $package_page .= "</table>\n";
+ $package_page .= "</div> <!-- end pdownload -->\n";
+
+ #
+ # more information
+ #
+ $package_page .= pmoreinfo( name => $pkg, data => $page,
+ opts => $opts,
+ env => \%FTP_SITES,
+ bugreports => 1, sourcedownload => 1,
+ changesandcopy => 1, maintainers => 1,
+ search => 1 );
+ } else { # unless $page->is_virtual
+ $short_desc = gettext( "virtual package" );
+
+ $$menu .= simple_menu( [ gettext( "Distribution:" ),
+ gettext( "Overview over this distribution" ),
+ "$ROOT/",
+ $suite ],
+ [ gettext( "Section:" ),
+ gettext( "All packages in this section" ),
+ "$ROOT/$suite/virtual/",
+
+ 'virtual' ], );
+
+ $package_page .= title( sprintf( gettext( "Virtual Package: %s" ),
+ $pkg ) );
+
+ my $policy_url = 'http://www.debian.org/doc/debian-policy/';
+ note( sprintf( gettext( "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>." ),
+ $policy_url, $policy_url ));
+
+ $package_page .= sprintf( "<h2>".gettext( "Packages providing %s" )."</h2>", $pkg );
+ my $provided_by = $page->{provided_by};
+ $package_page .= pkg_list( \%packages, $opts, $provided_by, 'en');
+
+ } # else (unless $page->is_virtual)
+ } else { # unless $opts->{source}
+ for my $entry (@results) {
+ debug( join(":", @$entry), 1 );
+ my (undef, $archive, undef, $section, $subsection,
+ $priority, $version) = @$entry;
+
+ my $data = $sources_all{"$archive $suite $pkg"};
+ $page->merge_data($pkg, $suite, $archive, $data)
+ or debug( "Merging $pkg $version FAILED", 2 );
+ }
+ $version = $page->{version};
+
+ my $st1 = new Benchmark;
+ my $std = timediff($st1, $st0);
+ debug( "Data search and merging took ".timestr($std) );
+
+ my ($v_str, $v_str_arr) = $page->get_version_string();
+ $archive = $page->get_newest( 'archive' );
+ $section = $page->get_newest( 'section' );
+ $subsection = $page->get_newest( 'subsection' );
+
+ $$menu .= simple_menu( [ gettext( "Distribution:" ),
+ gettext( "Overview over this suite" ),
+ "/$suite/",
+ $suite ],
+ [ gettext( "Section:" ),
+ gettext( "All packages in this section" ),
+ "/$suite/$subsection/",
+ $subsection ],
+ );
+
+ my $title .= sprintf( gettext( "Source Package: %s (%s)" ),
+ $pkg, $v_str );
+ $title .= " ".marker( $archive ) if $archive ne 'us';
+ $title .= " ".marker( $subsection ) if $subsection eq 'non-US'
+ and $archive ne 'non-US'; # non-US/security
+ $title .= " ".marker( $section ) if $section ne 'main';
+ $package_page .= title( $title );
+
+ if ($suite eq "experimental") {
+ note( gettext( "Experimental package"),
+ gettext( "Warning: This package is from the <span class=\"pred\">experimental</span> 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><p>".
+ gettext( "Users of experimental packages are encouraged to contact the package maintainers directly in case of problems." )
+ );
+ }
+ if ($subsection eq "debian-installer") {
+ note( gettext( "debian-installer udeb package"),
+ gettext( "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." )
+ );
+ }
+
+ my $binaries = find_binaries( $pkg, $archive, $suite, \%src2bin );
+ if ($binaries && @$binaries) {
+ $package_page .= '<div class="pdesc">';
+ $package_page .= gettext( "The following binary packages are built from this source package:" );
+ $package_page .= pkg_list( \%packages, $opts, $binaries, 'en' );
+ $package_page .= '</div> <!-- end pdesc -->';
+ }
+
+ #
+ # display dependencies
+ #
+ my $dep_list;
+ $dep_list = print_src_deps( \%packages, $opts, $pkg,
+ $page->get_dep_field('build-depends'),
+ 'build-depends' );
+ $dep_list .= print_src_deps( \%packages, $opts, $pkg,
+ $page->get_dep_field('build-depends-indep'),
+ 'build-depends-indep' );
+
+ if ( $dep_list ) {
+ $package_page .= "<div id=\"pdeps\">\n";
+ $package_page .= sprintf( "<h2>".gettext( "Other Packages Related to %s" )."</h2>\n", $pkg );
+ if ($suite eq "experimental") {
+ note( gettext( "Note that the \"<span class=\"pred\">experimental</span>\" distribution is not self-contained; missing dependencies are likely found in the \"<a href=\"/unstable/\">unstable</a>\" distribution." ) );
+ }
+
+ $package_page .= pdeplegend( [ 'adep', gettext( 'build-depends' ) ],
+ [ 'idep', gettext( 'build-depends-indep' ) ],
+ );
+
+ $package_page .= $dep_list;
+ $package_page .= "</div> <!-- end pdeps -->\n";
+ }
+
+ #
+ # Source package download
+ #
+ $package_page .= "<div id=\"pdownload\">\n";
+ $package_page .= sprintf( "<h2>".gettext( "Download %s" )."</h2>\n",
+ $pkg ) ;
+
+ my $source_files = $page->get_src( 'files' );
+ my $source_dir = $page->get_src( 'directory' );
+
+ $package_page .= sprintf( "<table cellspacing=\"0\" cellpadding=\"2\" summary=\"Download information for the files of this source package\">\n"
+ ."<tr><th>%s</th><th>%s</th><th>%s</th>",
+ gettext("File"),
+ gettext("Size (in kB)"),
+ gettext("md5sum") );
+ foreach( @$source_files ) {
+ my ($src_file_md5, $src_file_size, $src_file_name)
+ = split /\s+/, $_;
+ my $src_url;
+ for ($archive) {
+ /security/o && do {
+ $src_url = $FTP_SITES{security}; last };
+ /volatile/o && do {
+ $src_url = $FTP_SITES{volatile}; last };
+ /backports/o && do {
+ $src_url = $FTP_SITES{backports}; last };
+ /non-us/io && do {
+ $src_url = $FTP_SITES{'non-US'}; last };
+ $src_url = $FTP_SITES{us};
+ }
+ $src_url .= "/$source_dir/$src_file_name";
+
+ $package_page .= "<tr><td><a href=\"$src_url\">$src_file_name</a></td>\n"
+ ."<td class=\"dotalign\">".sprintf("%.1f", (floor(($src_file_size/102.4)+0.5)/10))."</td>\n"
+ ."<td>$src_file_md5</td></tr>";
+ }
+ $package_page .= "</table>\n";
+ $package_page .= "</div> <!-- end pdownload -->\n";
+
+ #
+ # more information
+ #
+ $package_page .= pmoreinfo( name => $pkg, data => $page,
+ opts => $opts,
+ env => \%FTP_SITES,
+ bugreports => 1,
+ changesandcopy => 1, maintainers => 1,
+ search => 1, is_source => 1 );
+
+ } # else (unless $opts->{source})
+ } # else (unless @results)
+ } # else (unless (@results || @non_results ))
+ }
+
+# use Data::Dumper;
+# debug( "Final page object:\n".Dumper($page), 3 );
+
+ my $title = $opts->{source} ?
+ "Details of source package <em>$pkg</em> in $suite" :
+ "Details of package <em>$pkg</em> in $suite" ;
+ my $title_tag = $opts->{source} ?
+ "Details of source package $pkg in $suite" :
+ "Details of package $pkg in $suite" ;
+ %$html_header = ( title => $title ,
+ lang => 'en',
+ desc => $short_desc,
+ keywords => "$suite, $archive, $section, $subsection, $version",
+ title_tag => "Details of package $pkg in $suite",
+ print_search_field => 'packages',
+ search_field_values => {
+ keywords => '',
+ searchon => 'names',
+ arch => 'any',
+ suite => 'all',
+ section => 'all',
+ exact => 0,
+ debug => $opts->{debug},
+ },
+ );
+
+ $$page_content = $package_page;
+}
+
+1;
+
sub pkg_list {
my ( $packages, $opts, $pkgs, $lang ) = @_;
+ my $suite = $opts->{suite}[0];
my $str = "";
foreach my $p ( @$pkgs ) {
- my $short_desc = (read_entry_simple( $packages, $p, $opts->{h_archives}, $opts->{suite}))->[-1];
+ my $short_desc = (read_entry_simple( $packages, $p, $opts->{h_archives}, $suite))->[-1];
if ( $short_desc ) {
- $str .= "<dt><a href=\"$ROOT/$opts->{suite}/$p\">$p</a></dt>\n".
+ $str .= "<dt><a href=\"$ROOT/$suite/$p\">$p</a></dt>\n".
"\t<dd>$short_desc</dd>\n";
} else {
$str .= "<dt>$p</dt>\n\t<dd>".gettext("Not available")."</dd>\n";
my $opts = $info{opts} or return;
my $page = $info{data} or return;
my $is_source = $info{is_source};
+ my $suite = $opts->{suite}[0];
my $str = "<div id=\"pmoreinfo\">";
$str .= sprintf( "<h2>".gettext( "More Information on %s" )."</h2>",
if ($info{sourcedownload}) {
my $files = $page->get_src( 'files' );
my $path = (@{$opts->{archive}} >1) ?
- $opts->{suite} :
- "$opts->{suite}/$opts->{archive}[0]";
+ $suite :
+ "$suite/$opts->{archive}[0]";
$str .= gettext( "Source Package:" );
$str .= " <a href=\"$ROOT/$path/source/$source\">$source</a>, ".
gettext( "Download" ).":\n";
'suggests' => 'sug');
my $res = "<ul class=\"ul$dep_type{$type}\">\n";
my $first = 1;
+ my $suite = $opts->{suite}[0];
# use Data::Dumper;
# debug( "print_deps called:\n".Dumper( $pkg, $relations, \$type ), 3 );
$pkg_version = "($pkg_version)" if $pkg_version;
my @results;
- my %short_descs;
- my $short_desc = $short_descs{$p_name} ||
- (read_entry_simple( $packages, $p_name, $opts->{h_archives}, $opts->{suite}))->[-1];
+ my %entries;
+ my $entry = $entries{$p_name} ||
+ read_entry_simple( $packages, $p_name, $opts->{h_archives}, $suite);
+ my $short_desc = $entry->[-1];
+ my $arch = $entry->[2];
if ( $short_desc ) {
if ( $is_old_pkgs ) {
- push @res_pkgs, dep_item( "$ROOT/$opts->{suite}/$p_name",
+ push @res_pkgs, dep_item( "$ROOT/$suite/$p_name",
$p_name, "$pkg_version$arch_str" );
+ } elsif ($arch eq 'virtual') {
+ $short_desc = "virtual package";
+ push @res_pkgs, dep_item( "$ROOT/$suite/$p_name",
+ $p_name, "$pkg_version$arch_str", $short_desc );
} else {
- $short_descs{$p_name} ||= $short_desc;
+ $entries{$p_name} ||= $entry;
$short_desc = encode_entities( $short_desc, "<>&\"" );
- push @res_pkgs, dep_item( "$ROOT/$opts->{suite}/$p_name",
+ push @res_pkgs, dep_item( "$ROOT/$suite/$p_name",
$p_name, "$pkg_version$arch_str", $short_desc );
}
} elsif ( $is_old_pkgs ) {
sub print_src_deps {
my ( $packages, $opts, $pkg, $relations, $type) = @_;
my %dep_type = ('build-depends' => 'adep', 'build-depends-indep' => 'idep' );
+ my $suite = $opts->{suite}[0];
my $res = "<ul class=\"ul$dep_type{$type}\">\n";
foreach my $dep (@$relations) {
my @res_pkgs;
}
$arch_str = " [${arch_str}@{$or_dep->[3]}]";
}
- my $short_desc = (read_entry_simple( $packages, $p_name, $opts->{h_archives}, $opts->{suite}))->[-1];
+ my $short_desc = (read_entry_simple( $packages, $p_name, $opts->{h_archives}, $suite))->[-1];
if ( $short_desc ) {
$short_desc = encode_entities( $short_desc, "<>&\"" );
- push @res_pkgs, dep_item( "/$opts->{suite}/$p_name", $p_name, "$p_version$arch_str", $short_desc );
+ push @res_pkgs, dep_item( "/$suite/$p_name", $p_name, "$p_version$arch_str", $short_desc );
} else {
$short_desc = gettext( "Package not available" );
push @res_pkgs, dep_item( undef, $p_name, "$p_version$arch_str", $short_desc );
my $page_title = $params{page_title} || $params{title} || '';
my $meta = $params{meta} || '';
- if ($params{print_title_above}) {
- $title_in_header = "<h1>$title_in_header</h1>";
- } else {
- $title_in_header = '';
- }
-
my $search_in_header = '';
$params{print_search_field} ||= "";
if ($params{print_search_field} eq 'packages') {
<div id="hpacketsearch">
<input type="hidden" name="debug" value="$values{debug}">
<input type="hidden" name="suite" value="$values{suite}">
-<input type="hidden" name="subword" value="$values{subword}">
<input type="hidden" name="exact" value="$values{exact}">
<input type="hidden" name="arch" value="$values{arch}">
<input type="hidden" name="section" value="$values{section}">
-<input type="hidden" name="case" value="$values{case}">
<input type="text" size="30" name="keywords" value="$values{keywords}" id="kw">
<input type="submit" value="Search">
<span style="font-size: 60%"><a href="$SEARCH_PAGE#search_packages">Full options</a></span>
NAVBEGIN
;
-# $title_in_header
$txt .= "<p class=\"hidecss\"><a href=\"\#inner\">" . gettext("Skip Site Navigation")."</a></p>\n";
$txt .= "<div id=\"navbar\">\n<ul>".
"<li><a href=\"$HOME/intro/about\">".gettext( "About Debian" )."</a></li>\n".
BEGINCONTENT
;
- if ($params{print_title_above}) {
- $txt .= "<h1>$page_title</h1>\n";
- }
- if ($params{print_title_below}) {
+ if ($params{print_title}) {
$txt .= "<h1>$page_title</h1>\n";
}
sub read_entry_simple {
my ($hash, $key, $archives, $suite) = @_;
my $result = $hash->{$key} || '';
+ debug( "read_entry_simple: key=$key, archives=".
+ join(" ",(keys %$archives)).", suite=$suite", 1);
my @data_fuzzy;
foreach (split /\000/o, $result) {
my @data = split ( /\s/o, $_, 8 );
sub read_src_entry_all {
my ($hash, $key, $results, $non_results, $opts) = @_;
my $result = $hash->{$key} || '';
+ debug( "read_src_entry_all: key=$key", 1);
foreach (split /\000/o, $result) {
my @data = split ( /\s/o, $_, 6 );
debug( "Considering entry ".join( ':', @data), 2);
read_src_entry_all( $hash, $key, $results, \@non_results, $opts );
}
sub do_names_search {
- my ($keyword, $packages, $postfixes, $read_entry, $opts) = @_;
- my @results;
+ my ($keyword, $packages, $postfixes, $read_entry, $opts,
+ $results, $non_results) = @_;
- $keyword = lc $keyword unless $opts->{case_bool};
+ $keyword = lc $keyword;
- if ($opts->{exact}) {
- &$read_entry( $packages, $keyword, \@results, $opts );
- } else {
- my ($key, $prefixes) = ($keyword, '');
- my %pkgs;
- $postfixes->seq( $key, $prefixes, R_CURSOR );
- while (index($key, $keyword) >= 0) {
- if ($prefixes =~ /^\001(\d+)/o) {
- $too_many_hits += $1;
- } else {
- foreach (split /\000/o, $prefixes) {
- $_ = '' if $_ eq '^';
- debug( "add word $_$key", 2);
- $pkgs{$_.$key}++;
- }
+ my ($key, $prefixes) = ($keyword, '');
+ my %pkgs;
+ $postfixes->seq( $key, $prefixes, R_CURSOR );
+ while (index($key, $keyword) >= 0) {
+ if ($prefixes =~ /^\001(\d+)/o) {
+ $too_many_hits += $1;
+ } else {
+ foreach (split /\000/o, $prefixes) {
+ $_ = '' if $_ eq '^';
+ debug( "add word $_$key", 2);
+ $pkgs{$_.$key}++;
}
- last if $postfixes->seq( $key, $prefixes, R_NEXT ) != 0;
- last if $too_many_hits or keys %pkgs >= 100;
- }
-
- my $no_results = keys %pkgs;
- if ($too_many_hits || ($no_results >= 100)) {
- $too_many_hits += $no_results;
- %pkgs = ( $keyword => 1 );
- }
- foreach my $pkg (sort keys %pkgs) {
- &$read_entry( $packages, $pkg, \@results, $opts );
}
+ last if $postfixes->seq( $key, $prefixes, R_NEXT ) != 0;
+ last if $too_many_hits or keys %pkgs >= 100;
+ }
+
+ my $no_results = keys %pkgs;
+ if ($too_many_hits || ($no_results >= 100)) {
+ $too_many_hits += $no_results;
+ %pkgs = ( $keyword => 1 );
+ }
+ foreach my $pkg (sort keys %pkgs) {
+ &$read_entry( $packages, $pkg, $results, $non_results, $opts );
}
- return \@results;
}
sub do_fulltext_search {
- my ($keyword, $file, $did2pkg, $packages, $read_entry, $opts) = @_;
+ my ($keyword, $file, $did2pkg, $packages, $read_entry, $opts,
+ $results, $non_results) = @_;
# NOTE: this needs to correspond with parse-packages!
$keyword =~ tr [A-Z] [a-z];
my $result = $did2pkg->{$.};
foreach (split /\000/o, $result) {
my @data = split /\s/, $_, 3;
- debug ("Considering $data[0], arch = $data[2]", 3);
- next unless $data[2] eq 'all' || $opts->{h_archs}{$data[2]};
- debug ("Ok", 3);
+# debug ("Considering $data[0], arch = $data[2]", 3);
+# next unless $data[2] eq 'all' || $opts->{h_archs}{$data[2]};
+# debug ("Ok", 3);
$numres++ unless $tmp_results{$data[0]}++;
}
last if $numres > 100;
my @results;
foreach my $pkg (keys %tmp_results) {
- &$read_entry( $packages, $pkg, \@results, $opts );
+ &$read_entry( $packages, $pkg, $results, $non_results, $opts );
}
- return \@results;
-}
+ }
sub find_binaries {
my ($pkg, $archive, $suite, $src2bin) = @_;
--- /dev/null
+package Packages::Sections;
+
+use strict;
+use warnings;
+
+use Exporter;
+our @ISA = qw( Exporter );
+our @EXPORT = qw( %sections_descs );
+
+our %sections_descs = (
+ 'admin' => [ "Administration Utilities",
+ "Utilities to administer system resources, manage user accounts, etc." ],
+ 'base' => [ "Base Utilities",
+ "Basic needed utilities of every Debian system." ],
+ 'comm' => [ "Communication Programs",
+ "Software to use your modem in the old fashioned style." ],
+ 'devel' => [ "Development",
+ "Development utilities, compilers, development environments, libraries, etc." ],
+ 'doc' => [ "Documentation",
+ "FAQs, HOWTOs and other documents trying to explain everything related to Debian, and software needed to browse documentation (man, info, etc)." ],
+ 'editors' => [ "Editors",
+ "Software to edit files. Programming environments." ],
+ 'electronics' => [ "Electronics",
+ "Electronics utilities." ],
+ 'embedded' => [ "Embedded software",
+ "Software suitable for use in embedded applications." ],
+ 'games' => [ "Games",
+ "Programs to spend a nice time with after all this setting up." ],
+ 'gnome' => [ "GNOME",
+ "The GNOME desktop environment, a powerful, easy to use set of integrated applications." ],
+ 'graphics' => [ "Graphics",
+ "Editors, viewers, converters... Everything to become an artist." ],
+ 'hamradio' => [ "Ham Radio",
+ "Software for ham radio." ],
+ 'interpreters' => [ "Interpreters",
+ "All kind of interpreters for interpreted languages. Macro processors." ],
+ 'kde' => [ "KDE",
+ "The K Desktop Environment, a powerful, easy to use set of integrated applications." ],
+ 'libs' => [ "Libraries",
+ "Libraries to make other programs work. They provide special features to developers." ],
+ 'libdevel' => [ "Library development",
+ "Libraries necessary for developers to write programs that use them." ],
+ 'mail' => [ "Mail",
+ "Programs to route, read, and compose E-mail messages." ],
+ 'math' => [ "Mathematics",
+ "Math software." ],
+ 'misc' => [ "Miscellaneous",
+ "Miscellaneous utilities that didn\'t fit well anywhere else." ],
+ 'net' => [ "Network",
+ "Daemons and clients to connect your Debian GNU/Linux system to the world." ],
+ 'news' => [ "Newsgroups",
+ "Software to access Usenet, to set up news servers, etc." ],
+ 'non-US' => [ "Software restricted in the U.S.",
+ "These packages probably may not be used in or distributed from the U.S. due to software patents. You should check the regulations in your country before using this software." ],
+ 'oldlibs' => [ "Old Libraries",
+ "Old versions of libraries, kept for backward compatibility with old applications." ],
+ 'otherosfs' => [ "Other OS\'s and file systems",
+ "Software to run programs compiled for other operating system, and to use their filesystems." ],
+ 'perl' => [ "Perl",
+ "Everything about Perl, an interpreted scripting language." ],
+ 'python' => [ "Python",
+ "Everything about Python, an interpreted, interactive object oriented language." ],
+ 'science' => [ "Science",
+ "Basic tools for scientific work" ],
+ 'shells' => [ "Shells",
+ "Command shells. Friendly user interfaces for beginners." ],
+ 'sound' => [ "Sound",
+ "Utilities to deal with sound: mixers, players, recorders, CD players, etc." ],
+ 'tex' => [ "TeX",
+ "The famous typesetting software and related programs." ],
+ 'text' => [ "Text Processing",
+ "Utilities to format and print text documents." ],
+ 'utils' => [ "Utilities",
+ "Utilities for file/disk manipulation, backup and archive tools, system monitoring, input systems, etc." ],
+ 'virtual' => [ "Virtual packages",
+ "Virtual packages." ],
+ 'web' => [ "Web Software",
+ "Web servers, browsers, proxies, download tools etc." ],
+ 'x11' => [ "X Window System software",
+ "X servers, libraries, fonts, window managers, terminal emulators and many related applications." ],
+ 'debian-installer' => [ "debian-installer udeb packages",
+ "Special packages for building customized debian-installer variants. Do not install them on a normal system!" ],
+ );
+
+
+
+1;
projects / deb / packages.git / commitdiff