generic-library/msgpack
1
0
Fork 0
mirror of https://github.com/msgpack/msgpack-c.git synced 2025-03-19 21:18:23 +01:00
Code Issues Projects Releases Wiki Activity

support $Data::MessagePack::PreferredInteger for Data::Model

Browse Source
This commit is contained in:
Tokuhiro Matsuno 2009-07-02 14:25:48 +09:00
parent c2a63b2c54
commit 601209c83c
4 changed files with 69 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
perl/lib/Data/MessagePack.pm
View File

@ -24,6 +24,16 @@ Data::MessagePack - messagepack
Data::MessagePack is a binary packer for perl.
=head1 Configuration Variables
=over 4
=item $Data::MessagePack::PreferredInteger
Pack the string as int when the value looks like int(EXPERIMENTAL).
=back
=head1 AUTHORS
Tokuhiro Matsuno

17
perl/pack.c
View File

@ -51,6 +51,16 @@ void need(enc_t *enc, STRLEN len)
}
}
static int looks_like_int(const char *str, size_t len) {
int i;
for (i=0; i<len; i++) {
if (!isDIGIT(str[i])) {
return 0;
}
}
return 1;
}
static void _msgpack_pack_sv(enc_t *enc, SV* val) {
if (val==NULL) {
msgpack_pack_nil(enc);
@ -121,6 +131,13 @@ static void _msgpack_pack_sv(enc_t *enc, SV* val) {
if (SvPOKp(val)) {
STRLEN len;
char * cval = SvPV(val, len);
SV* pref_int = get_sv("Data::MessagePack::PreferredInteger", 0);
if (pref_int && SvTRUE(pref_int) && looks_like_int(cval, len) && SvUV(val) < U32_MAX) {
PACK_WRAPPER(uint32)(enc, SvUV(val));
return;
}
msgpack_pack_raw(enc, len);
msgpack_pack_raw_body(enc, cval, len);
return;

38
perl/t/05_preferred_int.t Normal file
View File

@ -0,0 +1,38 @@
use t::Util;
use Test::More;
use Data::MessagePack;
use Data::Dumper;
no warnings; # shut up "Integer overflow in hexadecimal number"
sub packit {
local $_ = unpack("H*", Data::MessagePack->pack($_[0]));
s/(..)/$1 /g;
s/ $//;
$_;
}
sub pis ($$) {
is packit($_[0]), $_[1], 'dump ' . $_[1];
# is(Dumper(Data::MessagePack->unpack(Data::MessagePack->pack($_[0]))), Dumper($_[0]));
}
my @dat = (
'0', '00',
'1', '01',
'10', '0a',
''.0xEFFF => 'cd ef ff',
''.0xFFFF => 'cd ff ff',
''.0xFFFFFF => 'ce 00 ff ff ff',
''.0xFFFFFFFF => 'aa 34 32 39 34 39 36 37 32 39 35',
''.0xFFFFFFFFF => 'ab 36 38 37 31 39 34 37 36 37 33 35',
''.0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFF => 'b4 38 2e 33 30 37 36 37 34 39 37 33 36 35 35 37 32 65 2b 33 34',
{'0' => '1'}, '81 00 01',
{'abc' => '1'}, '81 a3 61 62 63 01',
);
plan tests => 1*(scalar(@dat)/2);
$Data::MessagePack::PreferredInteger = 1;
for (my $i=0; $i<scalar(@dat); ) {
pis $dat[$i++], $dat[$i++];
}

5
perl/t/data.pl
View File

@ -1,4 +1,4 @@
no warnings 'uninitialized'; # i need this. i need this.
no warnings; # i need this, i need this.
(
'93 c0 c2 c3' => [undef, false, true],
'94 a0 a1 61 a2 62 63 a3 64 65 66', ["", "a", "bc", "def"],
@ -12,4 +12,7 @@ no warnings 'uninitialized'; # i need this. i need this.
'99 d0 00 d0 80 d0 ff d1 00 00 d1 80 00 d1 ff ff d2 00 00 00 00 d2 80 00 00 00 d2 ff ff ff ff', [0, -128, -1, 0, -32768, -1, 0, -2147483648, -1],
'82 c2 81 c0 c0 c3 81 c0 80', {false,{undef,undef}, true,{undef,{}}},
'96 de 00 00 de 00 01 c0 c2 de 00 02 c0 c2 c3 c2 df 00 00 00 00 df 00 00 00 01 c0 c2 df 00 00 00 02 c0 c2 c3 c2', [{}, {undef,false}, {true,false, undef,false}, {}, {undef,false}, {true,false, undef,false}],
'ce 00 ff ff ff' => ''.0xFFFFFF,
'aa 34 32 39 34 39 36 37 32 39 35' => ''.0xFFFFFFFF,
'ab 36 38 37 31 39 34 37 36 37 33 35' => ''.0xFFFFFFFFF,
)