File Coverage

blib/lib/Sereal/Encoder.pm

Criterion	Covered	Total	%
statement	0	9	0.0
branch	0	14	0.0
condition			n/a
subroutine	0	3	0.0
pod	1	2	50.0
total	1	28	3.5

package Sereal::Encoder;
use 5.008;
use strict;
use warnings;
use Carp qw/croak/;
use XSLoader;

our $VERSION= '5.004';
our $XS_VERSION= $VERSION; $VERSION= eval $VERSION;

# Make sure to keep these constants in sync with the C code in srl_encoder.c.
# I know they could be exported from C using things like ExtUtils::Constant,
# but that's too much of a hassle for just three numbers.
#start-no-tidy
my ($compress_consts, $full_consts);
BEGIN {
$compress_consts= {
    SRL_UNCOMPRESSED => 0,
    SRL_SNAPPY       => 1,
    SRL_ZLIB         => 2,
    SRL_ZSTD         => 3,
};
$full_consts=
#begin generated
{
  'SRL_F_ALIASED_DEDUPE_STRINGS' => 4096,
  'SRL_F_CANONICAL_REFS' => 32768,
  'SRL_F_COMPRESS_SNAPPY' => 64,
  'SRL_F_COMPRESS_SNAPPY_INCREMENTAL' => 128,
  'SRL_F_COMPRESS_ZLIB' => 256,
  'SRL_F_COMPRESS_ZSTD' => 262144,
  'SRL_F_CROAK_ON_BLESS' => 4,
  'SRL_F_DEDUPE_STRINGS' => 2048,
  'SRL_F_ENABLE_FREEZE_SUPPORT' => 16384,
  'SRL_F_ENCODER_COMPRESS_FLAGS_MASK' => 262592,
  'SRL_F_NOWARN_UNKNOWN_OVERLOAD' => 512,
  'SRL_F_NO_BLESS_OBJECTS' => 8192,
  'SRL_F_REUSE_ENCODER' => 2,
  'SRL_F_SHARED_HASHKEYS' => 1,
  'SRL_F_SORT_KEYS' => 1024,
  'SRL_F_SORT_KEYS_PERL' => 65536,
  'SRL_F_SORT_KEYS_PERL_REV' => 131072,
  'SRL_F_STRINGIFY_UNKNOWN' => 16,
  'SRL_F_UNDEF_UNKNOWN' => 8,
  'SRL_F_WARN_UNKNOWN' => 32,
  '_FLAG_NAME' => [
                    'COMPRESS_SNAPPY',
                    'COMPRESS_SNAPPY_INCREMENTAL',
                    'COMPRESS_ZLIB',
                    'COMPRESS_ZSTD',
                    'SHARED_HASHKEYS',
                    'REUSE',
                    'CROAK_ON_BLESS',
                    'UNDEF_UNKNOWN',
                    'STRINGIFY_UNKNOWN',
                    'WARN_UNKNOWN',
                    'COMPRESS_SNAPPY',
                    'COMPRESS_SNAPPY_INCREMENTAL',
                    'COMPRESS_ZLIB',
                    'NOWARN_UNKNOWN_OVERLOAD',
                    'SORT_KEYS',
                    'DEDUPE_STRINGS',
                    'ALIASED_DEDUPE_STRINGS',
                    'NO_BLESS_OBJECTS',
                    'ENABLE_FREEZE_SUPPORT',
                    'CANONICAL_REFS',
                    'SORT_KEYS_PERL',
                    'SORT_KEYS_PERL_REV',
                    'COMPRESS_ZSTD'
                  ]
};
#end generated
}
use constant $compress_consts;
use constant $full_consts;
#end-no-tidy

use Exporter 'import';
our @EXPORT_OK= (qw(
    encode_sereal
    encode_sereal_with_header_data
    sereal_encode_with_object
), sort { $a cmp $b }
(
    keys(%$compress_consts),
    keys(%$full_consts)
));
our %EXPORT_TAGS= (
    all            => \@EXPORT_OK,
    compress_const => [ sort keys %$compress_consts ],
    full_const     => [ sort(keys(%$compress_consts),keys(%$full_consts)) ],
);

# export by default if run from command line
our @EXPORT= ( ( caller() )[1] eq '-e' ? @EXPORT_OK : () );

sub CLONE_SKIP { 1 }

XSLoader::load( 'Sereal::Encoder', $XS_VERSION );

sub encode_to_file {
    my ( $self, $file, $struct, $append )= @_;
    $self= $self->new() unless ref $self;
    my $mode= $append ? ">>" : ">";
    open my $fh, $mode, $file
        or die "Failed to open '$file' for " . ( $append ? "append" : "write" ) . ": $!";
    print $fh $self->encode($struct)
        or die "Failed to print to '$file': $!";
    close $fh
        or die "Failed to close '$file': $!";
}

my $flags= sub {
    my ( $int, $ary )= @_;
    return map { ( $ary->[$_] and $int & ( 1 << $_ ) ) ? $ary->[$_] : () } ( 0 .. $#$ary );
};

sub flag_names {
    my ( $self, $val )= @_;
    return $flags->( defined $val ? $val : $self->flags, _FLAG_NAME );
}

1;

__END__