From: Frank Lichtenheld Date: Sun, 5 Feb 2006 16:59:48 +0000 (+0000) Subject: * Move coniguratio stuf to own module X-Git-Tag: switch-to-templates~170 X-Git-Url: https://git.deb.at/?p=deb%2Fpackages.git;a=commitdiff_plain;h=5ca21f1ba07a6b559395bec8d6bc1e528eb238d1 * Move coniguratio stuf to own module * Overhaul archive handling for show_package * Begin to make the URL handling somewhat consistent * Fix source files handling, which was broken by the last upload --- diff --git a/bin/parse-packages b/bin/parse-packages index 04bee3d..ab5fbce 100755 --- a/bin/parse-packages +++ b/bin/parse-packages @@ -20,12 +20,15 @@ # 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 = (); @@ -35,20 +38,17 @@ my @descriptions = ("we count lines one-based\000"); 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 () { next if /^\s*$/; my $data = ""; @@ -119,7 +119,7 @@ for my $archive (@archives) { 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)) { @@ -129,7 +129,7 @@ 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)) { @@ -139,7 +139,7 @@ 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)) { @@ -148,7 +148,7 @@ 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)) { @@ -158,10 +158,10 @@ 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; @@ -182,7 +182,7 @@ for my $pkg (keys %package_names) { } } 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)) { @@ -197,13 +197,16 @@ 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"); diff --git a/bin/parse-sources b/bin/parse-sources index 82716b3..9c97e2f 100755 --- a/bin/parse-sources +++ b/bin/parse-sources @@ -20,30 +20,30 @@ # 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 () { next if /^\s*$/; my $data = ""; @@ -79,7 +79,7 @@ for my $archive (@archives) { 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)) { @@ -98,7 +98,7 @@ for my $pkg (keys %source_names) { } } 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)) { @@ -113,8 +113,8 @@ 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"); diff --git a/cgi-bin/search_packages.pl b/cgi-bin/search_packages.pl index e5cf44d..22e9495 100755 --- a/cgi-bin/search_packages.pl +++ b/cgi-bin/search_packages.pl @@ -21,6 +21,8 @@ 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::Search qw( :all ); use Packages::HTML (); @@ -46,37 +48,9 @@ $debug = 0 if !defined($debug) || $debug !~ /^\d+$/o; $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 () { - 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; @@ -95,6 +69,8 @@ if (my $path = $input->param('path')) { $input->param('archive', $_); } elsif ($ARCHITECTURES{$_}) { $input->param('arch', $_); + } elsif ($_ eq 'source') { + $input->param('searchon','sourcenames'); } } } @@ -261,7 +237,7 @@ if (!@Packages::CGI::fatal_errors && !@results) { if ($exact) { $printed++; - hint( "You have searched only for exact matches of the package name. You can try to search for package names that contain your search string." ); + hint( "You have searched only for exact matches of the package name. You can try to search for package names that contain your search string." ); } } else { if (($suites_enc eq 'all') @@ -274,10 +250,10 @@ if (!@Packages::CGI::fatal_errors && !@results) { unless ($subword) { $printed++; - hint( "You have searched only for words exactly matching your keywords. You can try to search allowing subword matching." ); + hint( "You have searched only for words exactly matching your keywords. You can try to search allowing subword matching." ); } } - hint( ( $printed ? "Or you" : "You" )." can try a different search on the Packages search page." ); + hint( ( $printed ? "Or you" : "You" )." can try a different search on the Packages search page." ); } } diff --git a/cgi-bin/show_package.pl b/cgi-bin/show_package.pl index e4e897c..53d0f7b 100755 --- a/cgi-bin/show_package.pl +++ b/cgi-bin/show_package.pl @@ -22,6 +22,8 @@ use DB_File; 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; @@ -48,43 +50,9 @@ $debug = 0 if !defined($debug) || $debug !~ /^\d+$/o; $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 () { - 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; @@ -107,22 +75,26 @@ if (my $path = $input->param('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') { @@ -131,14 +103,20 @@ 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); @@ -151,16 +129,16 @@ sub gettext { return $_[0]; }; 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: $!"; @@ -239,15 +217,26 @@ unless (@Packages::CGI::fatal_errors) { # $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 .= "[ $_ ] "; } else { $package_page .= - "[ $_ ] "; + "[ $_ ] "; } } + $package_page .= '
'; $package_page .= simple_menu( [ gettext( "Distribution:" ), gettext( "Overview over this suite" ), @@ -359,6 +348,7 @@ unless (@Packages::CGI::fatal_errors) { # more information # $package_page .= pmoreinfo( name => $pkg, data => $page, + opts => \%opts, env => \%FTP_SITES, bugreports => 1, sourcedownload => 1, changesandcopy => 1, maintainers => 1, diff --git a/conf/apache.conf b/conf/apache.conf index f6e9e03..40c890d 100644 --- a/conf/apache.conf +++ b/conf/apache.conf @@ -102,6 +102,8 @@ 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] @@ -116,11 +118,19 @@ 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 diff --git a/config.sh b/config.sh index 2a3e945..8867ddb 100644 --- a/config.sh +++ b/config.sh @@ -32,14 +32,17 @@ amd64_ftpsite=http://amd64.debian.net/debian 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 # diff --git a/lib/Deb/Versions.pm b/lib/Deb/Versions.pm index dbd5ba8..984cbfb 100644 --- a/lib/Deb/Versions.pm +++ b/lib/Deb/Versions.pm @@ -64,6 +64,7 @@ package Deb::Versions; use strict; use Exporter; +use Carp qw(cluck); our @ISA = qw( Exporter ); our @EXPORT = qw( version_cmp version_sort suites_cmp suites_sort ); @@ -79,7 +80,7 @@ sub version_cmp { ( $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; } @@ -87,7 +88,7 @@ sub version_cmp { ( $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; } @@ -156,11 +157,25 @@ our @SUITES_SORT = qw( woody oldstable sarge stable stable-proposed-updates 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 { diff --git a/lib/Packages/Config.pm b/lib/Packages/Config.pm new file mode 100644 index 0000000..d2efe2f --- /dev/null +++ b/lib/Packages/Config.pm @@ -0,0 +1,66 @@ +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 () { + 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; diff --git a/lib/Packages/HTML.pm b/lib/Packages/HTML.pm index da02433..826461a 100644 --- a/lib/Packages/HTML.pm +++ b/lib/Packages/HTML.pm @@ -8,6 +8,7 @@ use HTML::Entities; use Packages::CGI; use Packages::Search qw( read_entry_simple ); +use Packages::Config qw( :all ); #use Packages::Util; #use Packages::I18N::Locale; @@ -25,10 +26,6 @@ our @EXPORT = qw( header title trailer file_changed time_stamp 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 { @@ -120,6 +117,7 @@ sub pmoreinfo { 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}; @@ -139,8 +137,11 @@ sub pmoreinfo { 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 .= " $source, ". + $str .= " $source, ". gettext( "Download" ).":\n"; unless (@$files) { @@ -287,7 +288,7 @@ sub print_deps { 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", diff --git a/lib/Packages/Page.pm b/lib/Packages/Page.pm index bc7fdc0..550b989 100644 --- a/lib/Packages/Page.pm +++ b/lib/Packages/Page.pm @@ -33,8 +33,8 @@ sub merge_data { 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); @@ -68,7 +68,8 @@ sub add_src_data { 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; @@ -77,9 +78,9 @@ sub add_src_data { $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) ]; } @@ -148,7 +149,7 @@ sub merge_package { 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}; diff --git a/lib/Packages/Search.pm b/lib/Packages/Search.pm index a7a76d0..b545dbc 100644 --- a/lib/Packages/Search.pm +++ b/lib/Packages/Search.pm @@ -361,16 +361,23 @@ sub read_entry { 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) = @_;