From 7d713b693cdf6f5a1d5e9bf2ae085f455322cec6 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] [SIGNED-OFF] Bug 11848: Fix C4::Context::interface, add POD
 and UT

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
---
 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 04bbd1e..eab8f24 100644
--- a/C4/Context.pm
+++ b/C4/Context.pm
@@ -1264,15 +1264,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 6775b8e..8febdb4 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');
-- 
1.7.9.5