generic-library/msgpack
1
0
Fork 0
mirror of https://github.com/msgpack/msgpack-c.git synced 2025-03-26 11:46:34 +01:00
Code Issues Projects Releases Wiki Activity

Merge pull request from cho45/canonical

Browse Source 
perl: Implemented canonical mode.
This commit is contained in:
Fuji, Goro 2011-08-18 18:06:54 -07:00
commit 6f043e3326
4 changed files with 65 additions and 4 deletions
perl
lib/Data
MessagePack.pm
MessagePack
PP.pm
t
17_canonical.t
xs-src
pack.c

1
perl/lib/Data/MessagePack.pm

@ -5,6 +5,7 @@ use 5.008001;
our $VERSION = '0.34'; our $VERSION = '0.34';
our $PreferInteger = 0; our $PreferInteger = 0;
our $Canonical = 0;
sub true () { sub true () {
require Data::MessagePack::Boolean; require Data::MessagePack::Boolean;

5
perl/lib/Data/MessagePack/PP.pm

@ -182,8 +182,13 @@ sub _pack {
: $num < 2 ** 32 - 1 ? CORE::pack( 'CN', 0xdf, $num ) : $num < 2 ** 32 - 1 ? CORE::pack( 'CN', 0xdf, $num )
: _unexpected("number %d", $num) : _unexpected("number %d", $num)
; ;
if ($Data::MessagePack::Canonical) {
return join( '', $header, map { _pack( $_ ), _pack($value->{$_}) } sort { $a cmp $b } keys %$value );
} else {
return join( '', $header, map { _pack( $_ ) } %$value ); return join( '', $header, map { _pack( $_ ) } %$value );
} }
}
elsif ( ref( $value ) eq 'Data::MessagePack::Boolean' ) { elsif ( ref( $value ) eq 'Data::MessagePack::Boolean' ) {
return CORE::pack( 'C', ${$value} ? 0xc3 : 0xc2 ); return CORE::pack( 'C', ${$value} ? 0xc3 : 0xc2 );

32
perl/t/17_canonical.t Normal file

@ -0,0 +1,32 @@
use strict;
use warnings;
use Test::More;
use Data::MessagePack;
$Data::MessagePack::Canonical = 1;
my $data = {
'foo' => {
'a' => '',
'b' => '',
'c' => '',
'd' => '',
'e' => '',
'f' => '',
'g' => '',
}
};
my $packed1 = +Data::MessagePack->pack($data);
my $packed2 = +Data::MessagePack->pack(Data::MessagePack->unpack($packed1));
my $packed3 = +Data::MessagePack->pack(Data::MessagePack->unpack($packed2));
my $packed4 = +Data::MessagePack->pack(Data::MessagePack->unpack($packed3));
my $packed5 = +Data::MessagePack->pack(Data::MessagePack->unpack($packed4));
is $packed1, $packed2;
is $packed1, $packed3;
is $packed1, $packed4;
is $packed1, $packed5;
done_testing;

23
perl/xs-src/pack.c

@ -211,10 +211,33 @@ STATIC_INLINE void _msgpack_pack_rv(enc_t *enc, SV* sv, int depth) {
msgpack_pack_map(enc, count); msgpack_pack_map(enc, count);
if (SvTRUE(get_sv("Data::MessagePack::Canonical", 0))) {
AV* keys = newAV();
av_extend(keys, count);
while ((he = hv_iternext(hval))) {
av_push(keys, SvREFCNT_inc(hv_iterkeysv(he)));
}
int len = av_len(keys) + 1;
sortsv(AvARRAY(keys), len, Perl_sv_cmp);
int i;
for (i=0; i<len; i++) {
SV** svp = av_fetch(keys, i, FALSE);
he = hv_fetch_ent(hval, *svp, 0, 0);
_msgpack_pack_sv(enc, hv_iterkeysv(he), depth);
_msgpack_pack_sv(enc, HeVAL(he), depth);
}
av_undef(keys);
} else {
while ((he = hv_iternext(hval))) { while ((he = hv_iternext(hval))) {
_msgpack_pack_sv(enc, hv_iterkeysv(he), depth); _msgpack_pack_sv(enc, hv_iterkeysv(he), depth);
_msgpack_pack_sv(enc, HeVAL(he), depth); _msgpack_pack_sv(enc, HeVAL(he), depth);
} }
}
} else if (svt == SVt_PVAV) { } else if (svt == SVt_PVAV) {
AV* ary = (AV*)sv; AV* ary = (AV*)sv;
int len = av_len(ary) + 1; int len = av_len(ary) + 1;