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 cb3f73a..082e232 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 5aec963..aee3bd6 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 0000000..39167c1
--- /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 1a2b2b4..2f58d38 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,
 )