File Coverage

blib/lib/MsgPack/Decoder.pm
Criterion Covered Total %
statement 49 49 100.0
branch 1 2 50.0
condition n/a
subroutine 13 13 100.0
pod 3 3 100.0
total 66 67 98.5


line stmt bran cond sub pod time code
1             package MsgPack::Decoder;
2             our $AUTHORITY = 'cpan:YANICK';
3             # ABSTRACT: Decode data from a MessagePack stream
4             $MsgPack::Decoder::VERSION = '2.0.3';
5              
6 4     4   57326 use 5.20.0;
  4         21  
7              
8 4     4   22 use strict;
  4         5  
  4         76  
9 4     4   16 use warnings;
  4         7  
  4         117  
10              
11 4     4   30 use Carp;
  4         9  
  4         247  
12              
13 4     4   1953 use List::AllUtils qw/ reduce first first_index any /;
  4         42206  
  4         346  
14              
15 4     4   1488 use MsgPack::Type::Boolean;
  4         9  
  4         147  
16 4     4   1841 use MsgPack::Decoder::Generator::Any;
  4         17  
  4         219  
17              
18 4     4   56 use Log::Any 1.701;
  4         118  
  4         31  
19              
20 4     4   179 use Moose;
  4         7  
  4         28  
21              
22             with 'Beam::Emitter';
23              
24 4     4   24398 use experimental 'signatures', 'postderef';
  4         9  
  4         33  
25              
26             has log => (
27             is => 'ro',
28             lazy =>1,
29             default => sub {
30             Log::Any->get_logger->clone( prefix => "[MsgPack::Decoder] ");
31             });
32              
33             has emitter => (
34             is => 'ro',
35             default => sub { 0 },
36             );
37              
38              
39             has generator => (
40             is => 'rw',
41             lazy => 1,
42             default => sub {
43             my $self = shift;
44            
45             MsgPack::Decoder::Generator::Any->new(
46             push_decoded => sub{ $self->add_to_buffer(@_) }
47             )
48             }
49             );
50              
51              
52 64     64 1 710 sub read($self,@values) {
  64         106  
  64         109  
  64         121  
53 64         2093 my $size = $self->buffer_size;
54              
55 64         1424 $self->generator(
56             $self->generator->read( join '', @values )
57             );
58              
59 64         1580 return $self->buffer_size - $size;
60             }
61              
62              
63              
64              
65             has buffer => (
66             is => 'rw',
67             traits => [ 'Array' ],
68             default => sub { [] },
69             handles => {
70             'has_buffer' => 'count',
71             'buffer_size' => 'count',
72             clear_buffer => 'clear',
73             next => 'shift',
74             all => 'elements',
75             add_to_buffer => 'push',
76             },
77             );
78              
79             after add_to_buffer => sub {
80             my ( $self, @values ) = @_;
81             $self->log->debugf( 'pushing to buffer: %s', \@values );
82             };
83              
84             # add the 'after' only if emitter is set to 1? for performance
85             after add_to_buffer => sub {
86             my $self = shift;
87              
88             return unless $self->emitter;
89              
90             require MsgPack::Decoder::Event::Decoded;
91            
92             my @elements = $self->all;
93             $self->clear_buffer;
94              
95             $self->emit( 'decoded', class => 'MsgPack::Decoder::Event::Decoded', payload => \@elements );
96             };
97              
98             after all => sub($self) {
99             $self->buffer([]);
100             };
101              
102              
103 2     2 1 1059 sub read_all($self,@vals){
  2         4  
  2         6  
  2         2  
104 2         9 $self->read(@vals);
105 2         10 $self->all;
106             }
107              
108              
109 37     37 1 10604 sub read_next($self,@vals){
  37         64  
  37         80  
  37         59  
110 37         126 $self->read(@vals);
111 37 50       1080 carp "buffer is empty" unless $self->has_buffer;
112 37         1010 $self->next;
113             }
114              
115             1;
116              
117             __END__
118              
119             =pod
120              
121             =encoding UTF-8
122              
123             =head1 NAME
124              
125             MsgPack::Decoder - Decode data from a MessagePack stream
126              
127             =head1 VERSION
128              
129             version 2.0.3
130              
131             =head1 SYNOPSIS
132              
133             use MsgPack::Decoder;
134              
135             use MsgPack::Encoder;
136             use Data::Printer;
137              
138             my $decoder = MsgPack::Decoder->new;
139              
140             my $msgpack_binary = MsgPack::Encoder->new(struct => [ "hello world" ] )->encoded;
141              
142             $decoder->read( $msgpack_binary );
143              
144             my $struct = $decode->next;
145              
146             p $struct; # prints [ 'hello world' ]
147              
148             =head2 DESCRIPTION
149              
150             C<MsgPack::Decoder> objects take in the raw binary representation of
151             one or more MessagePack data structures, and convert it back into their
152             Perl representations.
153              
154             =head2 METHODS
155              
156             =head3 new( %args )
157              
158             Constructor. Accepts the following arguments.
159              
160             =over
161              
162             =item emitter
163              
164             If sets to C<true>, incoming decoded data is immediately removed
165             from the buffer and broadcasted
166             via a C<decoded> event encapsulated in a L<MsgPack::Decoder::Event::Decoded> object.
167              
168             C<MsgPack::Decoder> consumes the L<Beam::Emitter> role and subscription/unsubscription
169             to the C<decoded> event is done via its methods.
170              
171             my $decoder = MsgPack::Decoder->new( emitter => 1 );
172             $decoder->on( 'decoded' => sub {
173             my $event = shift;
174             my @structs = $event->payload_list;
175             warn "we received ", scalar(@structs), " data structures";
176             });
177              
178             =back
179              
180             =head3 read( @binary_values )
181              
182             Reads in the raw binary to convert. The binary can be only a partial piece of the
183             encoded structures. If so, all structures that can be decoded will be
184             made available in the buffer, while the potentially last unterminated structure will
185             remain "in flight".
186              
187             Returns how many structures were decoded.
188              
189             =head3 has_buffer
190              
191             Returns the number of decoded structures currently waiting in the buffer.
192              
193             =head3 next
194              
195             Returns the next structure from the buffer.
196              
197             $decoder->read( $binary );
198              
199             while( $decoder->has_buffer ) {
200             my $next = $decoder->next;
201             do_stuff( $next );
202             }
203              
204             Note that the returned structure could be C<undef>, so don't do:
205              
206             $decoder->read( $binary );
207              
208             # NO! $next could be 'undef'
209             while( my $next = $decoder->next ) {
210             do_stuff( $next );
211             }
212              
213             =head3 all
214              
215             Returns (and flush from the buffer) all the currently available structures.
216              
217             =head3 read_all( @binaries )
218              
219             Reads the provided binary data and returns all structures decoded so far.
220              
221             @data = $decoder->read_all($binary);
222              
223             # equivalent to
224            
225             $decoder->read(@binaries);
226             @data = $decoder->all;
227              
228             =head3 read_next( @binaries )
229              
230             Reads the provided binary data and returns the next structure decoded so far.
231             If there is no data in the buffer, dies.
232              
233             $data = $decoder->read_next($binary);
234              
235             # roughly equivalent to
236            
237             $decoder->read(@binaries);
238             $data = $decoder->next or die;
239              
240             =head1 AUTHOR
241              
242             Yanick Champoux <yanick@cpan.org>
243              
244             =head1 COPYRIGHT AND LICENSE
245              
246             This software is copyright (c) 2019, 2017, 2016, 2015 by Yanick Champoux.
247              
248             This is free software; you can redistribute it and/or modify it under
249             the same terms as the Perl 5 programming language system itself.
250              
251             =cut