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>

diff --git a/C4/Context.pm b/C4/Context.pm
index 1bc70b2..4ca9755 100644 (file)
--- 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 6775b8e..8febdb4 100755 (executable)
--- 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');