From 66a8c9655079f141c9185aea329435e3a63bbd0a Mon Sep 17 00:00:00 2001
From: Jesse Weaver <jweaver@bywatersolutions.com>
Date: Wed, 8 Jun 2016 11:31:54 -0600
Subject: [PATCH] Bug 16715: Proposed followup to use Sereal for serialization

This manages to eke out a bit more performance on my machine.

Signed-off-by: Jacek Ablewicz <abl@biblos.pk.edu.pl>

Signed-off-by: Jonathan Druart <jonathan.druart@bugs.koha-community.org>

Signed-off-by: Kyle M Hall <kyle@bywatersolutions.com>
---
 C4/Installer/PerlDependencies.pm |  5 +++++
 Koha/Cache.pm                    | 12 +++++++-----
 2 files changed, 12 insertions(+), 5 deletions(-)

diff --git a/C4/Installer/PerlDependencies.pm b/C4/Installer/PerlDependencies.pm
index 89df812e10..db9cd7c442 100644
--- a/C4/Installer/PerlDependencies.pm
+++ b/C4/Installer/PerlDependencies.pm
@@ -807,6 +807,11 @@ our $PERL_DEPS = {
         required => 1,
         min_ver => '1.00',
     },
+    'Sereal' => {
+        'usage'    => 'Caching',
+        'required' => '1',
+        'min_ver'  => '3.0',
+    },
 };
 
 1;
diff --git a/Koha/Cache.pm b/Koha/Cache.pm
index c4ff9433e5..0f85ed1a2a 100644
--- a/Koha/Cache.pm
+++ b/Koha/Cache.pm
@@ -38,9 +38,9 @@ The first, traditional OO interface provides the following functions:
 use strict;
 use warnings;
 use Carp;
-use Storable qw(freeze thaw);
 use Module::Load::Conditional qw(can_load);
 use Koha::Cache::Object;
+use Sereal;
 
 use base qw(Class::Accessor);
 
@@ -48,6 +48,8 @@ __PACKAGE__->mk_ro_accessors(
     qw( cache memcached_cache fastmmap_cache memory_cache ));
 
 our %L1_cache;
+our $L1_encoder = Sereal::Encoder->new;
+our $L1_decoder = Sereal::Decoder->new;
 
 =head2 get_instance
 
@@ -263,7 +265,7 @@ sub set_in_cache {
     my $flag = '-CF0'; # 0: scalar, 1: frozen data structure
     if (ref($value)) {
         # Set in L1 cache as a data structure, initially only in frozen form (for performance reasons)
-        $value = freeze($value);
+        $value = $L1_encoder->encode($value);
         $L1_cache{$key}->{frozen} = $value;
         $flag = '-CF1';
     } else {
@@ -325,10 +327,10 @@ sub get_from_cache {
     if ( exists $L1_cache{$key} ) {
         if (ref($L1_cache{$key})) {
             if ($unsafe) {
-                $L1_cache{$key}->{thawed} ||= thaw($L1_cache{$key}->{frozen});
+                $L1_cache{$key}->{thawed} ||= $L1_decoder->decode($L1_cache{$key}->{frozen});
                 return $L1_cache{$key}->{thawed};
             } else {
-                return thaw($L1_cache{$key}->{frozen});
+                return $L1_decoder->decode($L1_cache{$key}->{frozen});
             }
         } else {
             # No need to thaw if it's a scalar
@@ -350,7 +352,7 @@ sub get_from_cache {
     } elsif ($flag eq '-CF1') {
         # it's a frozen data structure
         my $thawed;
-        eval { $thawed = thaw($L2_value); };
+        eval { $thawed = $L1_decoder->decode($L2_value); };
         return if $@;
         $L1_cache{$key}->{frozen} = $L2_value;
         $L1_cache{$key}->{thawed} = $thawed if $unsafe;
-- 
2.39.5