From 801c5e77d0a7bdab5d2457d47b2fb2b852310c56 Mon Sep 17 00:00:00 2001
From: Julian Maurice <julian.maurice@biblibre.com>
Date: Mon, 17 Mar 2014 23:25:37 +0100
Subject: [PATCH] Bug 11848: Fix C4::Context::interface, add POD and UT

1/ Edit a Perl script, for example mainpage.pl
2/ add "use Koha::I18N;" to the top of file
3/ add a translatable message somewhere in the script (this have
   to be after the call to get_template_and_user). For example:
   warn gettext("This is a translated warning");
4/ Create or update the PO files with
   misc/translator/translate create LANGCODE
or
   misc/translator/translate update LANGCODE
   (LANGCODE should be enable in syspref 'languages')
5/ In misc/translator/po/LANGCODE-messages.po you should have
   your string, translate it (using a text editor or a PO file
   editor, make sure you don't have the "fuzzy" flag for this
   string).
6/ Go to mainpage.pl with active language being English with your
   browser and check your logs. You should see your string "This
   is a translated warning".
7/ Now change language to LANGCODE. Check your logs, you should
   have the string translated.

Note: I chose to name the sub 'gettext' because it's the default
keyword for xgettext for Perl. We can change it to whatever we want.

Signed-off-by: Bernardo Gonzalez Kriegel <bgkriegel@gmail.com>

Follow test plan, work as described.
No koha-qa errors.
Tests pass

Fixed small merge conflict on t/Context.t

Signed-off-by: Katrin Fischer <Katrin.Fischer.83@web.de>
Passes all tests and QA script.
Copied test plan from bug.

Signed-off-by: Galen Charlton <gmc@esilibrary.com>
---
 C4/Context.pm | 20 +++++++++++++++++---
 t/Context.t   | 16 +++++++++++++++-
 2 files changed, 32 insertions(+), 4 deletions(-)

diff --git a/C4/Context.pm b/C4/Context.pm
index 1bc70b2946..4ca97558c6 100644
--- a/C4/Context.pm
+++ b/C4/Context.pm
@@ -1261,15 +1261,29 @@ sub IsSuperLibrarian {
     return ($userenv->{flags}//0) % 2;
 }
 
+=head2 interface
+
+Sets the current interface for later retrieval in any Perl module
+
+    C4::Context->interface('opac');
+    C4::Context->interface('intranet');
+    my $interface = C4::Context->interface;
+
+=cut
+
 sub interface {
     my ($class, $interface) = @_;
 
     if (defined $interface) {
-        $interface ||= 'opac';
-        $context->{interface} = $interface;
+        $interface = lc $interface;
+        if ($interface eq 'opac' || $interface eq 'intranet') {
+            $context->{interface} = $interface;
+        } else {
+            warn "invalid interface : '$interface'";
+        }
     }
 
-    return $context->{interface};
+    return $context->{interface} // 'opac';
 }
 
 1;
diff --git a/t/Context.t b/t/Context.t
index 6775b8e998..8febdb466c 100755
--- a/t/Context.t
+++ b/t/Context.t
@@ -2,7 +2,7 @@
 
 use Modern::Perl;
 use DBI;
-use Test::More tests => 14;
+use Test::More tests => 24;
 use Test::MockModule;
 
 BEGIN {
@@ -45,3 +45,17 @@ is(C4::Context::db_scheme2dbi('mysql'), 'mysql', 'ask for mysql, get mysql');
 is(C4::Context::db_scheme2dbi('Pg'),    'Pg',    'ask for Pg, get Pg');
 is(C4::Context::db_scheme2dbi('xxx'),   'mysql', 'ask for unsupported DBMS, get mysql');
 is(C4::Context::db_scheme2dbi(),        'mysql', 'ask for nothing, get mysql');
+
+# C4::Context::interface
+my $lastwarn;
+local $SIG{__WARN__} = sub { $lastwarn = $_[0] };
+is(C4::Context->interface, 'opac');
+is(C4::Context->interface('foobar'), 'opac');
+like($lastwarn, qr/invalid interface : 'foobar'/);
+is(C4::Context->interface, 'opac');
+is(C4::Context->interface('intranet'), 'intranet');
+is(C4::Context->interface, 'intranet');
+is(C4::Context->interface('foobar'), 'intranet');
+is(C4::Context->interface, 'intranet');
+is(C4::Context->interface('OPAC'), 'opac');
+is(C4::Context->interface, 'opac');
-- 
2.39.5