From 5088706b61d93fbaf27bacb16745aba3cd5917a0 Mon Sep 17 00:00:00 2001
From: Buchan Milne <buchan@mageia.org>
Date: Fri, 25 Feb 2011 12:22:21 +0000
Subject: Try and do some correction of languages (e.g. it-it to it, i-default
 to en)

---
 lib/CatDap/Controller/register.pm | 31 ++++++++++++++++++++++++++-----
 1 file changed, 26 insertions(+), 5 deletions(-)

(limited to 'lib')

diff --git a/lib/CatDap/Controller/register.pm b/lib/CatDap/Controller/register.pm
index 2038e2b..80dbbb9 100644
--- a/lib/CatDap/Controller/register.pm
+++ b/lib/CatDap/Controller/register.pm
@@ -25,8 +25,7 @@ Catalyst Controller.
 
 sub index :Path :Args(0) : Form {
     my ( $self, $c ) = @_;
-    my $langs = join ',',@{$c->languages};
-    $c->log->debug("Languages: $langs, default: " . $c->language . ", saving: " . ${$c->languages}[0]);
+    my $lang = choose_language($c);
 
     #my $form = Catalyst::Controller::HTML::FormFu->form();
     #$c->response->body('Matched CatDap::Controller::register in register.');
@@ -106,8 +105,8 @@ sub check : Local {
     my $ug =  Data::UUID->new;
     my $password = $ug->create_str();
     my $cn = $c->request->params->{gn} . " " .  $c->request->params->{sn};
+    my $lang = choose_language($c);
     $c->log->info("Creating account for user $username");
-    $c->log->debug("Preferred language: " . ${$c->languages}[0]);
     $mesg = $c->model('Proxy')->add($dn,
         attr => [
             objectclass => [ 'inetOrgPerson' ],
@@ -117,7 +116,7 @@ sub check : Local {
             mail => $email,
             pwdReset => 'TRUE',
             userPassword => $password,
-	    preferredLanguage => ${$c->languages}[0],
+	    preferredLanguage => $lang,
         ]
     );
     if ($mesg->code) {
@@ -155,7 +154,29 @@ sub captcha : Local {
 	return $c->create_captcha();
 }
 
-
+sub choose_language : Private {
+    my $c = shift;
+    my $langs = join ',',@{$c->languages};
+    # FIXME heuristic for correcting languages, we may want a different strategy
+    # in future in conjunction with server-side constraints with slapo-constraint.
+    # E.g. we could have a languages container with mapping from browser locale
+    # codes (preferredLanguage, which is multi-valued), to a single value
+    # (e.g. mageiaselectedLanguage, or similar). Then use a uri-based constraint on 
+    # with mageiaSelectedLanguage as the attribute
+    # Also to be considered, pushing all the languages to preferredLanguage, but
+    # then do we use ordering?
+    my $lang = ${$c->languages}[0];
+    if ($lang !~ /^\w\w\w?(-\w+)?$/) {
+	$lang = 'en';
+    }
+    # Partial list of lang-variant locales where localisation is different
+    if ($lang !~ /^(en-gb|en-us|pt-br|no-\w+|zh-\w+)$/) {
+        $lang =~ s/^(\w+)-\w+$/$1/;
+    }
+    $c->log->debug("Browser languages: $langs,using preferred language: $lang");
+    $c->log->debug("Selected language $lang not default " . $c->language) if $lang ne $c->language;
+    return $lang;
+}
 
 =head1 AUTHOR
 
-- 
cgit v1.2.1