From 601209c83c11d9549eab86b708c6fe2f82d59f64 Mon Sep 17 00:00:00 2001
From: Tokuhiro Matsuno <tokuhirom@gmail.com>
Date: Thu, 2 Jul 2009 14:25:48 +0900
Subject: [PATCH] support $Data::MessagePack::PreferredInteger for Data::Model
---
perl/lib/Data/MessagePack.pm | 10 ++++++++++
perl/pack.c | 17 ++++++++++++++++
perl/t/05_preferred_int.t | 38 ++++++++++++++++++++++++++++++++++++
perl/t/data.pl | 5 ++++-
4 files changed, 69 insertions(+), 1 deletion(-)
create mode 100644 perl/t/05_preferred_int.t
diff --git a/perl/lib/Data/MessagePack.pm b/perl/lib/Data/MessagePack.pm
index cb3f73ac..082e2324 100644
--- a/perl/lib/Data/MessagePack.pm
+++ b/perl/lib/Data/MessagePack.pm
@@ -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
diff --git a/perl/pack.c b/perl/pack.c
index 5aec9632..aee3bd65 100644
--- a/perl/pack.c
+++ b/perl/pack.c
@@ -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;
diff --git a/perl/t/05_preferred_int.t b/perl/t/05_preferred_int.t
new file mode 100644
index 00000000..39167c12
--- /dev/null
+++ b/perl/t/05_preferred_int.t
@@ -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++];
+}
+
diff --git a/perl/t/data.pl b/perl/t/data.pl
index 1a2b2b4a..2f58d38c 100644
--- a/perl/t/data.pl
+++ b/perl/t/data.pl
@@ -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,
)