Hello community,
here is the log from the commit of package perl-Protocol-Redis for
openSUSE:Factory checked in at 2019-08-29 17:27:45
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/perl-Protocol-Redis (Old)
and /work/SRC/openSUSE:Factory/.perl-Protocol-Redis.new.7948 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-Protocol-Redis"
Thu Aug 29 17:27:45 2019 rev:2 rq:726983 version:1.0010
Changes:
--------
--- /work/SRC/openSUSE:Factory/perl-Protocol-Redis/perl-Protocol-Redis.changes
2019-02-01 11:49:03.384329999 +0100
+++
/work/SRC/openSUSE:Factory/.perl-Protocol-Redis.new.7948/perl-Protocol-Redis.changes
2019-08-29 17:27:47.619265319 +0200
@@ -1,0 +2,13 @@
+Thu Aug 29 05:33:07 UTC 2019 - Stephan Kulow <[email protected]>
+
+- updated to 1.0010
+ see /usr/share/doc/packages/perl-Protocol-Redis/Changes
+
+ 1.0010 28.08.2019 00:00:00
+ - code cleanup, prerequirements improvement, updated metadata to
+ meta-spec (Grinnz)
+ - tests improved with binary-safe encoding tests (Grinnz)
+ - optimize encode() (Grinnz)
+ - optimize parse() (jhthorsen)
+
+-------------------------------------------------------------------
Old:
----
Protocol-Redis-1.0006.tar.gz
New:
----
Protocol-Redis-1.0010.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ perl-Protocol-Redis.spec ++++++
--- /var/tmp/diff_new_pack.yfv6eO/_old 2019-08-29 17:27:50.787264826 +0200
+++ /var/tmp/diff_new_pack.yfv6eO/_new 2019-08-29 17:27:50.787264826 +0200
@@ -16,20 +16,22 @@
#
-%define cpan_name Protocol-Redis
Name: perl-Protocol-Redis
-Version: 1.0006
+Version: 1.0010
Release: 0
+%define cpan_name Protocol-Redis
Summary: Redis protocol parser/encoder with asynchronous capabilities
License: Artistic-1.0 OR GPL-1.0-or-later
Group: Development/Libraries/Perl
-URL: http://search.cpan.org/dist/Protocol-Redis/
+Url: https://metacpan.org/release/%{cpan_name}
Source0:
https://cpan.metacpan.org/authors/id/U/UN/UNDEF/%{cpan_name}-%{version}.tar.gz
Source1: cpanspec.yml
+BuildArch: noarch
+BuildRoot: %{_tmppath}/%{name}-%{version}-build
BuildRequires: perl
BuildRequires: perl-macros
-BuildRequires: perl(Test::More) >= 0.88
-BuildArch: noarch
+BuildRequires: perl(Test::More) >= 0.94
+Requires: perl(Test::More) >= 0.94
%{perl_requires}
%description
@@ -45,7 +47,7 @@
make %{?_smp_mflags}
%check
-make %{?_smp_mflags} test
+make test
%install
%perl_make_install
++++++ Protocol-Redis-1.0006.tar.gz -> Protocol-Redis-1.0010.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Protocol-Redis-1.0006/Changes
new/Protocol-Redis-1.0010/Changes
--- old/Protocol-Redis-1.0006/Changes 2017-05-03 11:49:40.000000000 +0200
+++ new/Protocol-Redis-1.0010/Changes 2019-08-28 19:49:45.000000000 +0200
@@ -1,5 +1,12 @@
This file documents the revision history for Perl extension Protocol::Redis
+1.0010 28.08.2019 00:00:00
+ - code cleanup, prerequirements improvement, updated metadata to
+ meta-spec (Grinnz)
+ - tests improved with binary-safe encoding tests (Grinnz)
+ - optimize encode() (Grinnz)
+ - optimize parse() (jhthorsen)
+
1.0006 03.05.2017 00:00:00
- fixed typo
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Protocol-Redis-1.0006/MANIFEST
new/Protocol-Redis-1.0010/MANIFEST
--- old/Protocol-Redis-1.0006/MANIFEST 2017-05-03 11:52:18.000000000 +0200
+++ new/Protocol-Redis-1.0010/MANIFEST 2019-08-28 21:17:50.000000000 +0200
@@ -1,11 +1,10 @@
-benchmark.pl
Changes
lib/Protocol/Redis.pm
lib/Protocol/Redis/Test.pm
Makefile.PL
MANIFEST This list of files
-META.yml
README
t/redis.t
xt/pod.t
+META.yml Module YAML meta-data (added by
MakeMaker)
META.json Module JSON meta-data (added by
MakeMaker)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Protocol-Redis-1.0006/META.json
new/Protocol-Redis-1.0010/META.json
--- old/Protocol-Redis-1.0006/META.json 2017-05-03 11:52:18.000000000 +0200
+++ new/Protocol-Redis-1.0010/META.json 2019-08-28 21:17:50.000000000 +0200
@@ -3,14 +3,14 @@
"author" : [
"Sergey Zasenko <[email protected]>"
],
- "dynamic_config" : 1,
- "generated_by" : "ExtUtils::MakeMaker version 7.04, CPAN::Meta::Converter
version 2.150001",
+ "dynamic_config" : 0,
+ "generated_by" : "ExtUtils::MakeMaker version 7.34, CPAN::Meta::Converter
version 2.150010",
"license" : [
"perl_5"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec";,
- "version" : "2"
+ "version" : 2
},
"name" : "Protocol-Redis",
"no_index" : {
@@ -22,8 +22,7 @@
"prereqs" : {
"build" : {
"requires" : {
- "ExtUtils::MakeMaker" : "0",
- "Test::More" : "0.88"
+ "ExtUtils::MakeMaker" : "0"
}
},
"configure" : {
@@ -34,7 +33,8 @@
"runtime" : {
"requires" : {
"Carp" : "0",
- "List::Util" : "0"
+ "Test::More" : "0.94",
+ "perl" : "5.008001"
}
}
},
@@ -47,8 +47,11 @@
"http://dev.perl.org/licenses/";
],
"repository" : {
- "url" : "https://github.com/und3f/protocol-redis";
+ "type" : "git",
+ "url" : "https://github.com/und3f/protocol-redis.git";,
+ "web" : "https://github.com/und3f/protocol-redis";
}
},
- "version" : 1.0006
+ "version" : "1.0010",
+ "x_serialization_backend" : "JSON::PP version 2.97001"
}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Protocol-Redis-1.0006/META.yml
new/Protocol-Redis-1.0010/META.yml
--- old/Protocol-Redis-1.0006/META.yml 2017-05-03 11:52:17.000000000 +0200
+++ new/Protocol-Redis-1.0010/META.yml 2019-08-28 21:17:50.000000000 +0200
@@ -4,11 +4,10 @@
- 'Sergey Zasenko <[email protected]>'
build_requires:
ExtUtils::MakeMaker: '0'
- Test::More: '0.88'
configure_requires:
ExtUtils::MakeMaker: '0'
-dynamic_config: 1
-generated_by: 'ExtUtils::MakeMaker version 7.04, CPAN::Meta::Converter version
2.150001'
+dynamic_config: 0
+generated_by: 'ExtUtils::MakeMaker version 7.34, CPAN::Meta::Converter version
2.150010'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
@@ -20,9 +19,11 @@
- inc
requires:
Carp: '0'
- List::Util: '0'
+ Test::More: '0.94'
+ perl: '5.008001'
resources:
bugtracker: https://github.com/und3f/protocol-redis/issues
license: http://dev.perl.org/licenses/
- repository: https://github.com/und3f/protocol-redis
-version: 1.0006
+ repository: https://github.com/und3f/protocol-redis.git
+version: '1.0010'
+x_serialization_backend: 'CPAN::Meta::YAML version 0.018'
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Protocol-Redis-1.0006/Makefile.PL
new/Protocol-Redis-1.0010/Makefile.PL
--- old/Protocol-Redis-1.0006/Makefile.PL 2017-05-03 11:45:47.000000000
+0200
+++ new/Protocol-Redis-1.0010/Makefile.PL 2019-08-28 19:00:25.000000000
+0200
@@ -1,4 +1,4 @@
-use 5.010001;
+use 5.008001;
use strict;
use warnings;
@@ -10,22 +10,26 @@
VERSION_FROM => 'lib/Protocol/Redis.pm',
ABSTRACT_FROM => 'lib/Protocol/Redis.pm',
AUTHOR => 'Sergey Zasenko <[email protected]>',
- LICENSE => 'perl',
+ LICENSE => 'perl_5',
META_MERGE => {
- resources => {
- license => 'http://dev.perl.org/licenses/',
- repository => 'https://github.com/und3f/protocol-redis',
- bugtracker => 'https://github.com/und3f/protocol-redis/issues',
+ dynamic_config => 0,
+ 'meta-spec' => { version => 2 },
+ resources => {
+ license => [ 'http://dev.perl.org/licenses/' ],
+ repository => {
+ type => 'git',
+ url => 'https://github.com/und3f/protocol-redis.git',
+ web => 'https://github.com/und3f/protocol-redis',
+ },
+ bugtracker => { web =>
'https://github.com/und3f/protocol-redis/issues' },
},
},
+ MIN_PERL_VERSION => '5.008001',
PREREQ_PM => {
'Carp' => 0,
- 'List::Util' => 0,
- },
- TEST_REQUIRES => {
- 'Test::More' => '0.88'
+ 'Test::More' => '0.94',
},
test => {TESTS => 't/*.t'},
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Protocol-Redis-1.0006/README
new/Protocol-Redis-1.0010/README
--- old/Protocol-Redis-1.0006/README 2017-05-03 11:49:57.000000000 +0200
+++ new/Protocol-Redis-1.0010/README 2019-08-28 21:10:27.000000000 +0200
@@ -99,8 +99,12 @@
Yaroslav Korshak (yko)
+ Dan Book (Grinnz)
+
+ Jan Henning Thorsen (jhthorsen)
+
COPYRIGHT AND LICENSE
- Copyright (C) 2011-2017, Sergey Zasenko.
+ Copyright (C) 2011-2019, Sergey Zasenko.
This program is free software, you can redistribute it and/or modify it
under the same terms as Perl 5.10.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Protocol-Redis-1.0006/benchmark.pl
new/Protocol-Redis-1.0010/benchmark.pl
--- old/Protocol-Redis-1.0006/benchmark.pl 2011-05-05 13:27:46.000000000
+0200
+++ new/Protocol-Redis-1.0010/benchmark.pl 1970-01-01 01:00:00.000000000
+0100
@@ -1,34 +0,0 @@
-#!/usr/bin/env perl
-
-use strict;
-use warnings;
-
-use Benchmark qw(:all :hireswallclock);
-
-use FindBin;
-use lib "$FindBin::Bin/lib";
-use Protocol::Redis;
-
-my $redis = Protocol::Redis->new(api => 1);
-
-$redis->on_message(sub { });
-
-my $status_message = $redis->encode({type => '+', data => 'OK'});
-timethese(
- 0,
- { '1. Status parse' => sub { $redis->parse($status_message) },
- '2. Splitted status parse' =>
- sub { $redis->parse("+OK"); $redis->parse("\r\n") },
- }
-);
-
-my $bulk_message = $redis->encode({type => '$', data => 'test'});
-timethese(0, {'1. Bulk parse' => sub { $redis->parse($bulk_message) },});
-
-my $mbulk_message = $redis->encode(
- { type => '*',
- data =>
- [{type => '$', data => 'test1'}, {type => '$', data => 'test2'}]
- }
-);
-timethese(0, {'Multi-Bulk parse' => sub { $redis->parse($mbulk_message) },});
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Protocol-Redis-1.0006/lib/Protocol/Redis/Test.pm
new/Protocol-Redis-1.0010/lib/Protocol/Redis/Test.pm
--- old/Protocol-Redis-1.0006/lib/Protocol/Redis/Test.pm 2012-02-03
02:28:58.000000000 +0100
+++ new/Protocol-Redis-1.0010/lib/Protocol/Redis/Test.pm 2019-08-28
21:02:24.000000000 +0200
@@ -26,7 +26,7 @@
my $redis_class = shift;
subtest 'Protocol::Redis APIv1 ok' => sub {
- plan tests => 39;
+ plan tests => 43;
use_ok $redis_class;
@@ -116,8 +116,8 @@
# Nil bulk message
$redis->parse("\$-1\r\n");
- is_deeply $redis->get_message,
- {type => '$', data => undef},
+ my $message = $redis->get_message;
+ ok defined($message) && !defined($message->{data}),
'nil bulk message';
# Two chunked bulk messages
@@ -165,8 +165,8 @@
'multi-bulk empty result';
$redis->parse("*-1\r\n");
- is_deeply $redis->get_message,
- {type => '*', data => undef},
+ my $message = $redis->get_message;
+ ok defined($message) && !defined($message->{data}),
'multi-bulk nil result';
# Does it work?
@@ -190,6 +190,39 @@
{type => '*', data => [{type => '$', data => 'test'}]};
is_deeply $redis->get_message, {type => '+', data => 'OK'};
+ # Another splitted multi-bulk message
+ $redis->parse("*4\r\n\$-1\r\n\$-1");
+ $redis->parse("\r\n\$5\r\ntest2\r\n");
+ $redis->parse("\$5\r\ntest3\r");
+ $redis->parse("\n");
+ is_deeply $redis->get_message, {
+ type => '*',
+ data => [
+ {type => '$', data => undef},
+ {type => '$', data => undef},
+ {type => '$', data => 'test2'},
+ {type => '$', data => 'test3'}
+ ]
+ };
+
+ # Complex string
+ $redis->parse("\*4\r\n");
+ $redis->parse("\$5\r\ntest1\r\n\$-1\r\n:test2\r\n+test3\r\n\$5\r\n123");
+ $redis->parse("45\r\n");
+ is_deeply $redis->get_message, {
+ type => '*',
+ data => [
+ {type => '$', data => 'test1'},
+ {type => '$', data => undef},
+ {type => ':', data => 'test2'},
+ {type => '+', data => 'test3'}
+ ]
+ };
+ is_deeply $redis->get_message, {
+ type => '$',
+ data => '12345',
+ };
+
# pipelined multi-bulk
$redis->parse(
join("\r\n",
@@ -249,6 +282,8 @@
# Encode bulk message
is $redis->encode({type => '$', data => 'test'}), "\$4\r\ntest\r\n",
'encode bulk';
+ is $redis->encode({type => '$', data => "\0\r\n"}), "\$3\r\n\0\r\n\r\n",
+ 'encode binary bulk';
is $redis->encode({type => '$', data => undef}), "\$-1\r\n",
'encode nil bulk';
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Protocol-Redis-1.0006/lib/Protocol/Redis.pm
new/Protocol-Redis-1.0010/lib/Protocol/Redis.pm
--- old/Protocol-Redis-1.0006/lib/Protocol/Redis.pm 2017-05-03
11:49:51.000000000 +0200
+++ new/Protocol-Redis-1.0010/lib/Protocol/Redis.pm 2019-08-28
21:16:24.000000000 +0200
@@ -4,7 +4,7 @@
use warnings;
use 5.008_001;
-our $VERSION = 1.0006;
+our $VERSION = '1.0010';
require Carp;
@@ -21,8 +21,6 @@
$self->on_message(delete $self->{on_message});
$self->{_messages} = [];
- $self->{_state} = \&_state_new_message;
-
$self;
}
@@ -32,253 +30,134 @@
$self->{api};
}
-my %message_type_encoders = (
- '+' => \&_encode_string,
- '-' => \&_encode_string,
- ':' => \&_encode_string,
- '$' => \&_encode_bulk,
- '*' => \&_encode_multi_bulk,
-);
+my %simple_types = ('+' => 1, '-' => 1, ':' => 1);
+my $rn = "\r\n";
sub encode {
- my ($self, $message) = @_;
-
- if (my $encoder = $message_type_encoders{$message->{type}}) {
- $encoder->($self, $message);
- }
- else {
- Carp::croak(qq/Unknown message type $message->{type}/);
- }
-}
-
-sub _encode_string {
- my ($self, $message) = @_;
-
- $message->{type} . $message->{data} . "\r\n";
-}
-
-sub _encode_bulk {
- my ($self, $message) = @_;
-
- my $data = $message->{data};
-
- return '$-1' . "\r\n"
- unless defined $data;
-
- '$' . length($data) . "\r\n" . $data . "\r\n";
-}
-
-sub _encode_multi_bulk {
- my ($self, $message) = @_;
-
- my $data = $message->{data};
-
- return '*-1' . "\r\n"
- unless defined $data;
+ my $self = shift;
- my $e_message = '*' . scalar(@$data) . "\r\n";
- foreach my $element (@$data) {
- $e_message .= $self->encode($element);
+ my $encoded_message = '';
+ while (@_) {
+ my $message = shift;
+
+ # Bulk string
+ if ($message->{type} eq '$') {
+ if (defined $message->{data}) {
+ $encoded_message .= '$' . length($message->{data}) . "\r\n" .
$message->{data} . "\r\n";
+ }
+ else {
+ $encoded_message .= "\$-1\r\n";
+ }
+ }
+ # Array (multi bulk)
+ elsif ($message->{type} eq '*') {
+ if (defined $message->{data}) {
+ $encoded_message .= '*' . scalar(@{$message->{data}}) . "\r\n";
+ unshift @_, @{$message->{data}};
+ }
+ else {
+ $encoded_message .= "*-1\r\n";
+ }
+ }
+ # String, error, integer
+ elsif (exists $simple_types{$message->{type}}) {
+ $encoded_message .= $message->{type} . $message->{data} . "\r\n";
+ }
+ else {
+ Carp::croak(qq/Unknown message type $message->{type}/);
+ }
}
- $e_message;
+ return $encoded_message;
}
-
sub get_message {
shift @{$_[0]->{_messages}};
}
sub on_message {
my ($self, $cb) = @_;
- $self->{_on_message_cb} = $cb;
+ $self->{_on_message_cb} = $cb || \&_gather_messages;
}
sub parse {
- my ($self, $chunk) = @_;
-
- # Pass chunk to current vertex.
- # Some vertices can return unparsed chunk. In this case
- # cycle will pass chunk to next vertex.
- 1 while $chunk = $self->{_state}->($self, $chunk);
-}
+ my $self = shift;
+ $self->{_buffer}.= shift;
-sub _message_parsed {
- my ($self, $chunk) = @_;
+ my $message = $self->{_message} ||= {};
+ my $buffer = \$self->{_buffer};
- my $message = delete $self->{_cmd};
-
- if (my $cb = $self->{_on_message_cb}) {
- $cb->($self, $message);
- }
- else {
- push @{$self->{_messages}}, $message;
- }
-
- $self->{_state} = \&_state_new_message;
- $chunk;
-}
-
-my %message_type_parsers = (
- '+' => \&_state_string_message,
- '-' => \&_state_string_message,
- ':' => \&_state_string_message,
- '$' => \&_state_bulk_message,
- '*' => \&_state_multibulk_message,
-);
-
-sub _state_parse_message_type {
- my ($self, $chunk) = @_;
-
- my $cmd = substr $chunk, 0, 1, '';
-
- if ($cmd) {
- if (my $parser = $message_type_parsers{$cmd}) {
- $self->{_cmd}{type} = $cmd;
- $self->{_state} = $parser;
- return $chunk;
+ CHUNK:
+ while ((my $pos = index($$buffer, "\r\n")) != -1) {
+ # Check our state: are we parsing new message or completing existing
+ if (!$message->{type}) {
+ if ($pos < 1) {
+ Carp::croak(qq/Unexpected input "$$buffer"/);
+ }
+
+ $message->{type} = substr $$buffer, 0, 1;
+ $message->{_argument} = substr $$buffer, 1, $pos - 1;
+ substr $$buffer, 0, $pos + 2, ''; # Remove type + argument + \r\n
}
- Carp::croak(qq/Unexpected input "$cmd"/);
- }
-}
-
-sub _state_new_message {
- my ($self, $chunk) = @_;
-
- $self->{_cmd} = {type => undef, data => undef};
-
- $self->{_state_cb} = \&_message_parsed;
-
- $self->{_state} = \&_state_parse_message_type;
- $chunk;
-}
-
-sub _state_string_message {
- my ($self, $chunk) = @_;
-
- my $str = $self->{_state_string} .= $chunk;
- my $i = index $str, "\r\n";
-
- # string isn't full
- return if $i < 0;
-
- # We got full string
- $self->{_cmd}{data} = substr $str, 0, $i, '';
-
- # Delete newline
- substr $str, 0, 2, '';
-
- delete $self->{_state_string};
-
- $self->{_state_cb}->($self, $str);
-}
-
-sub _state_bulk_message {
- my ($self, $chunk) = @_;
-
- my $bulk_state_cb = $self->{_state_cb};
-
- # Read bulk message size
- $self->{_state_cb} = sub {
- my ($self, $chunk) = @_;
-
- $self->{_bulk_size} = delete $self->{_cmd}{data};
-
- if ($self->{_bulk_size} == -1) {
-
- # Nil
- $self->{_cmd}{data} = undef;
- $bulk_state_cb->($self, $chunk);
+ # Simple Strings, Errors, Integers
+ if (exists $simple_types{$message->{type}}) {
+ $message->{data} = delete $message->{_argument};
}
- else {
- $self->{_state_cb} = $bulk_state_cb;
- $self->{_state} = \&_state_bulk_message_data;
- $chunk;
+ # Bulk Strings
+ elsif ($message->{type} eq '$') {
+ if ($message->{_argument} eq '-1') {
+ $message->{data} = undef;
+ }
+ elsif (length($$buffer) >= $message->{_argument} + 2) {
+ $message->{data} = substr $$buffer, 0, $message->{_argument},
'';
+ substr $$buffer, 0, 2, ''; # Remove \r\n
+ }
+ else {
+ return # Wait more data
+ }
}
- };
- $self->{_state} = \&_state_string_message;
- $chunk;
-}
-
-sub _state_bulk_message_data {
- my ($self, $chunk) = @_;
-
- my $str = $self->{_state_string} .= $chunk;
-
- # String + newline parsed
- return unless length $str >= $self->{_bulk_size} + 2;
-
- $self->{_cmd}{data} = substr $str, 0, $self->{_bulk_size}, '';
-
- # Delete ending newline
- substr $str, 0, 2, '';
-
- delete $self->{_state_string};
- delete $self->{_bulk_size};
-
- $self->{_state_cb}->($self, $str);
-}
-
-sub _state_multibulk_message {
- my ($self, $chunk) = @_;
-
- my $mbulk_state_cb = delete $self->{_state_cb};
- my $data = [];
- my $mbulk_process;
-
- my $arguments_num;
-
- $mbulk_process = sub {
- my ($self, $chunk) = @_;
-
- push @$data,
- { type => delete $self->{_cmd}{type},
- data => delete $self->{_cmd}{data}
- };
-
- if (scalar @$data == $arguments_num) {
-
- # Cleanup
- $mbulk_process = undef;
- delete $self->{_state_cb};
-
- # Return message
- $self->{_cmd}{type} = '*';
- $self->{_cmd}{data} = $data;
- $mbulk_state_cb->($self, $chunk);
+ # Arrays
+ elsif ($message->{type} eq '*') {
+ if ($message->{_argument} eq '-1') {
+ $message->{data} = undef;
+ } else {
+ $message->{data} = [];
+ if ($message->{_argument} > 0) {
+ $message = $self->{_message} = {_parent => $message};
+ next;
+ }
+ }
}
+ # Invalid input
else {
-
- # read next string
- $self->{_state_cb} = $mbulk_process;
- $self->{_state} = \&_state_parse_message_type;
- $chunk;
+ Carp::croak(qq/Unexpected input "$self->{_message}{type}"/);
}
- };
- $self->{_state_cb} = sub {
- my ($self, $chunk) = @_;
+ delete $message->{_argument};
+ delete $self->{_message};
- # Number of Multi-Bulk message
- $arguments_num = delete $self->{_cmd}{data};
- if ($arguments_num < 1) {
- $mbulk_process = undef;
- $self->{_cmd}{data} = $arguments_num == 0 ? [] : undef;
- $mbulk_state_cb->($self, $chunk);
+ # Fill parents with data
+ while (my $parent = delete $message->{_parent}) {
+ push @{$parent->{data}}, $message;
+
+ if (@{$parent->{data}} < $parent->{_argument}) {
+ $message = $self->{_message} = {_parent => $parent};
+ next CHUNK;
+ }
+ else {
+ $message = $parent;
+ delete $parent->{_argument};
+ }
}
- else {
- # We got messages
- $self->{_state_cb} = $mbulk_process;
- $self->{_state} = \&_state_parse_message_type;
- $chunk;
- }
- };
+ $self->{_on_message_cb}->($self, $message);
+ $message = $self->{_message} = {};
+ }
+}
- # Get number of messages
- $self->{_state} = \&_state_string_message;
- $chunk;
+sub _gather_messages {
+ push @{$_[0]->{_messages}}, $_[1];
}
1;
@@ -402,11 +281,15 @@
Yaroslav Korshak (yko)
+Dan Book (Grinnz)
+
+Jan Henning Thorsen (jhthorsen)
+
=back
=head1 COPYRIGHT AND LICENSE
-Copyright (C) 2011-2017, Sergey Zasenko.
+Copyright (C) 2011-2019, Sergey Zasenko.
This program is free software, you can redistribute it and/or modify it under
the same terms as Perl 5.10.
