fix Accept-Language usage

README.md

@@ -18,6 +18,7 @@ It requires the following CPAN distributions:
 * DateTime
 * Email-MIME
 * Email-Sender
+* HTTP-AcceptLanguage
 * List-MoreUtils
 * Locale-Maketext-Lexicon
 * Mojolicious

lib/AccessCheck/App/Controller.pm

@@ -3,6 +3,7 @@ package AccessCheck::App::Controller;
 use Mojo::Base qw(Mojolicious::Controller);
 
 use English qw(-no_match_vars);
+use HTTP::AcceptLanguage;
 use Syntax::Keyword::Try;
 
 use AccessCheck::Data::DB;
@@ -18,23 +19,19 @@ sub init_l10n {
 
     # lang identification first, as needed for any further error message
     my ($l10n, $lang);
-    if ($self->param('lang')) {
-        $lang = $self->param('lang');
-        $l10n = AccessCheck::L10N->get_handle($lang);
+    if ($lang = $self->param('lang')) {
         $log->debug(sprintf("setting language from parameter: %s", $lang));
-    } elsif ($self->session('lang')) {
-        $lang = $self->session('lang');
-        $l10n = AccessCheck::L10N->get_handle($lang);
+    } elsif ($lang = $self->session('lang')) {
         $log->debug(sprintf("setting language from session: %s", $lang));
-    } elsif ($self->req()->headers->header('Accept-Language')) {
-        $l10n = AccessCheck::L10N->get_handle();
-        $lang = $l10n->language_tag();
+    } elsif (my $header = $self->req()->headers->header('Accept-Language')) {
+        $lang = HTTP::AcceptLanguage->new($header)->match(qw/en fr/);
         $log->debug(sprintf("setting language from Accept-Language header: %s", $lang));
     } else {
         $lang = 'en';
-        $l10n = AccessCheck::L10N->get_handle($lang);
     }
 
+    $l10n = AccessCheck::L10N->get_handle($lang);
+
     $self->session(lang => $lang);
     $self->stash(lang => $lang);
     $self->stash(l10n => $l10n);

t/app.t

@@ -20,7 +20,7 @@ plan(skip_all => 'live database required') unless
     $ENV{TEST_DB_NAME} &&
     $ENV{TEST_DB_TYPE};
 
-plan tests => 9;
+plan tests => 10;
 
 sub named_subtest {
     my ($name, $code, @args) = @_;
@@ -170,7 +170,7 @@ named_subtest "index page" => sub {
     $t->get_ok('/')
       ->status_is(200)
       ->text_is('html head title' => 'eduGAIN Access Check')
-      ->element_exists('a[href=/step1]', 'get started button');
+      ->text_is('a[href=/step1]'  => 'Get started', 'get started button');
 
     my $res = $t->tx()->res();
     html_ok($res) or diag_file($res, $test_dir);
@@ -271,3 +271,15 @@ named_subtest "challenge page, valid entityid, invalid email" => sub {
     my $res = $t->tx()->res();
     html_ok($res) or diag_file($res, $test_dir);
 };
+
+named_subtest "index page, french version" => sub {
+    my $t = get_test_object(test => $_[0], language => 'fr-FR,fr;q=0.9');
+
+    $t->get_ok('/')
+      ->status_is(200)
+      ->text_is('html head title' => 'eduGAIN Access Check')
+      ->text_is('a[href=/step1]'  => 'Commencer', 'get started button');
+
+    my $res = $t->tx()->res();
+    html_ok($res) or diag_file($res, $test_dir);
+};