t/Cache.t

   1 #!/usr/bin/perl
   2
   3 # This file is part of Koha.
   4 #
   5 # Koha is free software; you can redistribute it and/or modify it
   6 # under the terms of the GNU General Public License as published by
   7 # the Free Software Foundation; either version 3 of the License, or
   8 # (at your option) any later version.
   9 #
  10 # Koha is distributed in the hope that it will be useful, but
  11 # WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13 # GNU General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  17
  18 use Modern::Perl;
  19
  20 use Test::More tests => 32;
  21
  22 my $destructorcount = 0;
  23
  24 BEGIN {
  25     use_ok('Koha::Cache');
  26     use_ok('Koha::Cache::Object');
  27     use_ok('C4::Context');
  28 }
  29
  30 SKIP: {
  31     # Set a special namespace for testing, to avoid breaking
  32     # if test is run with a different user than Apache's.
  33     $ENV{ MEMCACHED_NAMESPACE } = 'unit_tests';
  34     my $cache = Koha::Cache->get_instance();
  35
  36     skip "Cache not enabled", 28
  37       unless ( $cache->is_cache_active() && defined $cache );
  38
  39     # test fetching an item that isnt in the cache
  40     is( $cache->get_from_cache("not in here"),
  41         undef, "fetching item NOT in cache" );
  42
  43     # test expiry time in cache
  44     $cache->set_in_cache( "timeout", "I AM DATA", 1 ); # expiry time of 1 second
  45     sleep 2;
  46     is( $cache->get_from_cache("timeout"),
  47         undef, "fetching expired item from cache" );
  48
  49     # test fetching a valid, non expired, item from cache
  50     $cache->set_in_cache( "clear_me", "I AM MORE DATA", 1000 )
  51       ;    # overly large expiry time, clear below
  52     $cache->set_in_cache( "dont_clear_me", "I AM MORE DATA22", 1000 )
  53       ;    # overly large expiry time, clear below
  54     is(
  55         $cache->get_from_cache("clear_me"),
  56         "I AM MORE DATA",
  57         "fetching valid item from cache"
  58     );
  59
  60     # test clearing from cache
  61     $cache->clear_from_cache("clear_me");
  62     is( $cache->get_from_cache("clear_me"),
  63         undef, "fetching cleared item from cache" );
  64     is(
  65         $cache->get_from_cache("dont_clear_me"),
  66         "I AM MORE DATA22",
  67         "fetching valid item from cache (after clearing another item)"
  68     );
  69
  70     #test flushing from cache
  71     $cache->set_in_cache( "flush_me", "testing 1 data" );
  72     $cache->flush_all;
  73     is( $cache->get_from_cache("flush_me"),
  74         undef, "fetching flushed item from cache" );
  75     is( $cache->get_from_cache("dont_clear_me"),
  76         undef, "fetching flushed item from cache" );
  77
  78     my $constructorcount = 0;
  79     my $myscalar         = $cache->create_scalar(
  80         {
  81             'key'         => 'myscalar',
  82             'timeout'     => 1,
  83             'allowupdate' => 1,
  84             'unset'       => 1,
  85             'constructor' => sub { return ++$constructorcount; },
  86             'destructor'  => sub { return ++$destructorcount; },
  87         }
  88     );
  89     ok( defined($myscalar), 'Created tied scalar' );
  90     is( $$myscalar, 1, 'Constructor called to first initialize' );
  91     is( $$myscalar, 1, 'Data retrieved from cache' );
  92     sleep 2;
  93     is( $$myscalar, 2, 'Constructor called again when timeout reached' );
  94     $$myscalar = 5;
  95     is( $$myscalar,        5, 'Stored new value to cache' );
  96     is( $constructorcount, 2, 'Constructor not called after storing value' );
  97     undef $myscalar;
  98
  99     is( $cache->get_from_cache("myscalar"),
 100         undef, 'Item removed from cache on destruction' );
 101
 102     my %hash = ( 'key' => 'value' );
 103
 104     my $myhash         = $cache->create_hash(
 105         {
 106             'key'         => 'myhash',
 107             'timeout'     => 1,
 108             'allowupdate' => 1,
 109             'unset'       => 1,
 110             'constructor' => sub { return { %hash }; },
 111         }
 112     );
 113
 114     ok(defined $myhash, 'Created tied hash');
 115
 116     is($myhash->{'key'}, 'value', 'Found expected value in hash');
 117     ok(exists $myhash->{'key'}, 'Exists works');
 118     $myhash->{'key2'} = 'surprise';
 119     is($myhash->{'key2'}, 'surprise', 'Setting hash member worked');
 120     $hash{'key2'} = 'nosurprise';
 121     sleep 2;
 122     is($myhash->{'key2'}, 'nosurprise', 'Cache change caught');
 123
 124
 125     my $foundkeys = 0;
 126     foreach my $key (keys %{$myhash}) {
 127         $foundkeys++;
 128     }
 129
 130     is($foundkeys, 2, 'Found expected 2 keys when iterating through hash');
 131
 132     isnt(scalar %{$myhash}, undef, 'scalar knows the hash is not empty');
 133
 134     $hash{'anotherkey'} = 'anothervalue';
 135
 136     sleep 2;
 137
 138     ok(exists $myhash->{'anotherkey'}, 'Cache reset properly');
 139
 140     delete $hash{'anotherkey'};
 141     delete $myhash->{'anotherkey'};
 142
 143     ok(!exists $myhash->{'anotherkey'}, 'Key successfully deleted');
 144
 145     undef %hash;
 146     %{$myhash} = ();
 147
 148     is(scalar %{$myhash}, 0, 'hash cleared');
 149
 150     $hash{'key'} = 'value';
 151     is($myhash->{'key'}, 'value', 'retrieved value after clearing cache');
 152
 153     # UTF8 testing
 154     my $utf8_str = "A Møøse once bit my sister";
 155     $cache->set_in_cache('utf8_1', $utf8_str);
 156     is($cache->get_from_cache('utf8_1'), $utf8_str, 'Simple 8-bit UTF8 correctly retrieved');
 157     $utf8_str = "\x{20ac}"; # €
 158     $cache->set_in_cache('utf8_1', $utf8_str);
 159     my $utf8_res = $cache->get_from_cache('utf8_1');
 160     # This'll ensure that we're getting a unicode string back, rather than
 161     # a couple of bytes.
 162     is(length($utf8_res), 1, 'UTF8 string length correct');
 163     # ...and that it's really the character we intend
 164     is(ord($utf8_res), 8364, 'UTF8 string value correct');
 165 }
 166
 167 END {
 168   SKIP: {
 169         $ENV{ MEMCACHED_NAMESPACE } = 'unit_tests';
 170         my $cache = Koha::Cache->get_instance();
 171         skip "Cache not enabled", 1
 172           unless ( $cache->is_cache_active() );
 173         is( $destructorcount, 1, 'Destructor run exactly once' );
 174         # cleanup temporary file
 175         my $tmp_file = $cache->{ fastmmap_cache }->{ share_file };
 176         unlink $tmp_file if defined $tmp_file;
 177
 178     }
 179 }