File Coverage

blib/lib/Sereal/Splitter.pm
Criterion Covered Total %
statement 27 49 55.1
branch 0 8 0.0
condition 0 3 0.0
subroutine 9 11 81.8
pod 2 2 100.0
total 38 73 52.0


line stmt bran cond sub pod time code
1             package Sereal::Splitter;
2              
3             =head1 NAME
4              
5             Sereal::Splitter - splits a Sereal blob in chunks of roughly the same size
6              
7             =head1 SYNOPSIS
8              
9             use Sereal::Splitter qw(SRL_ZLIB create_header_data_template);
10              
11             my $splitter = Sereal::Splitter->new(
12             { input => $data, chunk_size => 1, compress => SRL_ZLIB,
13             header_data_template => create_header_data_template(
14             { date => time(), elements_count => '__$CNT__' }
15             )
16             }
17             );
18             while (defined( my $chunk = $splitter->next_chunk())) {
19             # do stuff with $chunk;
20             }
21              
22             =head1 DESCRIPTION
23              
24             This library implements an efficient way of splitting a Sereal blob into
25             smaller chunks. Currently, it only works with ArrayRefs Sereal blobs, like
26             this:
27              
28             [ $element_1, $element_2, ..., $element_n ]
29              
30             In the future, it may also work with HashRefs.
31              
32              
33             =head1 CONSTRUCTOR
34              
35             =head2 new
36              
37             Takes a HashRef with options:
38              
39             =head3 input
40              
41             Mandatory, String, the Sereal blob to split
42              
43             =head3 chunk_size
44              
45             Mandatory, positive Int, the approximate size of the B chunk
46              
47             =head3 compress
48              
49             Optional, Int, one of SRL_UNCOMPRESSED, SRL_SNAPPY or SRL_ZLIB. These constant
50             can be exported at use time. If set, indicates how chunks must be compressed.
51             Defaults to SRL_UNCOMPRESSED.
52              
53             =head3 header_data_template
54              
55             Optional, Str, the header_data to inject in each chunk. This header_data can
56             contain special scalar values, that will be replaced by values. Special scalar values are:
57              
58             =over
59              
60             =item '__$CNT__'
61              
62             This will be replaced by the number of elements that the chunks contains. It
63             must be encoded as SHORT_BINARY_08. It'll be replaced by a VARINT.
64              
65             REMARK: In theory, it should be a string of lentgh 11, because varint max size
66             are 11 bytes. However, the Sereal decoder code, can't cope with varint bigger
67             than 8 bytes, because of a bug, and even if the varint is forged like
68             0x8180808080808080808080.
69              
70             =back
71              
72             To make things easier, you can use C (see below)
73             to create it for you.
74              
75             =head1 METHODS
76              
77             =head2 next_chunk
78              
79             returns the next chunk as a String, or Undef if it was the last chunk
80              
81             =cut
82              
83 3     3   51014 use strict;
  3         5  
  3         112  
84 3     3   11 use warnings;
  3         33  
  3         75  
85 3     3   12 use Carp;
  3         8  
  3         278  
86              
87             our $VERSION = '0.800';
88              
89 3     3   13 use constant SRL_UNCOMPRESSED => 0;
  3         3  
  3         202  
90 3     3   12 use constant SRL_SNAPPY => 1;
  3         3  
  3         118  
91 3     3   11 use constant SRL_ZLIB => 2;
  3         3  
  3         91  
92              
93 3     3   1410 use IO::File;
  3         21481  
  3         294  
94              
95 3     3   20 use Exporter 'import';
  3         4  
  3         934  
96             our @EXPORT_OK = qw(
97             SRL_UNCOMPRESSED
98             SRL_SNAPPY
99             SRL_ZLIB
100             create_header_data_template
101             );
102             our %EXPORT_TAGS = (all => \@EXPORT_OK);
103              
104             =head1 EXPORTED FUNCTIONS
105              
106             =head2 create_header_data_template
107              
108             Given a structure, will return a Sereal *body*, that can be used as value for
109             the C constructor option.
110              
111             This function loads C if it's not already loaded.
112              
113             =cut
114              
115             sub create_header_data_template {
116 0     0 1   require Sereal::Encoder;
117 0           require Sereal::Encoder::Constants;
118 0           my ($struct) = @_;
119 0           my $blob = Sereal::Encoder::encode_sereal_with_header_data(1, $struct);
120              
121              
122 0 0         my $fh = IO::File->new(\$blob, 'r')
123             or croak "failed to open blob";
124 0           $fh->binmode(':raw');
125              
126 0           my $length = 0;
127              
128             # magic
129 0           $length += $fh->read(my $magic, Sereal::Encoder::Constants::SRL_MAGIC_STRLEN());
130 0 0 0       $magic eq Sereal::Encoder::Constants::SRL_MAGIC_STRING() || $magic eq Sereal::Encoder::Constants::SRL_MAGIC_STRING_HIGHBIT()
131             or croak "invalid magic";
132              
133             # version-type
134 0           $length += $fh->read(my $version_type, 1);
135              
136 0           $blob = substr $blob, $length, -1;
137            
138 0           return $blob;
139             }
140              
141             sub new {
142 0     0 1   my ($class, $args) = @_;
143            
144 0 0         if ( my $header_data_template = $args->{header_data_template} ) {
145 0           my $str_to_replace = chr(0x68) . '__$CNT__';
146 0 0         if ( (my $where = index($header_data_template, $str_to_replace)) >= 0) {
147 0           my $l = length $str_to_replace;
148 0           my $copy = $header_data_template;
149 0           substr($copy, $where, $l, chr(0x20) . chr(0) x ($l-1) );
150 0           $args = { %{$args},
  0            
151             header_data_template => $copy,
152             header_count_idx => $where + 1,
153             };
154             }
155             }
156              
157 0           $class->new_xs($args);
158             }
159              
160 3     3   23 use XSLoader;
  3         3  
  3         125  
161              
162             XSLoader::load(__PACKAGE__, $Sereal::Splitter::VERSION);
163              
164             1;