# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
use strict;
+use lib './lib';
my $what = $ARGV[0] ? "non-free" : "*";
# max. distinct results for a given package postfix
my $MAX_PACKAGE_POSTFIXES = 100;
use DB_File;
+use Packages::Config qw( $TOPDIR $DBDIR @ARCHIVES @SUITES );
+&Packages::Config::init( './' );
my %packages_small = ();
my %package_names = ();
my %package_postfixes = ();
my %packages_descriptions = ();
my %descriptions_packages = ();
-my @archives = ( 'us', 'non-US', 'security', 'volatile', 'backports' );
-my @suites = ('oldstable', 'stable', 'testing', 'unstable', 'experimental');
-
$/ = "";
-for my $archive (@archives) {
- for my $suite (@suites) {
+for my $archive (@ARCHIVES) {
+ for my $suite (@SUITES) {
print "Reading $archive/$suite...\n";
my %packages_all_db;
- tie %packages_all_db, "DB_File", "packages_all_$suite.db.new",
+ tie %packages_all_db, "DB_File", "$DBDIR/packages_all_$suite.db.new",
O_RDWR|O_CREAT, 0666, $DB_BTREE
or die "Error creating DB: $!";
- open PKG, "zcat /org/packages.debian.org/archive/$archive/$suite/$what/{,debian-installer/}binary-*/Packages.gz|";
+ open PKG, "zcat $TOPDIR/archive/$archive/$suite/$what/{,debian-installer/}binary-*/Packages.gz|";
while (<PKG>) {
next if /^\s*$/;
my $data = "";
print "Writing databases...\n";
my %packages_small_db;
-tie %packages_small_db, "DB_File", "packages_small.db.new",
+tie %packages_small_db, "DB_File", "$DBDIR/packages_small.db.new",
O_RDWR|O_CREAT, 0666, $DB_BTREE
or die "Error creating DB: $!";
while (my ($k, $v) = each(%packages_small)) {
untie %packages_small_db;
my %sources_packages_db;
-tie %sources_packages_db, "DB_File", "sources_packages.db.new",
+tie %sources_packages_db, "DB_File", "$DBDIR/sources_packages.db.new",
O_RDWR|O_CREAT, 0666, $DB_BTREE
or die "Error creating DB: $!";
while (my ($k, $v) = each(%sources_packages)) {
untie %sources_packages_db;
my %packages_descriptions_db;
-tie %packages_descriptions_db, "DB_File", "packages_descriptions.db.new",
+tie %packages_descriptions_db, "DB_File", "$DBDIR/packages_descriptions.db.new",
O_RDWR|O_CREAT, 0666, $DB_BTREE
or die "Error creating DB: $!";
while (my ($k, $v) = each(%packages_descriptions)) {
untie %packages_descriptions_db;
my %descriptions_packages_db;
-tie %descriptions_packages_db, "DB_File", "descriptions_packages.db.new",
+tie %descriptions_packages_db, "DB_File", "$DBDIR/descriptions_packages.db.new",
O_RDWR|O_CREAT, 0666, $DB_BTREE
or die "Error creating DB: $!";
while (my ($k, $v) = each(%descriptions_packages)) {
untie %descriptions_packages_db;
my %descriptions_db;
-tie %descriptions_db, "DB_File", "descriptions.db.new",
+tie %descriptions_db, "DB_File", "$DBDIR/descriptions.db.new",
O_RDWR|O_CREAT, 0666, $DB_BTREE
or die "Error creating DB: $!";
-open DESCR, "> descriptions.txt" or die "Error creating descriptions textfile";
+open DESCR, ">", "$DBDIR/descriptions.txt" or die "Error creating descriptions textfile";
for (my $i=1; $i<= $#descriptions; $i++) {
my $plain_description = $descriptions[$i];
$plain_description =~ s/\n .\n/ /og;
}
}
my %package_postfixes_db;
-tie %package_postfixes_db, "DB_File", "package_postfixes.db.new",
+tie %package_postfixes_db, "DB_File", "$DBDIR/package_postfixes.db.new",
O_RDWR|O_CREAT, 0666, $DB_BTREE
or die "Error creating DB: $!";
while (my ($k, $v) = each(%package_postfixes)) {
}
untie %package_postfixes_db;
-rename("packages_small.db.new", "packages_small.db");
-rename("sources_packages.db.new", "sources_packages.db");
-for my $suite (@suites) {
- rename("packages_all_$suite.db.new", "packages_all_$suite.db");
+rename("$DBDIR/packages_small.db.new", "$DBDIR/packages_small.db");
+rename("$DBDIR/sources_packages.db.new", "$DBDIR/sources_packages.db");
+for my $suite (@SUITES) {
+ rename("$DBDIR/packages_all_$suite.db.new",
+ "$DBDIR/packages_all_$suite.db");
}
-rename("packages_descriptions.db.new", "packages_descriptions.db");
-rename("descriptions_packages.db.new", "descriptions_packages.db");
-rename("descriptions.txt.new", "descriptions.txt");
-rename("descriptions.db.new", "descriptions.db");
-rename("package_postfixes.db.new", "package_postfixes.db");
+rename("$DBDIR/packages_descriptions.db.new",
+ "$DBDIR/packages_descriptions.db");
+rename("$DBDIR/descriptions_packages.db.new",
+ "$DBDIR/descriptions_packages.db");
+rename("$DBDIR/descriptions.txt.new", "$DBDIR/descriptions.txt");
+rename("$DBDIR/descriptions.db.new", "$DBDIR/descriptions.db");
+rename("$DBDIR/package_postfixes.db.new", "$DBDIR/package_postfixes.db");
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
use strict;
+use lib './lib';
my $what = $ARGV[0] ? "non-free" : "*";
# max. distinct results for a given package postfix
my $MAX_SOURCE_POSTFIXES = 100;
use DB_File;
+use Packages::Config qw( $TOPDIR $DBDIR @ARCHIVES @SUITES );
+&Packages::Config::init( './' );
my %sources_small = ();
my %source_names = ();
my %source_postfixes = ();
-my @archives = ( 'us', 'non-US', 'security', 'volatile', 'backports' );
-my @suites = ('oldstable', 'stable', 'testing', 'unstable', 'experimental');
-
$/ = "";
-for my $archive (@archives) {
- for my $suite (@suites) {
+for my $archive (@ARCHIVES) {
+ for my $suite (@SUITES) {
print "Reading $archive/$suite...\n";
my %sources_all_db;
- tie %sources_all_db, "DB_File", "sources_all_$suite.db.new",
+ tie %sources_all_db, "DB_File", "$DBDIR/sources_all_$suite.db.new",
O_RDWR|O_CREAT, 0666, $DB_BTREE
or die "Error creating DB: $!";
- open PKG, "zcat /org/packages.debian.org/archive/$archive/$suite/$what/source/Sources.gz|";
+ open PKG, "zcat $TOPDIR/archive/$archive/$suite/$what/source/Sources.gz|";
while (<PKG>) {
next if /^\s*$/;
my $data = "";
print "Writing databases...\n";
my %sources_small_db;
-tie %sources_small_db, "DB_File", "sources_small.db.new",
+tie %sources_small_db, "DB_File", "$DBDIR/sources_small.db.new",
O_RDWR|O_CREAT, 0666, $DB_BTREE
or die "Error creating DB: $!";
while (my ($k, $v) = each(%sources_small)) {
}
}
my %source_postfixes_db;
-tie %source_postfixes_db, "DB_File", "source_postfixes.db.new",
+tie %source_postfixes_db, "DB_File", "$DBDIR/source_postfixes.db.new",
O_RDWR|O_CREAT, 0666, $DB_BTREE
or die "Error creating DB: $!";
while (my ($k, $v) = each(%source_postfixes)) {
}
untie %source_postfixes_db;
-for my $suite (@suites) {
- rename("sources_all_$suite.db.new", "sources_all_$suite.db");
+for my $suite (@SUITES) {
+ rename("$DBDIR/sources_all_$suite.db.new", "$DBDIR/sources_all_$suite.db");
}
-rename("sources_small.db.new", "sources_small.db");
-rename("source_postfixes.db.new", "source_postfixes.db");
+rename("$DBDIR/sources_small.db.new", "$DBDIR/sources_small.db");
+rename("$DBDIR/source_postfixes.db.new", "$DBDIR/source_postfixes.db");
use Benchmark;
use Deb::Versions;
+use Packages::Config qw( $DBDIR $ROOT $SEARCH_CGI $SEARCH_PAGE
+ @SUITES @SECTIONS @ARCHIVES @ARCHITECTURES );
use Packages::CGI;
use Packages::Search qw( :all );
use Packages::HTML ();
$Packages::CGI::debug = $debug;
# read the configuration
-our $config_read_time ||= 0;
our $db_read_time ||= 0;
-our ( $topdir, $ROOT, @SUITES, @SECTIONS, @ARCHIVES, @ARCHITECTURES );
-# FIXME: move to own module
-my $modtime = (stat( "../config.sh" ))[9];
-if ($modtime > $config_read_time) {
- if (!open (C, '<', "../config.sh")) {
- error( "Internal: Cannot open configuration file." );
- }
- while (<C>) {
- next if /^\s*\#/o;
- chomp;
- $topdir = $1 if /^\s*topdir="?([^\"]*)"?\s*$/o;
- $ROOT = $1 if /^\s*root="?([^\"]*)"?\s*$/o;
- $Packages::HTML::HOME = $1 if /^\s*home="?([^\"]*)"?\s*$/o;
- $Packages::HTML::SEARCH_CGI = $1 if /^\s*searchcgi="?([^\"]*)"?\s*$/o;
- $Packages::HTML::SEARCH_PAGE = $1 if /^\s*searchpage="?([^\"]*)"?\s*$/o;
- $Packages::HTML::WEBMASTER_MAIL = $1 if /^\s*webmaster="?([^\"]*)"?\s*$/o;
- $Packages::HTML::CONTACT_MAIL = $1 if /^\s*contact="?([^\"]*)"?\s*$/o;
- @SUITES = split(/\s+/, $1) if /^\s*suites="?([^\"]*)"?\s*$/o;
- @SECTIONS = split(/\s+/, $1) if /^\s*sections="?([^\"]*)"?\s*$/o;
- @ARCHIVES = split(/\s+/, $1) if /^\s*archives="?([^\"]*)"?\s*$/o;
- @ARCHITECTURES = split(/\s+/, $1) if /^\s*architectures="?([^\"]*)"?\s*$/o;
- }
- close (C);
- debug( "read config ($modtime > $config_read_time)" );
- $config_read_time = $modtime;
-}
-my $DBDIR = $topdir . "/files/db";
-my $thisscript = $Packages::HTML::SEARCH_CGI;
+&Packages::Config::init( '../' );
if (my $path = $input->param('path')) {
my @components = map { lc $_ } split /\//, $path;
$input->param('archive', $_);
} elsif ($ARCHITECTURES{$_}) {
$input->param('arch', $_);
+ } elsif ($_ eq 'source') {
+ $input->param('searchon','sourcenames');
}
}
}
if ($exact) {
$printed++;
- hint( "You have searched only for exact matches of the package name. You can try to search for <a href=\"$thisscript?exact=0&searchon=$searchon&suite=$suites_param&case=$case&section=$sections_param&keywords=$keyword_esc&arch=$archs_param\">package names that contain your search string</a>." );
+ hint( "You have searched only for exact matches of the package name. You can try to search for <a href=\"$SEARCH_CGI?exact=0&searchon=$searchon&suite=$suites_param&case=$case&section=$sections_param&keywords=$keyword_esc&arch=$archs_param\">package names that contain your search string</a>." );
}
} else {
if (($suites_enc eq 'all')
unless ($subword) {
$printed++;
- hint( "You have searched only for words exactly matching your keywords. You can try to search <a href=\"$thisscript?subword=1&searchon=$searchon&suite=$suites_param&case=$case&section=$sections_param&keywords=$keyword_esc&arch=$archs_param\">allowing subword matching</a>." );
+ hint( "You have searched only for words exactly matching your keywords. You can try to search <a href=\"$SEARCH_CGI?subword=1&searchon=$searchon&suite=$suites_param&case=$case&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=\"$Packages::HTML::SEARCH_PAGE#search_packages\">Packages search page</a>." );
+ hint( ( $printed ? "Or you" : "You" )." can try a different search on the <a href=\"$SEARCH_PAGE#search_packages\">Packages search page</a>." );
}
}
use Benchmark;
use Deb::Versions;
+use Packages::Config qw( $DBDIR $ROOT @SUITES @ARCHIVES @SECTIONS
+ @ARCHITECTURES %FTP_SITES );
use Packages::CGI;
use Packages::Search qw( :all );
use Packages::HTML;
$Packages::CGI::debug = $debug;
# read the configuration
-our $config_read_time ||= 0;
our $db_read_time ||= 0;
-our ( $topdir, $ROOT, @SUITES, @SECTIONS, @ARCHIVES, @ARCHITECTURES,
- %FTP_SITES );
-
-# FIXME: move to own module
-my $modtime = (stat( "../config.sh" ))[9];
-if ($modtime > $config_read_time) {
- if (!open (C, '<', "../config.sh")) {
- error( "Internal: Cannot open configuration file." );
- }
- while (<C>) {
- next if /^\s*\#/o;
- chomp;
- $topdir = $1 if /^\s*topdir="?([^\"]*)"?\s*$/o;
- $ROOT = $1 if /^\s*root="?([^\"]*)"?\s*$/o;
- $Packages::HTML::HOME = $1 if /^\s*home="?([^\"]*)"?\s*$/o;
- $Packages::HTML::SEARCH_CGI = $1 if /^\s*searchcgi="?([^\"]*)"?\s*$/o;
- $Packages::HTML::SEARCH_PAGE = $1 if /^\s*searchpage="?([^\"]*)"?\s*$/o;
- $Packages::HTML::WEBMASTER_MAIL = $1 if /^\s*webmaster="?([^\"]*)"?\s*$/o;
- $Packages::HTML::CONTACT_MAIL = $1 if /^\s*contact="?([^\"]*)"?\s*$/o;
- $Packages::HTML::BUG_URL = $1 if /^\s*bug_url="?([^\"]*)"?\s*$/o;
- $Packages::HTML::SRC_BUG_URL = $1 if /^\s*src_bug_url="?([^\"]*)"?\s*$/o;
- $Packages::HTML::QA_URL = $1 if /^\s*qa_url="?([^\"]*)"?\s*$/o;
- $FTP_SITES{us} = $1 if /^\s*ftpsite="?([^\"]*)"?\s*$/o;
- $FTP_SITES{$1} = $2 if /^\s*(\w+)_ftpsite="?([^\"]*)"?\s*$/o;
- @SUITES = split(/\s+/, $1) if /^\s*suites="?([^\"]*)"?\s*$/o;
- @SECTIONS = split(/\s+/, $1) if /^\s*sections="?([^\"]*)"?\s*$/o;
- @ARCHIVES = split(/\s+/, $1) if /^\s*archives="?([^\"]*)"?\s*$/o;
- @ARCHITECTURES = split(/\s+/, $1) if /^\s*architectures="?([^\"]*)"?\s*$/o;
- }
- close (C);
- debug( "read config ($modtime > $config_read_time)" );
- $config_read_time = $modtime;
-}
-my $DBDIR = $topdir . "/files/db";
-my $thisscript = $Packages::HTML::SEARCH_CGI;
+
+&Packages::Config::init( '../' );
if (my $path = $input->param('path')) {
my @components = map { lc $_ } split /\//, $path;
}
}
-my ( $pkg, $suite, $format );
+my ( $pkg, $suite, @sections, @archs, @archives, $format );
my %params_def = ( package => { default => undef, match => '^([a-z0-9.+-]+)$',
var => \$pkg },
suite => { default => undef, match => '^(\w+)$',
var => \$suite },
+ archive => { default => 'all', match => '^(\w+)$',
+ array => ',', var => \@archives,
+ replace => { all => [qw(us security)] } },
+ section => { default => 'all', match => '^(\w+)$',
+ array => ',', var => \@sections,
+ replace => { all => \@SECTIONS } },
+ arch => { default => 'any', match => '^(\w+)$',
+ array => ',', var => \@archs,
+ replace => { any => \@ARCHITECTURES } },
format => { default => 'html', match => '^(\w+)$',
var => \$format }
);
my %opts;
my %params = Packages::Search::parse_params( $input, \%params_def, \%opts );
-$opts{h_suites} = { $suite => 1 };
-$opts{h_archs} = { map { $_ => 1 } @ARCHITECTURES };
-$opts{h_sections} = { map { $_ => 1 } @SECTIONS };
-$opts{h_archives} = { map { $_ => 1 } @ARCHIVES };
-
#XXX: Don't use alternative output formats yet
$format = 'html';
if ($format eq 'html') {
if ($params{errors}{package}) {
fatal_error( "package not valid or not specified" );
+ $pkg = '';
}
if ($params{errors}{suite}) {
fatal_error( "suite not valid or not specified" );
+ $suite = '';
}
+$opts{h_suites} = { $suite => 1 };
+$opts{h_archs} = { map { $_ => 1 } @archs };
+$opts{h_sections} = { map { $_ => 1 } @sections };
+$opts{h_archives} = { map { $_ => 1 } @archives };;
+
my $DL_URL = "$pkg/download";
my $FILELIST_URL = "$pkg/files";
-my $DDPO_URL = "http://qa.debian.org/developer.php?email=";
our (%packages, %packages_all, %sources_all, %descriptions);
my (@results, @non_results);
my $st0 = new Benchmark;
unless (@Packages::CGI::fatal_errors) {
my $dbmodtime = (stat("$DBDIR/packages_small.db"))[9];
+ 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: $!";
if ($dbmodtime > $db_read_time) {
tie %packages, 'DB_File', "$DBDIR/packages_small.db",
O_RDONLY, 0666, $DB_BTREE
or die "couldn't tie DB $DBDIR/packages_small.db: $!";
- 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: $!";
tie %descriptions, 'DB_File', "$DBDIR/descriptions.db",
O_RDONLY, 0666, $DB_BTREE
or die "couldn't tie DB $DBDIR/descriptions.db: $!";
# $long_desc = conv_desc( $lang, $long_desc );
# $short_desc = conv_desc( $lang, $short_desc );
- my %all_suites = map { $_->[2] => 1 } (@results, @non_results);
+ my %all_suites;
+ foreach (@results, @non_results) {
+ my $a = $_->[1];
+ my $s = $_->[2];
+ if ($a =~ /^(?:us|security)$/o) {
+ $all_suites{$s}++;
+ } else {
+ $all_suites{"$s/$a"}++;
+ }
+ }
foreach (suites_sort(keys %all_suites)) {
- if ($suite eq $_) {
+ if (("$suite/$archive" eq $_)
+ || (!$all_suites{"$suite/$archive"} && ($suite eq $_))) {
$package_page .= "[ <strong>$_</strong> ] ";
} else {
$package_page .=
- "[ <a href=\"../$_/".uri_escape($pkg)."\">$_</a> ] ";
+ "[ <a href=\"$ROOT/$_/".uri_escape($pkg)."\">$_</a> ] ";
}
}
+ $package_page .= '<br>';
$package_page .= simple_menu( [ gettext( "Distribution:" ),
gettext( "Overview over this suite" ),
# more information
#
$package_page .= pmoreinfo( name => $pkg, data => $page,
+ opts => \%opts,
env => \%FTP_SITES,
bugreports => 1, sourcedownload => 1,
changesandcopy => 1, maintainers => 1,
ScriptAlias /cgi-old /org/packages.debian.net/cgi-bin/
RewriteEngine on
+ RewriteLog /var/log/apache/rewrite.log
+ RewriteLogLevel 0
# we never want to rewrite those URLs
RewriteRule ^/cgi-(bin|old)/ - [L]
RewriteCond %{SCRIPT_FILENAME} "!-f"
RewriteCond %{SCRIPT_FILENAME} "!-d"
- RewriteRule ^/([^/]+)$ http://packages.debian.net/cgi-bin/search_packages.pl?searchon=names&version=all&exact=1&keywords=$1 [R,L,NE]
+ RewriteRule ^/([^/]+)$ /cgi-bin/search_packages.pl?searchon=names&version=all&exact=1&keywords=$1 [PT]
RewriteCond %{SCRIPT_FILENAME} "!-f"
RewriteCond %{SCRIPT_FILENAME} "!-d"
- RewriteRule ^/(.+)/([^/]+)$ /cgi-bin/search_packages.pl?searchon=names&version=all&exact=1&keywords=$2&path=$1 [PT]
+ RewriteRule ^/search/([^/]+)$ /cgi-bin/search_packages.pl?searchon=names&version=all&exact=1&keywords=$1 [PT]
+
+ RewriteCond %{SCRIPT_FILENAME} "!-f"
+ RewriteCond %{SCRIPT_FILENAME} "!-d"
+ RewriteRule ^/search/(.+)/([^/]+)$ /cgi-bin/search_packages.pl?searchon=names&version=all&exact=1&keywords=$2&path=$1 [PT]
+
+ RewriteCond %{SCRIPT_FILENAME} "!-f"
+ RewriteCond %{SCRIPT_FILENAME} "!-d"
+ RewriteRule ^/(.+)/([^/]+)$ /cgi-bin/show_package.pl?searchon=names&version=all&exact=1&package=$2&path=$1 [PT]
# In case we need to disable the site again
kfreebsd_ftpsite=http://kfreebsd-gnu.debian.net/debian
root=""
-searchpage="http://packages.debian.net/"
-searchcgi="/cgi-bin/search_packages.pl"
+search_page="http://packages.debian.net/"
+search_cgi="/cgi-bin/search_packages.pl"
+search_url="/search/"
+search_src_url="/search/source/"
webmaster=webmaster@debian.org
contact=debian-www@lists.debian.org
home="http://www.debian.org"
bug_url="http://bugs.debian.org/"
src_bug_url="http://bugs.debian.org/src:"
qa_url="http://packages.qa.debian.org/"
+ddpo_url="http://qa.debian.org/developer.php?email="
# Architectures
#
use strict;
use Exporter;
+use Carp qw(cluck);
our @ISA = qw( Exporter );
our @EXPORT = qw( version_cmp version_sort suites_cmp suites_sort );
( $e1, $u1, $d1 ) = ( $1, $2, $3 );
$e1 ||= 0;
} else {
- warn "This seems not to be a valid version number:"
+ cluck "This seems not to be a valid version number:"
. "<$ver1>\n";
return -1;
}
( $e2, $u2, $d2 ) = ( $1, $2, $3 );
$e2 ||= 0;
} else {
- warn "This seems not to be a valid version number:"
+ cluck "This seems not to be a valid version number:"
. "<$ver2>\n";
return 1;
}
etch testing testing-proposed-updates sid unstable
experimental warty hoary hoary-backports breezy
breezy-backports dapper );
-my $i = 100;
-our %suites_sort = map { $_ => $i-- } @SUITES_SORT;
+our @ARCHIVE_SORT = qw( security updates volatile backports );
+my $i = 1000;
+our %suites_sort = map { $_ => ($i-=10) } @SUITES_SORT;
+$i = 0;
+our %archive_sort = map { $_ => $i++ } @ARCHIVE_SORT;
sub suites_cmp {
- return ($suites_sort{$_[0]} <=> $suites_sort{$_[1]});
+ my ($s_a, $s_b) = @_;
+ my $cmp_a = $suites_sort{$s_a};
+ unless ($cmp_a) {
+ $cmp_a = $suites_sort{$1} - $archive_sort{$2}
+ if $s_a =~ m;^(.+?)[/-](.*)$;o;
+ }
+ my $cmp_b = $suites_sort{$s_b};
+ unless ($cmp_b) {
+ $cmp_b = $suites_sort{$1} - $archive_sort{$2}
+ if $s_b =~ m;^(.+?)[/-](.*)$;o;
+ }
+ return ($cmp_a <=> $cmp_b);
}
sub suites_sort {
--- /dev/null
+package Packages::Config;
+
+use strict;
+use warnings;
+
+use Exporter;
+use Packages::CGI;
+
+our @ISA = qw( Exporter );
+
+our ( $TOPDIR, $DBDIR, $ROOT, $HOME, $CONTACT_MAIL, $WEBMASTER_MAIL,
+ $SEARCH_PAGE, $SEARCH_CGI, $SEARCH_URL,
+ $SRC_SEARCH_URL, $CONTENTS_SEARCH_CGI,
+ $CN_HELP_URL, $BUG_URL, $SRC_BUG_URL, $QA_URL, $DDPO_URL,
+ @SUITES, @SECTIONS, @ARCHIVES, @ARCHITECTURES,
+ %FTP_SITES );
+our @EXPORT_OK = qw( $TOPDIR $DBDIR $ROOT $HOME $CONTACT_MAIL
+ $WEBMASTER_MAIL
+ $SEARCH_PAGE $SEARCH_CGI $SEARCH_URL
+ $SRC_SEARCH_URL $CONTENTS_SEARCH_CGI
+ $CN_HELP_URL $BUG_URL $SRC_BUG_URL $QA_URL $DDPO_URL
+ @SUITES @SECTIONS @ARCHIVES @ARCHITECTURES
+ %FTP_SITES );
+our %EXPORT_TAGS = ( all => [ @EXPORT_OK ] );
+
+our $config_read_time;
+
+sub init {
+ my ($dir) = @_;
+ my $modtime = (stat( "$dir/config.sh" ))[9];
+ $config_read_time ||= 0;
+ if ($modtime > $config_read_time) {
+ if (!open (C, '<', "$dir/config.sh")) {
+ error( "Internal: Cannot open configuration file." );
+ }
+ while (<C>) {
+ next if /^\s*\#/o;
+ chomp;
+ $TOPDIR = $1 if /^\s*topdir="?([^\"]*)"?\s*$/o;
+ $ROOT = $1 if /^\s*root="?([^\"]*)"?\s*$/o;
+ $HOME = $1 if /^\s*home="?([^\"]*)"?\s*$/o;
+ $SEARCH_CGI = $1 if /^\s*search_cgi="?([^\"]*)"?\s*$/o;
+ $SEARCH_PAGE = $1 if /^\s*search_page="?([^\"]*)"?\s*$/o;
+ $SEARCH_URL = $1 if /^\s*search_url="?([^\"]*)"?\s*$/o;
+ $SRC_SEARCH_URL = $1 if /^\s*search_src_url="?([^\"]*)"?\s*$/o;
+ $WEBMASTER_MAIL = $1 if /^\s*webmaster="?([^\"]*)"?\s*$/o;
+ $CONTACT_MAIL = $1 if /^\s*contact="?([^\"]*)"?\s*$/o;
+ $BUG_URL = $1 if /^\s*bug_url="?([^\"]*)"?\s*$/o;
+ $SRC_BUG_URL = $1 if /^\s*src_bug_url="?([^\"]*)"?\s*$/o;
+ $QA_URL = $1 if /^\s*qa_url="?([^\"]*)"?\s*$/o;
+ $DDPO_URL = $1 if /^\s*ddpo_url="?([^\"]*)"?\s*$/o;
+ $FTP_SITES{us} = $1 if /^\s*ftpsite="?([^\"]*)"?\s*$/o;
+ $FTP_SITES{$1} = $2 if /^\s*(\w+)_ftpsite="?([^\"]*)"?\s*$/o;
+ @SUITES = split(/\s+/, $1) if /^\s*suites="?([^\"]*)"?\s*$/o;
+ @SECTIONS = split(/\s+/, $1) if /^\s*sections="?([^\"]*)"?\s*$/o;
+ @ARCHIVES = split(/\s+/, $1) if /^\s*archives="?([^\"]*)"?\s*$/o;
+ @ARCHITECTURES = split(/\s+/, $1) if /^\s*architectures="?([^\"]*)"?\s*$/o;
+ }
+ close (C);
+ debug( "read config ($modtime > $config_read_time)" );
+ $config_read_time = $modtime;
+ }
+ $DBDIR = "$TOPDIR/files/db";
+}
+
+1;
use Packages::CGI;
use Packages::Search qw( read_entry_simple );
+use Packages::Config qw( :all );
#use Packages::Util;
#use Packages::I18N::Locale;
ds_begin ds_item ds_end note title marker pdesc
pdeplegend pkg_list pmoreinfo print_deps );
-our ( $HOME, $ROOT, $CONTACT_MAIL, $WEBMASTER_MAIL,
- $SEARCH_PAGE, $SEARCH_CGI, $SEARCH_URL,
- $SRC_SEARCH_URL, $CONTENTS_SEARCH_CGI,
- $CN_HELP_URL, $BUG_URL, $SRC_BUG_URL, $QA_URL );
our $CHANGELOG_URL = '/changelogs';
sub img {
my $name = $info{name} or return;
my $env = $info{env} or return;
+ my $opts = $info{opts} or return;
my $page = $info{data} or return;
my $is_source = $info{is_source};
my $src_dir = $page->get_src('directory');
if ($info{sourcedownload}) {
my $files = $page->get_src( 'files' );
+ my $path = (@{$opts->{archive}} >1) ?
+ $opts->{suite} :
+ "$opts->{suite}/$opts->{archive}[0]";
$str .= gettext( "Source Package:" );
- $str .= " <a href=\"../source/$source\">$source</a>, ".
+ $str .= " <a href=\"/$path/source/$source\">$source</a>, ".
gettext( "Download" ).":\n";
unless (@$files) {
my @results;
my %short_descs;
my $short_desc = $short_descs{$p_name} ||
- (read_entry_simple( $packages, $p_name, $opts->{suite}))->[-1];
+ (read_entry_simple( $packages, $p_name, $opts->{h_archives}, $opts->{suite}))->[-1];
if ( $short_desc ) {
if ( $is_old_pkgs ) {
push @res_pkgs, dep_item( "/$opts->{suite}/$p_name",
my ($self, $pkg, $version, $architecture, $data) = @_;
my %data = ( package => $pkg,
- version => $version,
- architecture => $architecture );
+ version => $version,
+ architecture => $architecture );
chomp($data);
while ($data =~ /^(\S+):\s*(.*)\s*$/mg) {
my ($key, $value) = ($1, $2);
chomp($data);
my %data = ();
- while ($data =~ /^(\S+):\s*(.*)\s*$/mg) {
+ $data =~ s/\n\s+/\377/g;
+ while ($data =~ /^(\S+):\s*(.*)\s*$/mog) {
my ($key, $value) = ($1, $2);
$key =~ tr [A-Z] [a-z];
$data{$key} = $value;
$self->{src}{name} = $src;
$self->{src}{version} = $version;
if ($data{files}) {
- $data{files} =~ s/\A\s*//o; # remove leading spaces
$self->{src}{files} = [];
- foreach my $sf ( split( /\n\s*/, $data{files} ) ) {
+ foreach my $sf ( split( /\377/, $data{files} ) ) {
+ next unless $sf;
# md5, size, name
push @{$self->{src}{files}}, [ split( /\s+/, $sf) ];
}
if (!$self->{versions}{$data->{architecture}}
|| $is_newest
|| (version_cmp( $data->{version},
- $self->{versions}{$data->{architecture}} ) > 0)) {
+ $self->{versions}{$data->{architecture}}{version} ) > 0)) {
foreach my $key (@STORE_ALL) {
$self->{versions}{$data->{architecture}}{$key}
= $data->{$key};
read_entry_all( $hash, $key, $results, \@non_results, $opts );
}
sub read_entry_simple {
- my ($hash, $key, $suite) = @_;
+ my ($hash, $key, $archives, $suite) = @_;
my $result = $hash->{$key} || '';
+ my @data_fuzzy;
foreach (split /\000/o, $result) {
my @data = split ( /\s/o, $_, 8 );
debug( "Considering entry ".join( ':', @data), 2);
if ($data[1] eq $suite) {
- debug( "Using entry ".join( ':', @data), 2);
- return \@data;
- }
+ if ($archives->{$data[0]}) {
+ debug( "Using entry ".join( ':', @data), 2);
+ return \@data;
+ } elsif ($data[0] eq 'us') {
+ debug( "Fuzzy entry ".join( ':', @data), 2);
+ @data_fuzzy = @data;
+ }
+ }
}
+ return \@data_fuzzy;
}
sub read_src_entry {
my ($hash, $key, $results, $opts) = @_;
projects / deb / packages.git / commitdiff