File Coverage

blib/lib/Dancer2/Session/Redis/Serialization/Sereal.pm

Criterion	Covered	Total	%
statement	26	26	100.0
branch	3	6	50.0
condition	1	3	33.3
subroutine	10	10	100.0
pod	2	2	100.0
total	42	47	89.3

package Dancer2::Session::Redis::Serialization::Sereal;
use strictures 1;
# ABSTRACT: Dancer2::Session::Redis serialization broker for Sereal.
#
# This file is part of Dancer2-Session-Redis
#
# This software is Copyright (c) 2016 by BURNERSK .
#
# This is free software, licensed under:
#
#   The MIT (X11) License
#

BEGIN {
  our $VERSION = '0.002';  # fixed version - NOT handled via DZP::OurPkgVersion.
}

use Types::Standard qw( Bool InstanceOf );
use Moo;
use Sereal::Decoder qw( looks_like_sereal );
use Sereal::Encoder qw( SRL_UNCOMPRESSED SRL_SNAPPY );

with 'Dancer2::Session::Redis::SerializationRole';


############################################################################

has snappy => (
  is      => 'ro',
  isa     => Bool,
  default => 1,
);

has _decoder => (
  is      => 'lazy',
  isa     => InstanceOf ['Sereal::Decoder'],
  builder => sub { Sereal::Decoder->new },
);

has _encoder => (
  is      => 'lazy',
  isa     => InstanceOf ['Sereal::Encoder'],
  builder => sub {
    my ($self) = @_;
    my $snappy = $self->snappy ? SRL_SNAPPY : SRL_UNCOMPRESSED;
    return Sereal::Encoder->new( {
      compress           => $snappy,  # use Google Snappy compression algorithm if wanted.
      compress_threshold => 1024,     # compress when content is 1 kbyte or bigger.
      croak_on_bless     => 0,        # do not croak on blessed objects.
      undef_unknown      => 0,        # do not undef unknown objects.
      stringify_unknown  => 0,        # do not stringify unknown objects.
      warn_unknown       => 1,        # carp on unknown objects.
      sort_keys          => 0,        # do not sort keys. we do not care abount sorting but performance.
    } );
  },
);

############################################################################

sub decode {
  my ( $self, $serialized_object ) = @_;
  # deserealize stuff only if Sereal thinks it can do it.
  return $serialized_object unless looks_like_sereal $serialized_object;
  return $self->_decoder->decode($serialized_object);
}


sub encode {
  my ( $self, $raw_object ) = @_;
  return $raw_object if defined $raw_object && !ref $raw_object;  # do not serialize simple scalars (strings).
  return $self->_encoder->encode($raw_object);
}


############################################################################


1;

__END__