X-Git-Url: https://git.deb.at/?p=deb%2Fpackages.git;a=blobdiff_plain;f=lib%2FPackages%2FDispatcher.pm;h=732974082a15436c3578d59df8d391be2285fe86;hp=9d38c1788e63cf82b196d6950271261390c3bb35;hb=cc6c820a1e503808b7ac1e2bff132de23f87606b;hpb=ee72025828634d9ebfbe2ab4a75849a3409d87da diff --git a/lib/Packages/Dispatcher.pm b/lib/Packages/Dispatcher.pm index 9d38c17..7329740 100755 --- a/lib/Packages/Dispatcher.pm +++ b/lib/Packages/Dispatcher.pm @@ -15,7 +15,7 @@ # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software -# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. package Packages::Dispatcher; @@ -25,18 +25,16 @@ use warnings; use CGI; use POSIX; use File::Basename; -use URI::Escape; -use HTML::Entities; use Template; use DB_File; +use URI::Escape; use Benchmark ':hireswallclock'; use I18N::AcceptLanguage; -use Locale::gettext; use Deb::Versions; use Packages::Config qw( $DBDIR $ROOT $TEMPLATEDIR $CACHEDIR @SUITES @SECTIONS @ARCHIVES @ARCHITECTURES @PRIORITIES - @LANGUAGES @DDTP_LANGUAGES $LOCALES ); + @LANGUAGES @DDTP_LANGUAGES ); use Packages::CGI qw( :DEFAULT error get_all_messages ); use Packages::DB; use Packages::Search qw( :all ); @@ -65,6 +63,13 @@ sub do_dispatch { delete $ENV{'LC_ALL'}; delete $ENV{'LC_MESSAGES'}; + my %SUITES_ALIAS = ( oldstable => 'sarge', + stable => 'etch', + testing => 'lenny', + unstable => 'sid', + '3.1' => 'sarge', + '4.0' => 'etch' ); + # Read in all the variables set by the form my $input; if ($ARGV[0] && ($ARGV[0] eq 'php')) { @@ -86,6 +91,7 @@ sub do_dispatch { my $homedir = dirname($ENV{SCRIPT_FILENAME}).'/../'; &Packages::Config::init( $homedir ); &Packages::DB::init(); + &Packages::I18N::Locale::load( "$homedir/po" ); my $acc = I18N::AcceptLanguage->new(); my %all_langs = map { $_ => 1 } (@LANGUAGES, @DDTP_LANGUAGES); @@ -94,9 +100,7 @@ sub do_dispatch { \@all_langs ) || 'en'; debug( "LANGUAGES=@all_langs header=". ($input->http("Accept-Language")||''). - " http_lang=$http_lang", 2 ) if DEBUG; - bindtextdomain ( 'pdo', $LOCALES ); - textdomain( 'pdo' ); + " http_lang=$http_lang", 1 ) if DEBUG; # backwards compatibility stuff debug( "SCRIPT_URL=$ENV{SCRIPT_URL} SCRIPT_URI=$ENV{SCRIPT_URI}" ) if DEBUG; @@ -131,7 +135,7 @@ sub do_dispatch { my $what_to_do = 'show'; my $source = 0; - if (my $path = $input->path_info() || $input->param('PATH_INFO')) { + if (my $path = $ENV{'PATH_INFO'} || $input->param('PATH_INFO')) { my @components = grep { $_ } map { lc $_ } split /\/+/, $path; debug( "PATH_INFO=$path components=@components", 3) if DEBUG; @@ -139,11 +143,11 @@ sub do_dispatch { push @components, 'index' if @components && $path =~ m,/$,; my %LANGUAGES = map { $_ => 1 } @all_langs; - if (@components > 0 and $LANGUAGES{$components[0]} + if (@components > 1 and $LANGUAGES{$components[0]} and !$input->param('lang')) { $input->param( 'lang', shift(@components) ); } - if (@components > 0 and $components[0] eq 'source') { + if (@components > 1 and $components[0] eq 'source') { shift @components; $input->param( 'source', 1 ); } @@ -151,10 +155,10 @@ sub do_dispatch { shift @components; $what_to_do = 'search'; # Done - fatal_error( _g( "search doesn't take any more path elements" ) ) + fatal_error( "search doesn't take any more path elements" ) if @components; } elsif (@components == 0) { - fatal_error( _g( "We're supposed to display the homepage here, instead of getting dispatch.pl" ) ); + fatal_error( "We're supposed to display the homepage here, instead of getting dispatch.pl" ); } elsif (@components == 1) { $what_to_do = 'search'; } else { @@ -168,14 +172,6 @@ sub do_dispatch { } my %SUITES = map { $_ => 1 } @SUITES; - my %SUITES_ALIAS = ( sarge => 'oldstable', - etch => 'stable', - lenny => 'testing', - sid => 'unstable', - oldstable => 'sarge', - stable => 'etch', - testing => 'lenny', - unstable => 'sid', ); my %SECTIONS = map { $_ => 1 } @SECTIONS; my %ARCHIVES = map { $_ => 1 } @ARCHIVES; my %ARCHITECTURES = map { $_ => 1 } (@ARCHITECTURES, 'all', 'any'); @@ -185,7 +181,7 @@ sub do_dispatch { my ($cgi, $params_set, $key, $val) = @_; debug("set_param_once key=$key val=$val",4) if DEBUG; if ($params_set->{$key}++) { - fatal_error( sprintf( _g( "%s set more than once in path" ), $key ) ); + fatal_error( "$key set more than once in path" ); } else { $cgi->param( $key, $val ); } @@ -206,8 +202,6 @@ sub do_dispatch { set_param_once( $input, \%params_set, 'archive', $_); } elsif (!$need_pkg && $sections_descs{$_}) { set_param_once( $input, \%params_set, 'subsection', $_); - } elsif (!$need_pkg && ($_ eq 'non-us')) { # non-US hack - set_param_once( $input, \%params_set, 'subsection', 'non-US'); } elsif (!$need_pkg && ($_ eq 'source')) { set_param_once( $input, \%params_set, 'source', 1); } elsif ($ARCHITECTURES{$_}) { @@ -222,13 +216,14 @@ sub do_dispatch { @components = @pkg; if (@components > 1) { - fatal_error( sprintf( _g( "two or more packages specified (%s)" ), "@components" ) ); + 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 $c = uri_unescape($components[0]); + $input->param( 'keywords', $c ); + $input->param( 'package', $c ); } } @@ -238,13 +233,14 @@ sub do_dispatch { array => '\s+', match => '^([-+\@\w\/.:]+)$', }, - package => { default => undef, - match => '^([\w.+-]+)$', - var => \$pkg }, + 'package' => { default => undef, + match => '^([\w.+-]+)$', + var => \$pkg }, suite => { default => 'default', match => '^([\w-]+)$', array => ',', var => \@suites, replace => { all => \@SUITES, - default => \@SUITES } }, + default => \@SUITES, + %SUITES_ALIAS } }, archive => { default => ($what_to_do eq 'search') ? 'all' : 'default', match => '^([\w-]+)$', @@ -252,7 +248,7 @@ sub do_dispatch { replace => { all => \@ARCHIVES, default => \@ARCHIVES} }, exact => { default => 0, match => '^(\w+)$', }, - lang => { default => $http_lang, match => '^(\w+)$', }, + lang => { default => $http_lang, match => '^([\w-]+)$', }, source => { default => 0, match => '^(\d+)$', }, debug => { default => 0, match => '^(\d+)$', }, searchon => { default => 'names', match => '^(\w+)$', }, @@ -269,25 +265,19 @@ sub do_dispatch { arch => { default => 'any', match => '^([\w-]+)$', array => ',', var => \@archs, replace => { any => \@ARCHITECTURES } }, - format => { default => 'html', match => '^([\w.]+)$', }, - mode => { default => undef, match => '^(\w+)$', }, - sort_by => { default => 'file', match => '^(\w+)$', }, - ); + 'format' => { default => 'html', match => '^([\w.]+)$', }, + mode => { default => '', match => '^(\w+)$', }, + sort_by => { default => 'file', match => '^(\w+)$', }, + ); my %opts; my %params = Packages::CGI::parse_params( $input, \%params_def, \%opts ); -Packages::CGI::init_url( $input, \%params, \%opts ); - - my $locale = get_locale($opts{lang}); - my $charset = get_charset($opts{lang}); - setlocale ( LC_ALL, $locale ) - or do { debug( "couldn't set locale $locale, using default" ) if DEBUG; - setlocale( LC_ALL, get_locale() ) - or do { - debug( "couldn't set default locale either" ) if DEBUG; - setlocale( LC_ALL, "C" ); - }; - }; - debug( "locale=$locale charset=$charset", 2 ) if DEBUG; + Packages::CGI::init_url( $input, \%params, \%opts ); + + my $charset = "UTF-8"; + my $cat = Packages::I18N::Locale->get_handle( $opts{lang} ) + || Packages::I18N::Locale->get_handle( 'en' ); + die "get_handle failed for $opts{lang}" unless $cat; + $opts{cat} = $cat; $opts{h_suites} = { map { $_ => 1 } @suites }; $opts{h_sections} = { map { $_ => 1 } @sections }; @@ -312,11 +302,14 @@ Packages::CGI::init_url( $input, \%params, \%opts ); my $template = new Packages::Template( $TEMPLATEDIR, $opts{format}, { lang => $opts{lang}, charset => $charset, + cat => $cat, debug => ( DEBUG ? $opts{debug} : 0 ) }, ( $CACHEDIR ? { COMPILE_DIR => $CACHEDIR } : {} ) ); - unless (-e "$TEMPLATEDIR/$opts{format}/${what_to_do}.tmpl") { - fatal_error( "requested format not available for this document", + #FIXME: ugly hack + unless (($what_to_do eq 'allpackages' and $opts{format} =~ /^(html|txt\.gz)/) + || -e "$TEMPLATEDIR/$opts{format}/${what_to_do}.tmpl") { + fatal_error( $cat->g("requested format not available for this document"), "406 requested format not available"); } @@ -329,14 +322,6 @@ Packages::CGI::init_url( $input, \%params, \%opts ); $page_content{opts} = \%opts; $page_content{params} = \%params; - $page_content{make_search_url} = sub { return &Packages::CGI::make_search_url(@_) }; - $page_content{make_url} = sub { return &Packages::CGI::make_url(@_) }; - # needed to work around the limitations of the the FILTER syntax - $page_content{html_encode} = sub { return HTML::Entities::encode_entities(@_,'<>&"') }; - $page_content{uri_escape} = sub { return URI::Escape::uri_escape(@_) }; - $page_content{quotemeta} = sub { return quotemeta($_[0]) }; - $page_content{string2id} = sub { return &Packages::CGI::string2id(@_) }; - unless (@Packages::CGI::fatal_errors) { print $input->header(-charset => $charset, -type => get_mime($opts{format}) ); #use Data::Dumper;