Bug 21395: Make perlcritic happy
[koha.git] / t / db_dependent / Context.t
1 #!/usr/bin/perl
2
3 use Modern::Perl;
4
5 use Test::More;
6 use Test::MockModule;
7 use vars qw($debug $koha $dbh $config $ret);
8 use t::lib::Mocks;
9
10 use Koha::Database;
11
12 BEGIN {
13     $debug = $ENV{DEBUG} || 0;
14
15     # Note: The overall number of tests may vary by configuration.
16     # First we need to check your environmental variables
17     for (qw(KOHA_CONF PERL5LIB)) {
18         ok( $ret = $ENV{$_}, "ENV{$_} = $ret" );
19     }
20     use_ok('C4::Context');
21 }
22
23 ok($dbh = C4::Context->dbh(), 'Getting dbh from C4::Context');
24
25 $dbh->begin_work;
26 C4::Context->set_preference('OPACBaseURL','junk');
27 C4::Context->clear_syspref_cache();
28 my $OPACBaseURL = C4::Context->preference('OPACBaseURL');
29 is($OPACBaseURL,'http://junk','OPACBaseURL saved with http:// when missing it');
30
31 C4::Context->set_preference('OPACBaseURL','https://junk');
32 C4::Context->clear_syspref_cache();
33 $OPACBaseURL = C4::Context->preference('OPACBaseURL');
34 is($OPACBaseURL,'https://junk','OPACBaseURL saved with https:// as specified');
35
36 C4::Context->set_preference('OPACBaseURL','http://junk2');
37 C4::Context->clear_syspref_cache();
38 $OPACBaseURL = C4::Context->preference('OPACBaseURL');
39 is($OPACBaseURL,'http://junk2','OPACBaseURL saved with http:// as specified');
40
41 C4::Context->set_preference('OPACBaseURL', '');
42 $OPACBaseURL = C4::Context->preference('OPACBaseURL');
43 is($OPACBaseURL,'','OPACBaseURL saved empty as specified');
44
45 C4::Context->set_preference('SillyPreference','random');
46 C4::Context->clear_syspref_cache();
47 my $SillyPeference = C4::Context->preference('SillyPreference');
48 is($SillyPeference,'random','SillyPreference saved as specified');
49 C4::Context->clear_syspref_cache();
50 C4::Context->enable_syspref_cache();
51 $dbh->rollback;
52
53 ok($koha = C4::Context->new,  'C4::Context->new');
54 my @keys = keys %$koha;
55 my $width = 0;
56 if (ok(@keys)) { 
57     $width = (sort {$a <=> $b} map {length} @keys)[-1];
58     $debug and diag "widest key is $width";
59 }
60 foreach (sort @keys) {
61         ok(exists $koha->{$_}, 
62                 '$koha->{' . sprintf('%' . $width . 's', $_)  . '} exists '
63                 . ((defined $koha->{$_}) ? "and is defined." : "but is not defined.")
64         );
65 }
66 ok($config = $koha->{config}, 'Getting $koha->{config} ');
67
68 # Testing syspref caching
69 use Test::DBIx::Class;
70
71 my $schema = Koha::Database->new()->schema();
72 $schema->storage->debug(1);
73 my $trace_read;
74 open my $trace, '>', \$trace_read or die "Can't open variable: $!";
75 $schema->storage->debugfh( $trace );
76
77 C4::Context->set_preference('SillyPreference', 'thing1');
78 my $silly_preference = Koha::Config::SysPrefs->find('SillyPreference');
79 is( $silly_preference->variable, 'SillyPreference', 'set_preference should have kept the case sensitivity' );
80
81 my $pref = C4::Context->preference("SillyPreference");
82 is(C4::Context->preference("SillyPreference"), 'thing1', "Retrieved syspref (value='thing1') successfully with default behavior");
83 ok( $trace_read, 'Retrieved syspref from database');
84 $trace_read = q{};
85
86 is(C4::Context->preference("SillyPreference"), 'thing1', "Retrieved syspref (value='thing1') successfully with default behavior");
87 is( $trace_read , q{}, 'Did not retrieve syspref from database');
88 $trace_read = q{};
89
90 C4::Context->disable_syspref_cache();
91 $silly_preference->set( { value => 'thing2' } )->store();
92 is(C4::Context->preference("SillyPreference"), 'thing2', "Retrieved syspref (value='thing2') successfully with disabled cache");
93 ok($trace_read, 'Retrieved syspref from database');
94 $trace_read = q{};
95
96 $silly_preference->set( { value => 'thing3' } )->store();
97 is(C4::Context->preference("SillyPreference"), 'thing3', "Retrieved syspref (value='thing3') successfully with disabled cache");
98 ok($trace_read, 'Retrieved syspref from database');
99 $trace_read = q{};
100
101 C4::Context->enable_syspref_cache();
102 is(C4::Context->preference("SillyPreference"), 'thing3', "Retrieved syspref (value='thing3') successfully from cache");
103 isnt( $trace_read, q{}, 'The pref should be retrieved from the database if the cache has been enabled');
104 $trace_read = q{};
105
106 # FIXME This was added by Robin and does not pass anymore
107 # I don't understand why we should expect thing1 while thing3 is in the cache and in the DB
108 #$dbh->{mock_clear_history} = 1;
109 ## This gives us the value that was cached on the first call, when the cache was active.
110 #is(C4::Context->preference("SillyPreference"), 'thing1', "Retrieved syspref (value='thing1') successfully from cache");
111 #$history = $dbh->{mock_all_history};
112 #is(scalar(@{$history}), 0, 'Did not retrieve syspref from database');
113
114 $silly_preference->set( { value => 'thing4' } )->store();
115 C4::Context->clear_syspref_cache();
116 is(C4::Context->preference("SillyPreference"), 'thing4', "Retrieved syspref (value='thing4') successfully after clearing cache");
117 ok($trace_read, 'Retrieved syspref from database');
118 $trace_read = q{};
119
120 is(C4::Context->preference("SillyPreference"), 'thing4', "Retrieved syspref (value='thing4') successfully from cache");
121 is( $trace_read, q{}, 'Did not retrieve syspref from database');
122 $trace_read = q{};
123
124 my $oConnection = C4::Context->Zconn('biblioserver', 0);
125 isnt($oConnection->option('async'), 1, "ZOOM connection is synchronous");
126 $oConnection = C4::Context->Zconn('biblioserver', 1);
127 is($oConnection->option('async'), 1, "ZOOM connection is asynchronous");
128
129 $silly_preference->delete();
130
131 # AutoEmailOpacUser should be a YesNo pref
132 C4::Context->set_preference('AutoEmailOpacUser', '');
133 my $yesno_pref = Koha::Config::SysPrefs->find('AutoEmailOpacUser');
134 is( $yesno_pref->value(), 0, 'set_preference should have set the value to 0, instead of an empty string' );
135
136 done_testing();
137
138 sub TransformVersionToNum {
139     my $version = shift;
140
141     # remove the 3 last . to have a Perl number
142     $version =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
143
144     # three X's at the end indicate that you are testing patch with dbrev
145     # change it into 999
146     # prevents error on a < comparison between strings (should be: lt)
147     $version =~ s/XXX$/999/;
148     return $version;
149 }