Merge branch 'master' of http://github.com/msgpack/msgpack

cpp/ChangeLog

@@ -1,4 +1,16 @@
 
+2010-08-29 version 0.5.4:
+
+  * includes msgpack_vc2008.vcproj file in source package
+  * fixes type::fix_int types
+
+2010-08-27 version 0.5.3:
+
+  * adds type::fix_{u,}int{8,16,32,64} types
+  * adds msgpack_pack_fix_{u,}int{8,16,32,64} functions
+  * adds packer<Stream>::pack_fix_{u,}int{8,16,32,64} functions
+  * fixes include paths
+
 2010-07-14 version 0.5.2:
 
   * type::raw::str(), operator==, operator!=, operator< and operator> are now const

cpp/Makefile.am

@@ -6,7 +6,9 @@ DOC_FILES = \
 		NOTICE \
 		msgpack_vc8.vcproj \
 		msgpack_vc8.sln \
-		msgpack_vc8.postbuild.bat
+		msgpack_vc2008.vcproj \
+		msgpack_vc2008.sln \
+		msgpack_vc.postbuild.bat
 
 EXTRA_DIST = \
 		$(DOC_FILES)

cpp/README.md

@@ -13,9 +13,10 @@ On UNIX-like platform, run ./configure && make && sudo make install:
     $ make
     $ sudo make install
 
-On Windows, open msgpack_vc8.vcproj file and build it using batch build. DLLs are built on lib folder, and the headers are built on include folder.
+On Windows, open msgpack_vc8.vcproj or msgpack_vc2008 file and build it using batch build. DLLs are built on lib folder,
+and the headers are built on include folder.
 
-To use the library in your program, include msgpack.hpp header and link msgpack and msgpackc library.
+To use the library in your program, include msgpack.hpp header and link "msgpack" library.
 
 
 ## Example
@@ -34,15 +35,9 @@ To use the library in your program, include msgpack.hpp header and link msgpack
         msgpack::pack(&buffer, target);
     
         // Deserialize the serialized data.
-        msgpack::zone mempool;    // this manages the life of deserialized object
-        msgpack::object obj;
-        msgpack::unpack_return ret =
-                msgpack::unpack(buffer.data, buffer.size, NULL, &mempool, &obj);
-    
-        if(ret != msgapck::UNPACK_SUCCESS) {
-            // error check
-            exit(1);
-        }
+        msgpack::unpacked msg;    // includes memory pool and deserialized object
+        msgpack::unpack(&msg, sbuf.data(), sbuf.size());
+        msgpack::object obj = msg.get();
     
         // Print the deserialized object to stdout.
         std::cout << obj << std::endl;    // ["Hello," "World!"]
@@ -55,24 +50,24 @@ To use the library in your program, include msgpack.hpp header and link msgpack
         obj.as<int>();  // type is mismatched, msgpack::type_error is thrown
     }
 
-API document and other example codes are available at the [wiki.](http://msgpack.sourceforge.net/start)
+API documents and other example codes are available at the [wiki.](http://redmine.msgpack.org/projects/msgpack/wiki)
 
 
 ## License
 
-Copyright (C) 2008-2010 FURUHASHI Sadayuki
-
-   Licensed under the Apache License, Version 2.0 (the "License");
-   you may not use this file except in compliance with the License.
-   You may obtain a copy of the License at
-
-       http://www.apache.org/licenses/LICENSE-2.0
-
-   Unless required by applicable law or agreed to in writing, software
-   distributed under the License is distributed on an "AS IS" BASIS,
-   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-   See the License for the specific language governing permissions and
-   limitations under the License.
+    Copyright (C) 2008-2010 FURUHASHI Sadayuki
+    
+       Licensed under the Apache License, Version 2.0 (the "License");
+       you may not use this file except in compliance with the License.
+       You may obtain a copy of the License at
+    
+           http://www.apache.org/licenses/LICENSE-2.0
+    
+       Unless required by applicable law or agreed to in writing, software
+       distributed under the License is distributed on an "AS IS" BASIS,
+       WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+       See the License for the specific language governing permissions and
+       limitations under the License.
 
 See also NOTICE file.
 

cpp/configure.in

@@ -1,6 +1,6 @@
 AC_INIT(src/object.cpp)
 AC_CONFIG_AUX_DIR(ac)
-AM_INIT_AUTOMAKE(msgpack, 0.5.2)
+AM_INIT_AUTOMAKE(msgpack, 0.5.4)
 AC_CONFIG_HEADER(config.h)
 
 AC_SUBST(CFLAGS)

cpp/msgpack_vc.postbuild.bat

@@ -26,10 +26,11 @@ copy src\msgpack\object.hpp            include\msgpack\
 copy src\msgpack\zone.hpp              include\msgpack\
 copy src\msgpack\type.hpp              include\msgpack\type\
 copy src\msgpack\type\bool.hpp         include\msgpack\type\
+copy src\msgpack\type\deque.hpp        include\msgpack\type\
+copy src\msgpack\type\fixint.hpp       include\msgpack\type\
 copy src\msgpack\type\float.hpp        include\msgpack\type\
 copy src\msgpack\type\int.hpp          include\msgpack\type\
 copy src\msgpack\type\list.hpp         include\msgpack\type\
-copy src\msgpack\type\deque.hpp        include\msgpack\type\
 copy src\msgpack\type\map.hpp          include\msgpack\type\
 copy src\msgpack\type\nil.hpp          include\msgpack\type\
 copy src\msgpack\type\pair.hpp         include\msgpack\type\

cpp/msgpack_vc8.vcproj

@@ -28,7 +28,7 @@
 			<Tool
 				Name="VCCustomBuildTool"
 				Description="Gathering header files"
-				CommandLine="msgpack_vc8.postbuild.bat"
+				CommandLine="msgpack_vc.postbuild.bat"
 				Outputs="include"
 			/>
 			<Tool
@@ -96,7 +96,7 @@
 			<Tool
 				Name="VCCustomBuildTool"
 				Description="Gathering header files"
-				CommandLine="msgpack_vc8.postbuild.bat"
+				CommandLine="msgpack_vc.postbuild.bat"
 				Outputs="include"
 			/>
 			<Tool

cpp/preprocess

@@ -29,3 +29,6 @@ cp -f ../msgpack/unpack_template.h src/msgpack/
 cp -f ../test/cases.mpac           test/
 cp -f ../test/cases_compact.mpac   test/
 
+sed -e 's/8\.00/9.00/' < msgpack_vc8.vcproj > msgpack_vc2008.vcproj
+sed -e 's/9\.00/10.00/' -e 's/msgpack_vc8/msgpack_vc2008/' < msgpack_vc8.sln > msgpack_vc2008.sln
+

cpp/src/Makefile.am

@@ -58,10 +58,11 @@ nobase_include_HEADERS += \
 		msgpack/zone.hpp \
 		msgpack/type.hpp \
 		msgpack/type/bool.hpp \
+		msgpack/type/deque.hpp \
 		msgpack/type/float.hpp \
+		msgpack/type/fixint.hpp \
 		msgpack/type/int.hpp \
 		msgpack/type/list.hpp \
-		msgpack/type/deque.hpp \
 		msgpack/type/map.hpp \
 		msgpack/type/nil.hpp \
 		msgpack/type/pair.hpp \

cpp/src/msgpack/object.h

@@ -18,7 +18,7 @@
 #ifndef MSGPACK_OBJECT_H__
 #define MSGPACK_OBJECT_H__
 
-#include "msgpack/zone.h"
+#include "zone.h"
 #include <stdio.h>
 
 #ifdef __cplusplus

cpp/src/msgpack/object.hpp

@@ -18,9 +18,9 @@
 #ifndef MSGPACK_OBJECT_HPP__
 #define MSGPACK_OBJECT_HPP__
 
-#include "msgpack/object.h"
-#include "msgpack/pack.hpp"
-#include "msgpack/zone.hpp"
+#include "object.h"
+#include "pack.hpp"
+#include "zone.hpp"
 #include <string.h>
 #include <stdexcept>
 #include <typeinfo>

cpp/src/msgpack/pack.h

@@ -18,8 +18,8 @@
 #ifndef MSGPACK_PACK_H__
 #define MSGPACK_PACK_H__
 
-#include "msgpack/pack_define.h"
-#include "msgpack/object.h"
+#include "pack_define.h"
+#include "object.h"
 #include <stdlib.h>
 
 #ifdef __cplusplus
@@ -70,6 +70,15 @@ static int msgpack_pack_int16(msgpack_packer* pk, int16_t d);
 static int msgpack_pack_int32(msgpack_packer* pk, int32_t d);
 static int msgpack_pack_int64(msgpack_packer* pk, int64_t d);
 
+static int msgpack_pack_fix_uint8(msgpack_packer* pk, uint8_t d);
+static int msgpack_pack_fix_uint16(msgpack_packer* pk, uint16_t d);
+static int msgpack_pack_fix_uint32(msgpack_packer* pk, uint32_t d);
+static int msgpack_pack_fix_uint64(msgpack_packer* pk, uint64_t d);
+static int msgpack_pack_fix_int8(msgpack_packer* pk, int8_t d);
+static int msgpack_pack_fix_int16(msgpack_packer* pk, int16_t d);
+static int msgpack_pack_fix_int32(msgpack_packer* pk, int32_t d);
+static int msgpack_pack_fix_int64(msgpack_packer* pk, int64_t d);
+
 static int msgpack_pack_float(msgpack_packer* pk, float d);
 static int msgpack_pack_double(msgpack_packer* pk, double d);
 
@@ -96,12 +105,18 @@ int msgpack_pack_object(msgpack_packer* pk, msgpack_object d);
 #define msgpack_pack_inline_func_cint(name) \
 	inline int msgpack_pack ## name
 
+#define msgpack_pack_inline_func_cint(name) \
+	inline int msgpack_pack ## name
+
+#define msgpack_pack_inline_func_fixint(name) \
+	inline int msgpack_pack_fix ## name
+
 #define msgpack_pack_user msgpack_packer*
 
 #define msgpack_pack_append_buffer(user, buf, len) \
 	return (*(user)->callback)((user)->data, (const char*)buf, len)
 
-#include "msgpack/pack_template.h"
+#include "pack_template.h"
 
 inline void msgpack_packer_init(msgpack_packer* pk, void* data, msgpack_packer_write callback)
 {

cpp/src/msgpack/pack.hpp

@@ -18,7 +18,7 @@
 #ifndef MSGPACK_PACK_HPP__
 #define MSGPACK_PACK_HPP__
 
-#include "msgpack/pack_define.h"
+#include "pack_define.h"
 #include <stdexcept>
 #include <limits.h>
 
@@ -45,6 +45,15 @@ public:
 	packer<Stream>& pack_int32(int32_t d);
 	packer<Stream>& pack_int64(int64_t d);
 
+	packer<Stream>& pack_fix_uint8(uint8_t d);
+	packer<Stream>& pack_fix_uint16(uint16_t d);
+	packer<Stream>& pack_fix_uint32(uint32_t d);
+	packer<Stream>& pack_fix_uint64(uint64_t d);
+	packer<Stream>& pack_fix_int8(int8_t d);
+	packer<Stream>& pack_fix_int16(int16_t d);
+	packer<Stream>& pack_fix_int32(int32_t d);
+	packer<Stream>& pack_fix_int64(int64_t d);
+
 	packer<Stream>& pack_short(short d);
 	packer<Stream>& pack_int(int d);
 	packer<Stream>& pack_long(long d);
@@ -78,6 +87,15 @@ private:
 	static void _pack_int32(Stream& x, int32_t d);
 	static void _pack_int64(Stream& x, int64_t d);
 
+	static void _pack_fix_uint8(Stream& x, uint8_t d);
+	static void _pack_fix_uint16(Stream& x, uint16_t d);
+	static void _pack_fix_uint32(Stream& x, uint32_t d);
+	static void _pack_fix_uint64(Stream& x, uint64_t d);
+	static void _pack_fix_int8(Stream& x, int8_t d);
+	static void _pack_fix_int16(Stream& x, int16_t d);
+	static void _pack_fix_int32(Stream& x, int32_t d);
+	static void _pack_fix_int64(Stream& x, int64_t d);
+
 	static void _pack_short(Stream& x, short d);
 	static void _pack_int(Stream& x, int d);
 	static void _pack_long(Stream& x, long d);
@@ -133,11 +151,15 @@ inline void pack(Stream& s, const T& v)
 	template <typename Stream> \
 	inline void packer<Stream>::_pack ## name
 
+#define msgpack_pack_inline_func_fixint(name) \
+	template <typename Stream> \
+	inline void packer<Stream>::_pack_fix ## name
+
 #define msgpack_pack_user Stream&
 
 #define msgpack_pack_append_buffer append_buffer
 
-#include "msgpack/pack_template.h"
+#include "pack_template.h"
 
 
 template <typename Stream>
@@ -149,6 +171,7 @@ packer<Stream>::packer(Stream& s) : m_stream(s) { }
 template <typename Stream>
 packer<Stream>::~packer() { }
 
+
 template <typename Stream>
 inline packer<Stream>& packer<Stream>::pack_uint8(uint8_t d)
 { _pack_uint8(m_stream, d); return *this; }
@@ -182,6 +205,39 @@ inline packer<Stream>& packer<Stream>::pack_int64(int64_t d)
 { _pack_int64(m_stream, d); return *this;}
 
 
+template <typename Stream>
+inline packer<Stream>& packer<Stream>::pack_fix_uint8(uint8_t d)
+{ _pack_fix_uint8(m_stream, d); return *this; }
+
+template <typename Stream>
+inline packer<Stream>& packer<Stream>::pack_fix_uint16(uint16_t d)
+{ _pack_fix_uint16(m_stream, d); return *this; }
+
+template <typename Stream>
+inline packer<Stream>& packer<Stream>::pack_fix_uint32(uint32_t d)
+{ _pack_fix_uint32(m_stream, d); return *this; }
+
+template <typename Stream>
+inline packer<Stream>& packer<Stream>::pack_fix_uint64(uint64_t d)
+{ _pack_fix_uint64(m_stream, d); return *this; }
+
+template <typename Stream>
+inline packer<Stream>& packer<Stream>::pack_fix_int8(int8_t d)
+{ _pack_fix_int8(m_stream, d); return *this; }
+
+template <typename Stream>
+inline packer<Stream>& packer<Stream>::pack_fix_int16(int16_t d)
+{ _pack_fix_int16(m_stream, d); return *this; }
+
+template <typename Stream>
+inline packer<Stream>& packer<Stream>::pack_fix_int32(int32_t d)
+{ _pack_fix_int32(m_stream, d); return *this; }
+
+template <typename Stream>
+inline packer<Stream>& packer<Stream>::pack_fix_int64(int64_t d)
+{ _pack_fix_int64(m_stream, d); return *this;}
+
+
 template <typename Stream>
 inline packer<Stream>& packer<Stream>::pack_short(short d)
 { _pack_short(m_stream, d); return *this; }

cpp/src/msgpack/sbuffer.hpp

@@ -18,7 +18,7 @@
 #ifndef MSGPACK_SBUFFER_HPP__
 #define MSGPACK_SBUFFER_HPP__
 
-#include "msgpack/sbuffer.h"
+#include "sbuffer.h"
 #include <stdexcept>
 
 namespace msgpack {

cpp/src/msgpack/type.hpp

@@ -1,15 +1,16 @@
-#include "msgpack/type/bool.hpp"
-#include "msgpack/type/float.hpp"
-#include "msgpack/type/int.hpp"
-#include "msgpack/type/list.hpp"
-#include "msgpack/type/deque.hpp"
-#include "msgpack/type/map.hpp"
-#include "msgpack/type/nil.hpp"
-#include "msgpack/type/pair.hpp"
-#include "msgpack/type/raw.hpp"
-#include "msgpack/type/set.hpp"
-#include "msgpack/type/string.hpp"
-#include "msgpack/type/vector.hpp"
-#include "msgpack/type/tuple.hpp"
-#include "msgpack/type/define.hpp"
+#include "type/bool.hpp"
+#include "type/deque.hpp"
+#include "type/fixint.hpp"
+#include "type/float.hpp"
+#include "type/int.hpp"
+#include "type/list.hpp"
+#include "type/map.hpp"
+#include "type/nil.hpp"
+#include "type/pair.hpp"
+#include "type/raw.hpp"
+#include "type/set.hpp"
+#include "type/string.hpp"
+#include "type/vector.hpp"
+#include "type/tuple.hpp"
+#include "type/define.hpp"
 

cpp/src/msgpack/type/fixint.hpp

@@ -0,0 +1,172 @@
+//
+// MessagePack for C++ static resolution routine
+//
+// Copyright (C) 2020 FURUHASHI Sadayuki
+//
+//    Licensed under the Apache License, Version 2.0 (the "License");
+//    you may not use this file except in compliance with the License.
+//    You may obtain a copy of the License at
+//
+//        http://www.apache.org/licenses/LICENSE-2.0
+//
+//    Unless required by applicable law or agreed to in writing, software
+//    distributed under the License is distributed on an "AS IS" BASIS,
+//    WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+//    See the License for the specific language governing permissions and
+//    limitations under the License.
+//
+#ifndef MSGPACK_TYPE_FIXINT_HPP__
+#define MSGPACK_TYPE_FIXINT_HPP__
+
+#include "msgpack/object.hpp"
+#include "msgpack/type/int.hpp"
+
+namespace msgpack {
+
+namespace type {
+
+
+template <typename T>
+struct fix_int {
+	fix_int() : value(0) { }
+	fix_int(T value) : value(value) { }
+
+	operator T() const { return value; }
+
+	T get() const { return value; }
+
+private:
+	T value;
+};
+
+
+typedef fix_int<uint8_t>  fix_uint8;
+typedef fix_int<uint16_t> fix_uint16;
+typedef fix_int<uint32_t> fix_uint32;
+typedef fix_int<uint64_t> fix_uint64;
+
+typedef fix_int<int8_t>  fix_int8;
+typedef fix_int<int16_t> fix_int16;
+typedef fix_int<int32_t> fix_int32;
+typedef fix_int<int64_t> fix_int64;
+
+
+}  // namespace type
+
+
+inline type::fix_int8& operator>> (object o, type::fix_int8& v)
+	{ v = type::detail::convert_integer<int8_t>(o); return v; }
+
+inline type::fix_int16& operator>> (object o, type::fix_int16& v)
+	{ v = type::detail::convert_integer<int16_t>(o); return v; }
+
+inline type::fix_int32& operator>> (object o, type::fix_int32& v)
+	{ v = type::detail::convert_integer<int32_t>(o); return v; }
+
+inline type::fix_int64& operator>> (object o, type::fix_int64& v)
+	{ v = type::detail::convert_integer<int64_t>(o); return v; }
+
+
+inline type::fix_uint8& operator>> (object o, type::fix_uint8& v)
+	{ v = type::detail::convert_integer<uint8_t>(o); return v; }
+
+inline type::fix_uint16& operator>> (object o, type::fix_uint16& v)
+	{ v = type::detail::convert_integer<uint16_t>(o); return v; }
+
+inline type::fix_uint32& operator>> (object o, type::fix_uint32& v)
+	{ v = type::detail::convert_integer<uint32_t>(o); return v; }
+
+inline type::fix_uint64& operator>> (object o, type::fix_uint64& v)
+	{ v = type::detail::convert_integer<uint64_t>(o); return v; }
+
+
+template <typename Stream>
+inline packer<Stream>& operator<< (packer<Stream>& o, const type::fix_int8& v)
+	{ o.pack_fix_int8(v); return o; }
+
+template <typename Stream>
+inline packer<Stream>& operator<< (packer<Stream>& o, const type::fix_int16& v)
+	{ o.pack_fix_int16(v); return o; }
+
+template <typename Stream>
+inline packer<Stream>& operator<< (packer<Stream>& o, const type::fix_int32& v)
+	{ o.pack_fix_int32(v); return o; }
+
+template <typename Stream>
+inline packer<Stream>& operator<< (packer<Stream>& o, const type::fix_int64& v)
+	{ o.pack_fix_int64(v); return o; }
+
+
+template <typename Stream>
+inline packer<Stream>& operator<< (packer<Stream>& o, const type::fix_uint8& v)
+	{ o.pack_fix_uint8(v); return o; }
+
+template <typename Stream>
+inline packer<Stream>& operator<< (packer<Stream>& o, const type::fix_uint16& v)
+	{ o.pack_fix_uint16(v); return o; }
+
+template <typename Stream>
+inline packer<Stream>& operator<< (packer<Stream>& o, const type::fix_uint32& v)
+	{ o.pack_fix_uint32(v); return o; }
+
+template <typename Stream>
+inline packer<Stream>& operator<< (packer<Stream>& o, const type::fix_uint64& v)
+	{ o.pack_fix_uint64(v); return o; }
+
+
+inline void operator<< (object& o, type::fix_int8 v)
+	{ v.get() < 0 ? o.type = type::NEGATIVE_INTEGER, o.via.i64 = v.get() : o.type = type::POSITIVE_INTEGER, o.via.u64 = v.get(); }
+
+inline void operator<< (object& o, type::fix_int16 v)
+	{ v.get() < 0 ? o.type = type::NEGATIVE_INTEGER, o.via.i64 = v.get() : o.type = type::POSITIVE_INTEGER, o.via.u64 = v.get(); }
+
+inline void operator<< (object& o, type::fix_int32 v)
+	{ v.get() < 0 ? o.type = type::NEGATIVE_INTEGER, o.via.i64 = v.get() : o.type = type::POSITIVE_INTEGER, o.via.u64 = v.get(); }
+
+inline void operator<< (object& o, type::fix_int64 v)
+	{ v.get() < 0 ? o.type = type::NEGATIVE_INTEGER, o.via.i64 = v.get() : o.type = type::POSITIVE_INTEGER, o.via.u64 = v.get(); }
+
+
+inline void operator<< (object& o, type::fix_uint8 v)
+	{ o.type = type::POSITIVE_INTEGER, o.via.u64 = v.get(); }
+
+inline void operator<< (object& o, type::fix_uint16 v)
+	{ o.type = type::POSITIVE_INTEGER, o.via.u64 = v.get(); }
+
+inline void operator<< (object& o, type::fix_uint32 v)
+	{ o.type = type::POSITIVE_INTEGER, o.via.u64 = v.get(); }
+
+inline void operator<< (object& o, type::fix_uint64 v)
+	{ o.type = type::POSITIVE_INTEGER, o.via.u64 = v.get(); }
+
+
+inline void operator<< (object::with_zone& o, type::fix_int8 v)
+	{ static_cast<object&>(o) << v; }
+
+inline void operator<< (object::with_zone& o, type::fix_int16 v)
+	{ static_cast<object&>(o) << v; }
+
+inline void operator<< (object::with_zone& o, type::fix_int32 v)
+	{ static_cast<object&>(o) << v; }
+
+inline void operator<< (object::with_zone& o, type::fix_int64 v)
+	{ static_cast<object&>(o) << v; }
+
+
+inline void operator<< (object::with_zone& o, type::fix_uint8 v)
+	{ static_cast<object&>(o) << v; }
+
+inline void operator<< (object::with_zone& o, type::fix_uint16 v)
+	{ static_cast<object&>(o) << v; }
+
+inline void operator<< (object::with_zone& o, type::fix_uint32 v)
+	{ static_cast<object&>(o) << v; }
+
+inline void operator<< (object::with_zone& o, type::fix_uint64 v)
+	{ static_cast<object&>(o) << v; }
+
+
+}  // namespace msgpack
+
+#endif /* msgpack/type/fixint.hpp */
+

cpp/src/msgpack/unpack.h

@@ -18,8 +18,8 @@
 #ifndef MSGPACK_UNPACKER_H__
 #define MSGPACK_UNPACKER_H__
 
-#include "msgpack/zone.h"
-#include "msgpack/object.h"
+#include "zone.h"
+#include "object.h"
 #include <string.h>
 
 #ifdef __cplusplus

cpp/src/msgpack/unpack.hpp

@@ -18,9 +18,9 @@
 #ifndef MSGPACK_UNPACK_HPP__
 #define MSGPACK_UNPACK_HPP__
 
-#include "msgpack/unpack.h"
-#include "msgpack/object.hpp"
-#include "msgpack/zone.hpp"
+#include "unpack.h"
+#include "object.hpp"
+#include "zone.hpp"
 #include <memory>
 #include <stdexcept>
 

cpp/src/msgpack/vrefbuffer.h

@@ -18,7 +18,7 @@
 #ifndef MSGPACK_VREFBUFFER_H__
 #define MSGPACK_VREFBUFFER_H__
 
-#include "msgpack/zone.h"
+#include "zone.h"
 #include <stdlib.h>
 
 #ifndef _WIN32

cpp/src/msgpack/vrefbuffer.hpp

@@ -18,7 +18,7 @@
 #ifndef MSGPACK_VREFBUFFER_HPP__
 #define MSGPACK_VREFBUFFER_HPP__
 
-#include "msgpack/vrefbuffer.h"
+#include "vrefbuffer.h"
 #include <stdexcept>
 
 namespace msgpack {

cpp/src/msgpack/zbuffer.h

@@ -18,7 +18,7 @@
 #ifndef MSGPACK_ZBUFFER_H__
 #define MSGPACK_ZBUFFER_H__
 
-#include "msgpack/sysdep.h"
+#include "sysdep.h"
 #include <stdlib.h>
 #include <string.h>
 #include <zlib.h>

cpp/src/msgpack/zbuffer.hpp

@@ -18,7 +18,7 @@
 #ifndef MSGPACK_ZBUFFER_HPP__
 #define MSGPACK_ZBUFFER_HPP__
 
-#include "msgpack/zbuffer.h"
+#include "zbuffer.h"
 #include <stdexcept>
 
 namespace msgpack {

cpp/src/msgpack/zone.h

@@ -18,7 +18,7 @@
 #ifndef MSGPACK_ZONE_H__
 #define MSGPACK_ZONE_H__
 
-#include "msgpack/sysdep.h"
+#include "sysdep.h"
 
 #ifdef __cplusplus
 extern "C" {

cpp/src/msgpack/zone.hpp.erb

@@ -18,7 +18,7 @@
 #ifndef MSGPACK_ZONE_HPP__
 #define MSGPACK_ZONE_HPP__
 
-#include "msgpack/zone.h"
+#include "zone.h"
 #include <cstdlib>
 #include <memory>
 #include <vector>

cpp/test/Makefile.am

@@ -13,6 +13,8 @@ check_PROGRAMS = \
 		convert \
 		buffer \
 		cases \
+		fixint \
+		fixint_c \
 		version \
 		msgpackc_test \
 		msgpack_test
@@ -38,6 +40,10 @@ buffer_LDADD = -lz
 
 cases_SOURCES = cases.cc
 
+fixint_SOURCES = fixint.cc
+
+fixint_c_SOURCES = fixint_c.cc
+
 version_SOURCES = version.cc
 
 msgpackc_test_SOURCES = msgpackc_test.cpp

cpp/test/fixint.cc

@@ -0,0 +1,55 @@
+#include <msgpack.hpp>
+#include <gtest/gtest.h>
+
+template <typename T>
+void check_size(size_t size) {
+	T v(0);
+	msgpack::sbuffer sbuf;
+	msgpack::pack(sbuf, v);
+	EXPECT_EQ(size, sbuf.size());
+}
+
+TEST(fixint, size)
+{
+	check_size<msgpack::type::fix_int8>(2);
+	check_size<msgpack::type::fix_int16>(3);
+	check_size<msgpack::type::fix_int32>(5);
+	check_size<msgpack::type::fix_int64>(9);
+
+	check_size<msgpack::type::fix_uint8>(2);
+	check_size<msgpack::type::fix_uint16>(3);
+	check_size<msgpack::type::fix_uint32>(5);
+	check_size<msgpack::type::fix_uint64>(9);
+}
+
+
+template <typename T>
+void check_convert() {
+	T v1(-11);
+	msgpack::sbuffer sbuf;
+	msgpack::pack(sbuf, v1);
+
+	msgpack::unpacked msg;
+	msgpack::unpack(&msg, sbuf.data(), sbuf.size());
+
+	T v2;
+	msg.get().convert(&v2);
+
+	EXPECT_EQ(v1.get(), v2.get());
+
+	EXPECT_EQ(msg.get(), msgpack::object(T(v1.get())));
+}
+
+TEST(fixint, convert)
+{
+	check_convert<msgpack::type::fix_int8>();
+	check_convert<msgpack::type::fix_int16>();
+	check_convert<msgpack::type::fix_int32>();
+	check_convert<msgpack::type::fix_int64>();
+
+	check_convert<msgpack::type::fix_uint8>();
+	check_convert<msgpack::type::fix_uint16>();
+	check_convert<msgpack::type::fix_uint32>();
+	check_convert<msgpack::type::fix_uint64>();
+}
+

cpp/test/fixint_c.cc

@@ -0,0 +1,32 @@
+#include <msgpack.hpp>
+#include <gtest/gtest.h>
+
+TEST(fixint, size)
+{
+	msgpack_sbuffer* sbuf = msgpack_sbuffer_new();
+	msgpack_packer* pk = msgpack_packer_new(sbuf, msgpack_sbuffer_write);
+
+	size_t sum = 0;
+
+	EXPECT_EQ(0, msgpack_pack_fix_int8(pk, 0));
+	EXPECT_EQ(sum+=2, sbuf->size);
+	EXPECT_EQ(0, msgpack_pack_fix_int16(pk, 0));
+	EXPECT_EQ(sum+=3, sbuf->size);
+	EXPECT_EQ(0, msgpack_pack_fix_int32(pk, 0));
+	EXPECT_EQ(sum+=5, sbuf->size);
+	EXPECT_EQ(0, msgpack_pack_fix_int64(pk, 0));
+	EXPECT_EQ(sum+=9, sbuf->size);
+
+	EXPECT_EQ(0, msgpack_pack_fix_uint8(pk, 0));
+	EXPECT_EQ(sum+=2, sbuf->size);
+	EXPECT_EQ(0, msgpack_pack_fix_uint16(pk, 0));
+	EXPECT_EQ(sum+=3, sbuf->size);
+	EXPECT_EQ(0, msgpack_pack_fix_uint32(pk, 0));
+	EXPECT_EQ(sum+=5, sbuf->size);
+	EXPECT_EQ(0, msgpack_pack_fix_uint64(pk, 0));
+	EXPECT_EQ(sum+=9, sbuf->size);
+
+	msgpack_sbuffer_free(sbuf);
+	msgpack_packer_free(pk);
+}
+

erlang/msgpack.erl

@@ -126,7 +126,7 @@ pack_(List)  when is_list(List) ->
 pack_({Map}) when is_list(Map) ->
     pack_map(Map);
 pack_(Other) ->
-    throw({error, {badarg, Other}}).
+    throw({badarg, Other}).
 
 
 -spec pack_uint_(non_neg_integer()) -> binary().
@@ -387,4 +387,9 @@ benchmark_test()->
     {Data,<<>>}=?debugTime("deserialize", msgpack:unpack(S)),
     ?debugFmt("for ~p KB test data.", [byte_size(S) div 1024]).
 
+error_test()->
+    ?assertEqual({error,{badarg, atom}}, msgpack:pack(atom)),
+    Term = {"hoge", "hage", atom},
+    ?assertEqual({error,{badarg, Term}}, msgpack:pack(Term)).
+
 -endif.

haskell/LICENSE

@@ -1,4 +1,4 @@
-Copyright (c) 2009, Hideyuki Tanaka
+Copyright (c) 2009-2010, Hideyuki Tanaka
 All rights reserved.
 
 Redistribution and use in source and binary forms, with or without

haskell/cbits/msgpack.c

@@ -1,137 +0,0 @@
-#include <msgpack.h>
-
-void msgpack_sbuffer_init_wrap(msgpack_sbuffer* sbuf)
-{
-  msgpack_sbuffer_init(sbuf);
-}
-
-void msgpack_sbuffer_destroy_wrap(msgpack_sbuffer* sbuf)
-{
-  msgpack_sbuffer_destroy(sbuf);
-}
-
-int msgpack_sbuffer_write_wrap(void* data, const char* buf, unsigned int len)
-{
-  return msgpack_sbuffer_write(data, buf, len);
-}
-
-msgpack_packer* msgpack_packer_new_wrap(void *data, msgpack_packer_write callback)
-{
-  return msgpack_packer_new(data, callback);
-}
-
-void msgpack_packer_free_wrap(msgpack_packer* pk)
-{
-  msgpack_packer_free(pk);
-}
-
-int msgpack_pack_uint8_wrap(msgpack_packer* pk, uint8_t d)
-{
-  return msgpack_pack_uint8(pk, d);
-}
-
-int msgpack_pack_uint16_wrap(msgpack_packer* pk, uint16_t d)
-{
-  return msgpack_pack_uint16(pk, d);
-}
-
-int msgpack_pack_uint32_wrap(msgpack_packer* pk, uint32_t d)
-{
-  return msgpack_pack_uint32(pk, d);
-}
-
-int msgpack_pack_uint64_wrap(msgpack_packer* pk, uint64_t d)
-{
-  return msgpack_pack_uint64(pk, d);
-}
-
-int msgpack_pack_int8_wrap(msgpack_packer* pk, int8_t d)
-{
-  return msgpack_pack_int8(pk, d);
-}
-
-int msgpack_pack_int16_wrap(msgpack_packer* pk, int16_t d)
-{
-  return msgpack_pack_int16(pk, d);
-}
-
-int msgpack_pack_int32_wrap(msgpack_packer* pk, int32_t d)
-{
-  return msgpack_pack_int32(pk, d);
-}
-
-int msgpack_pack_int64_wrap(msgpack_packer* pk, int64_t d)
-{
-  return msgpack_pack_int64(pk, d);
-}
-
-int msgpack_pack_double_wrap(msgpack_packer* pk, double d)
-{
-  return msgpack_pack_double(pk, d);
-}
-
-int msgpack_pack_nil_wrap(msgpack_packer* pk)
-{
-  return msgpack_pack_nil(pk);
-}
-
-int msgpack_pack_true_wrap(msgpack_packer* pk)
-{
-  return msgpack_pack_true(pk);
-}
-
-int msgpack_pack_false_wrap(msgpack_packer* pk)
-{
-  return msgpack_pack_false(pk);
-}
-
-int msgpack_pack_array_wrap(msgpack_packer* pk, unsigned int n)
-{
-  return msgpack_pack_array(pk, n);
-}
-
-int msgpack_pack_map_wrap(msgpack_packer* pk, unsigned int n)
-{
-  return msgpack_pack_map(pk, n);
-}
-
-int msgpack_pack_raw_wrap(msgpack_packer* pk, size_t l)
-{
-  return msgpack_pack_raw(pk, l);
-}
-
-int msgpack_pack_raw_body_wrap(msgpack_packer* pk, const void *b, size_t l)
-{
-  return msgpack_pack_raw_body(pk, b, l);
-}
-
-bool msgpack_unpacker_reserve_buffer_wrap(msgpack_unpacker *mpac, size_t size)
-{
-  return msgpack_unpacker_reserve_buffer(mpac, size);
-}
-
-char *msgpack_unpacker_buffer_wrap(msgpack_unpacker *mpac)
-{
-  return msgpack_unpacker_buffer(mpac);
-}
-
-size_t msgpack_unpacker_buffer_capacity_wrap(const msgpack_unpacker *mpac)
-{
-  return msgpack_unpacker_buffer_capacity(mpac);
-}
-
-void msgpack_unpacker_buffer_consumed_wrap(msgpack_unpacker *mpac, size_t size)
-{
-  msgpack_unpacker_buffer_consumed(mpac, size);
-}
-
-void msgpack_unpacker_data_wrap(msgpack_unpacker *mpac, msgpack_object *obj)
-{
-  *obj=msgpack_unpacker_data(mpac);
-}
-
-size_t msgpack_unpacker_message_size_wrap(const msgpack_unpacker *mpac)
-{
-  return msgpack_unpacker_message_size(mpac);
-}
-

haskell/msgpack.cabal

@@ -1,32 +1,42 @@
-Name:                msgpack
-Version:             0.2.2
-License:             BSD3
-License-File:        LICENSE
-Author:              Hideyuki Tanaka
-Maintainer:          Hideyuki Tanaka <tanaka.hideyuki@gmail.com>
-Category:            Data
-Synopsis:            A Haskell binding to MessagePack
+Name:               msgpack
+Version:            0.3.1.1
+Synopsis:           A Haskell binding to MessagePack
 Description:
-  A Haskell binding to MessagePack <http://msgpack.sourceforge.jp/>
-Homepage:	     http://github.com/tanakh/hsmsgpack
-Stability:	     Experimental
-Tested-with:	     GHC==6.10.4
-Cabal-Version:	     >=1.2
-Build-Type:          Simple
+  A Haskell binding to MessagePack <http://msgpack.org/>
 
-library
-  build-depends:	base>=4 && <5, mtl, bytestring
-  ghc-options:		-O2 -Wall
-  hs-source-dirs:	src
-  extra-libraries:	msgpackc
+License:            BSD3
+License-File:       LICENSE
+Copyright:          Copyright (c) 2009-2010, Hideyuki Tanaka
+Category:           Data
+Author:             Hideyuki Tanaka
+Maintainer:         Hideyuki Tanaka <tanaka.hideyuki@gmail.com>
+Homepage:           http://github.com/msgpack/msgpack
+Stability:          Experimental
+Cabal-Version:      >= 1.6
+Build-Type:         Simple
+
+Library
+  Build-depends:    base >=4 && <5,
+                    transformers >= 0.2.1 && < 0.2.2,
+                    MonadCatchIO-transformers >= 0.2.2 && < 0.2.3,
+                    bytestring >= 0.9 && < 0.10,
+                    vector >= 0.6.0 && < 0.6.1,
+                    iteratee >= 0.4 && < 0.5,
+                    attoparsec >= 0.8.1 && < 0.8.2,
+                    binary >= 0.5.0 && < 0.5.1,
+                    data-binary-ieee754 >= 0.4 && < 0.5,
+                    deepseq >= 1.1 && <1.2
+
+  Ghc-options:      -Wall
+  Hs-source-dirs:   src
 
   Exposed-modules:
     Data.MessagePack
-    Data.MessagePack.Base
-    Data.MessagePack.Class
-    Data.MessagePack.Feed
-    Data.MessagePack.Monad
-    Data.MessagePack.Stream
+    Data.MessagePack.Object
+    Data.MessagePack.Put
+    Data.MessagePack.Parser
+    Data.MessagePack.Iteratee
 
-  C-Sources:
-    cbits/msgpack.c
+Source-repository head
+  Type:     git
+  Location: git://github.com/msgpack/msgpack.git

haskell/src/Data/MessagePack.hs

@@ -1,7 +1,7 @@
 --------------------------------------------------------------------
 -- |
 -- Module    : Data.MessagePack
--- Copyright : (c) Hideyuki Tanaka, 2009
+-- Copyright : (c) Hideyuki Tanaka, 2009-2010
 -- License   : BSD3
 --
 -- Maintainer:  tanaka.hideyuki@gmail.com
@@ -13,51 +13,114 @@
 --------------------------------------------------------------------
 
 module Data.MessagePack(
-  module Data.MessagePack.Base,
-  module Data.MessagePack.Class,
-  module Data.MessagePack.Feed,
-  module Data.MessagePack.Monad,
-  module Data.MessagePack.Stream,
+  module Data.MessagePack.Object,
+  module Data.MessagePack.Put,
+  module Data.MessagePack.Parser,
+  module Data.MessagePack.Iteratee,
   
-  -- * Pack and Unpack
-  packb,
-  unpackb,
+  -- * Simple functions of Pack and Unpack
+  pack,
+  unpack,
+  
+  -- * Pack functions
+  packToString,
+  packToHandle,
+  packToHandle',
+  packToFile,
+  
+  -- * Unpack functions
+  unpackFromString,
+  unpackFromHandle,
+  unpackFromFile,
+  unpackFromStringI,
+  unpackFromHandleI,
+  unpackFromFileI,
   
-  -- * Pure version of Pack and Unpack
-  packb',
-  unpackb',
   ) where
 
-import Data.ByteString (ByteString)
-import System.IO.Unsafe
+import qualified Control.Monad.CatchIO as CIO
+import Control.Monad.IO.Class
+import qualified Data.Attoparsec as A
+import Data.Binary.Put
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Lazy as L
+import Data.Functor.Identity
+import qualified Data.Iteratee as I
+import System.IO
 
-import Data.MessagePack.Base
-import Data.MessagePack.Class
-import Data.MessagePack.Feed
-import Data.MessagePack.Monad
-import Data.MessagePack.Stream
+import Data.MessagePack.Object
+import Data.MessagePack.Put
+import Data.MessagePack.Parser
+import Data.MessagePack.Iteratee
+
+bufferSize :: Int
+bufferSize = 4 * 1024
+
+class IsByteString s where
+  toBS :: s -> B.ByteString
+
+instance IsByteString B.ByteString where
+  toBS = id
+
+instance IsByteString L.ByteString where
+  toBS = B.concat . L.toChunks
 
 -- | Pack Haskell data to MessagePack string.
-packb :: OBJECT a => a -> IO ByteString
-packb dat = do
-  sb <- newSimpleBuffer
-  pc <- newPacker sb
-  pack pc dat
-  simpleBufferData sb
+pack :: ObjectPut a => a -> L.ByteString
+pack = packToString . put
 
 -- | Unpack MessagePack string to Haskell data.
-unpackb :: OBJECT a => ByteString -> IO (Result a)
-unpackb bs = do
-  withZone $ \z -> do
-    r <- unpackObject z bs
-    return $ case r of
-      Left err -> Left (show err)
-      Right (_, dat) -> fromObject dat
+unpack :: (ObjectGet a, IsByteString s) => s -> a
+unpack bs =
+  runIdentity $ I.run $ I.joinIM $ I.enumPure1Chunk (toBS bs) getI
 
--- | Pure version of 'packb'.
-packb' :: OBJECT a => a -> ByteString
-packb' dat = unsafePerformIO $ packb dat
+-- TODO: tryUnpack
 
--- | Pure version of 'unpackb'.
-unpackb' :: OBJECT a => ByteString -> Result a
-unpackb' bs = unsafePerformIO $ unpackb bs
+-- | Pack to ByteString.
+packToString :: Put -> L.ByteString
+packToString = runPut
+
+-- | Pack to Handle
+packToHandle :: Handle -> Put -> IO ()
+packToHandle h = L.hPutStr h . packToString
+
+-- | Pack to Handle and Flush Handle
+packToHandle' :: Handle -> Put -> IO ()
+packToHandle' h p = packToHandle h p >> hFlush h
+
+-- | Pack to File
+packToFile :: FilePath -> Put -> IO ()
+packToFile path = L.writeFile path . packToString
+
+-- | Unpack from ByteString
+unpackFromString :: (Monad m, IsByteString s) => s -> A.Parser a -> m a
+unpackFromString bs =
+  unpackFromStringI bs . parserToIteratee
+
+-- | Unpack from Handle
+unpackFromHandle :: CIO.MonadCatchIO m => Handle -> A.Parser a -> m a
+unpackFromHandle h =
+  unpackFromHandleI h .parserToIteratee
+
+-- | Unpack from File
+unpackFromFile :: CIO.MonadCatchIO m => FilePath -> A.Parser a -> m a
+unpackFromFile path =
+  unpackFromFileI path . parserToIteratee
+
+-- | Iteratee interface to unpack from ByteString
+unpackFromStringI :: (Monad m, IsByteString s) => s -> I.Iteratee B.ByteString m a -> m a
+unpackFromStringI bs =
+  I.run . I.joinIM . I.enumPure1Chunk (toBS bs)
+
+-- | Iteratee interface to unpack from Handle
+unpackFromHandleI :: CIO.MonadCatchIO m => Handle -> I.Iteratee B.ByteString m a -> m a
+unpackFromHandleI h =
+  I.run . I.joinIM . enumHandleNonBlocking bufferSize h
+
+-- | Iteratee interface to unpack from File
+unpackFromFileI :: CIO.MonadCatchIO m => FilePath -> I.Iteratee B.ByteString m a -> m a
+unpackFromFileI path p =
+  CIO.bracket
+  (liftIO $ openBinaryFile path ReadMode)
+  (liftIO . hClose)
+  (flip unpackFromHandleI p)

haskell/src/Data/MessagePack/Base.hsc

@@ -1,584 +0,0 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE ForeignFunctionInterface #-}
-
---------------------------------------------------------------------
--- |
--- Module    : Data.MessagePack.Base
--- Copyright : (c) Hideyuki Tanaka, 2009
--- License   : BSD3
---
--- Maintainer:  tanaka.hideyuki@gmail.com
--- Stability :  experimental
--- Portability: portable
---
--- Low Level Interface to MessagePack C API
---
---------------------------------------------------------------------
-
-module Data.MessagePack.Base(
-  -- * Simple Buffer
-  SimpleBuffer,
-  newSimpleBuffer,
-  simpleBufferData,
-  
-  -- * Serializer
-  Packer,
-  newPacker,
-  
-  packU8,
-  packU16,
-  packU32,
-  packU64,  
-  packS8,
-  packS16,
-  packS32,
-  packS64,
-  
-  packTrue,
-  packFalse,
-  
-  packInt,
-  packDouble,
-  packNil,
-  packBool,
-  
-  packArray,
-  packMap,
-  packRAW,
-  packRAWBody,
-  packRAW',
-  
-  -- * Stream Deserializer
-  Unpacker,
-  defaultInitialBufferSize,
-  newUnpacker,
-  unpackerReserveBuffer,
-  unpackerBuffer,
-  unpackerBufferCapacity,
-  unpackerBufferConsumed,
-  unpackerFeed,
-  unpackerExecute,
-  unpackerData,
-  unpackerReleaseZone,
-  unpackerResetZone,
-  unpackerReset,
-  unpackerMessageSize,
-  
-  -- * MessagePack Object
-  Object(..),
-  packObject,
-  
-  UnpackReturn(..),
-  unpackObject,
-  
-  -- * Memory Zone
-  Zone,
-  newZone,
-  freeZone,
-  withZone,
-  ) where
-
-import Control.Exception
-import Control.Monad
-import Data.ByteString (ByteString)
-import qualified Data.ByteString as BS hiding (pack, unpack)
-import Data.Int
-import Data.Word
-import Foreign.C
-import Foreign.Concurrent
-import Foreign.ForeignPtr hiding (newForeignPtr)
-import Foreign.Marshal.Alloc
-import Foreign.Marshal.Array
-import Foreign.Ptr
-import Foreign.Storable
-
-#include <msgpack.h>
-
-type SimpleBuffer = ForeignPtr ()
-
-type WriteCallback = Ptr () -> CString -> CUInt -> IO CInt
-
--- | Create a new Simple Buffer. It will be deleted automatically.
-newSimpleBuffer :: IO SimpleBuffer
-newSimpleBuffer = do
-  ptr <- mallocBytes (#size msgpack_sbuffer)
-  fptr <- newForeignPtr ptr $ do
-    msgpack_sbuffer_destroy ptr
-    free ptr
-  withForeignPtr fptr $ \p ->
-    msgpack_sbuffer_init p
-  return fptr
-
--- | Get data of Simple Buffer.
-simpleBufferData :: SimpleBuffer -> IO ByteString
-simpleBufferData sb =
-  withForeignPtr sb $ \ptr -> do
-    size <- (#peek msgpack_sbuffer, size) ptr
-    dat  <- (#peek msgpack_sbuffer, data) ptr
-    BS.packCStringLen (dat, fromIntegral (size :: CSize))
-
-foreign import ccall "msgpack_sbuffer_init_wrap" msgpack_sbuffer_init ::
-  Ptr () -> IO ()
-
-foreign import ccall "msgpack_sbuffer_destroy_wrap" msgpack_sbuffer_destroy ::
-  Ptr () -> IO ()
-
-foreign import ccall "msgpack_sbuffer_write_wrap" msgpack_sbuffer_write ::
-  WriteCallback
-
-type Packer = ForeignPtr ()
-
--- | Create new Packer. It will be deleted automatically.
-newPacker :: SimpleBuffer -> IO Packer
-newPacker sbuf = do
-  cb <- wrap_callback msgpack_sbuffer_write
-  ptr <- withForeignPtr sbuf $ \ptr ->
-    msgpack_packer_new ptr cb
-  fptr <- newForeignPtr ptr $ do
-    msgpack_packer_free ptr
-  return fptr
-
-foreign import ccall "msgpack_packer_new_wrap" msgpack_packer_new ::
-  Ptr () -> FunPtr WriteCallback -> IO (Ptr ())
-
-foreign import ccall "msgpack_packer_free_wrap" msgpack_packer_free ::
-  Ptr () -> IO ()
-
-foreign import ccall "wrapper" wrap_callback ::
-  WriteCallback -> IO (FunPtr WriteCallback)
-
-packU8 :: Packer -> Word8 -> IO Int
-packU8 pc n =
-  liftM fromIntegral $ withForeignPtr pc $ \ptr ->
-    msgpack_pack_uint8 ptr n
-
-foreign import ccall "msgpack_pack_uint8_wrap" msgpack_pack_uint8 ::
-  Ptr () -> Word8 -> IO CInt
-
-packU16 :: Packer -> Word16 -> IO Int
-packU16 pc n =
-  liftM fromIntegral $ withForeignPtr pc $ \ptr ->
-    msgpack_pack_uint16 ptr n
-
-foreign import ccall "msgpack_pack_uint16_wrap" msgpack_pack_uint16 ::
-  Ptr () -> Word16 -> IO CInt
-
-packU32 :: Packer -> Word32 -> IO Int
-packU32 pc n =
-  liftM fromIntegral $ withForeignPtr pc $ \ptr ->
-    msgpack_pack_uint32 ptr n
-
-foreign import ccall "msgpack_pack_uint32_wrap" msgpack_pack_uint32 ::
-  Ptr () -> Word32 -> IO CInt
-
-packU64 :: Packer -> Word64 -> IO Int
-packU64 pc n =
-  liftM fromIntegral $ withForeignPtr pc $ \ptr ->
-    msgpack_pack_uint64 ptr n
-
-foreign import ccall "msgpack_pack_uint64_wrap" msgpack_pack_uint64 ::
-  Ptr () -> Word64 -> IO CInt
-
-packS8 :: Packer -> Int8 -> IO Int
-packS8 pc n =
-  liftM fromIntegral $ withForeignPtr pc $ \ptr ->
-    msgpack_pack_int8 ptr n
-
-foreign import ccall "msgpack_pack_int8_wrap" msgpack_pack_int8 ::
-  Ptr () -> Int8 -> IO CInt
-
-packS16 :: Packer -> Int16 -> IO Int
-packS16 pc n =
-  liftM fromIntegral $ withForeignPtr pc $ \ptr ->
-    msgpack_pack_int16 ptr n
-
-foreign import ccall "msgpack_pack_int16_wrap" msgpack_pack_int16 ::
-  Ptr () -> Int16 -> IO CInt
-
-packS32 :: Packer -> Int32 -> IO Int
-packS32 pc n =
-  liftM fromIntegral $ withForeignPtr pc $ \ptr ->
-    msgpack_pack_int32 ptr n
-
-foreign import ccall "msgpack_pack_int32_wrap" msgpack_pack_int32 ::
-  Ptr () -> Int32 -> IO CInt
-
-packS64 :: Packer -> Int64 -> IO Int
-packS64 pc n =
-  liftM fromIntegral $ withForeignPtr pc $ \ptr ->
-    msgpack_pack_int64 ptr n
-
-foreign import ccall "msgpack_pack_int64_wrap" msgpack_pack_int64 ::
-  Ptr () -> Int64 -> IO CInt
-
--- | Pack an integral data.
-packInt :: Integral a => Packer -> a -> IO Int
-packInt pc n = packS64 pc $ fromIntegral n
-
--- | Pack a double data.
-packDouble :: Packer -> Double -> IO Int
-packDouble pc d =
-  liftM fromIntegral $ withForeignPtr pc $ \ptr ->
-    msgpack_pack_double ptr (realToFrac d)
-
-foreign import ccall "msgpack_pack_double_wrap" msgpack_pack_double ::
-  Ptr () -> CDouble -> IO CInt
-
--- | Pack a nil.
-packNil :: Packer -> IO Int
-packNil pc =
-  liftM fromIntegral $ withForeignPtr pc $ \ptr ->
-    msgpack_pack_nil ptr
-
-foreign import ccall "msgpack_pack_nil_wrap" msgpack_pack_nil ::
-  Ptr () -> IO CInt
-
-packTrue :: Packer -> IO Int
-packTrue pc =
-  liftM fromIntegral $ withForeignPtr pc $ \ptr ->
-    msgpack_pack_true ptr
-
-foreign import ccall "msgpack_pack_true_wrap" msgpack_pack_true ::
-  Ptr () -> IO CInt
-
-packFalse :: Packer -> IO Int
-packFalse pc =
-  liftM fromIntegral $ withForeignPtr pc $ \ptr ->
-    msgpack_pack_false ptr
-
-foreign import ccall "msgpack_pack_false_wrap" msgpack_pack_false ::
-  Ptr () -> IO CInt
-
--- | Pack a bool data.
-packBool :: Packer -> Bool -> IO Int
-packBool pc True  = packTrue pc
-packBool pc False = packFalse pc
-
--- | 'packArray' @p n@ starts packing an array. 
--- Next @n@ data will consist this array.
-packArray :: Packer -> Int -> IO Int
-packArray pc n =
-  liftM fromIntegral $ withForeignPtr pc $ \ptr ->
-    msgpack_pack_array ptr (fromIntegral n)
-
-foreign import ccall "msgpack_pack_array_wrap" msgpack_pack_array ::
-  Ptr () -> CUInt -> IO CInt
-
--- | 'packMap' @p n@ starts packing a map. 
--- Next @n@ pairs of data (2*n data) will consist this map.
-packMap :: Packer -> Int -> IO Int
-packMap pc n =
-  liftM fromIntegral $ withForeignPtr pc $ \ptr ->
-    msgpack_pack_map ptr (fromIntegral n)
-
-foreign import ccall "msgpack_pack_map_wrap" msgpack_pack_map ::
-  Ptr () -> CUInt -> IO CInt
-
--- | 'packRAW' @p n@ starts packing a byte sequence. 
--- Next total @n@ bytes of 'packRAWBody' call will consist this sequence.
-packRAW :: Packer -> Int -> IO Int
-packRAW pc n =
-  liftM fromIntegral $ withForeignPtr pc $ \ptr ->
-    msgpack_pack_raw ptr (fromIntegral n)
-
-foreign import ccall "msgpack_pack_raw_wrap" msgpack_pack_raw ::
-  Ptr () -> CSize -> IO CInt
-
--- | Pack a byte sequence.
-packRAWBody :: Packer -> ByteString -> IO Int
-packRAWBody pc bs =
-  liftM fromIntegral $ withForeignPtr pc $ \ptr ->
-  BS.useAsCStringLen bs $ \(str, len) ->
-    msgpack_pack_raw_body ptr (castPtr str) (fromIntegral len)
-
-foreign import ccall "msgpack_pack_raw_body_wrap" msgpack_pack_raw_body ::
-  Ptr () -> Ptr () -> CSize -> IO CInt
-
--- | Pack a single byte stream. It calls 'packRAW' and 'packRAWBody'.
-packRAW' :: Packer -> ByteString -> IO Int
-packRAW' pc bs = do
-  _ <- packRAW pc (BS.length bs)
-  packRAWBody pc bs
-
-type Unpacker = ForeignPtr ()
-
-defaultInitialBufferSize :: Int
-defaultInitialBufferSize = 32 * 1024 -- #const MSGPACK_UNPACKER_DEFAULT_INITIAL_BUFFER_SIZE
-
--- | 'newUnpacker' @initialBufferSize@ creates a new Unpacker. It will be deleted automatically.
-newUnpacker :: Int -> IO Unpacker
-newUnpacker initialBufferSize = do
-  ptr <- msgpack_unpacker_new (fromIntegral initialBufferSize)
-  fptr <- newForeignPtr ptr $ do
-    msgpack_unpacker_free ptr
-  return fptr
-
-foreign import ccall "msgpack_unpacker_new" msgpack_unpacker_new ::
-  CSize -> IO (Ptr ())
-
-foreign import ccall "msgpack_unpacker_free" msgpack_unpacker_free ::
-  Ptr() -> IO ()
-
--- | 'unpackerReserveBuffer' @up size@ reserves at least @size@ bytes of buffer.
-unpackerReserveBuffer :: Unpacker -> Int -> IO Bool
-unpackerReserveBuffer up size =
-  withForeignPtr up $ \ptr ->
-  liftM (/=0) $ msgpack_unpacker_reserve_buffer ptr (fromIntegral size)
-
-foreign import ccall "msgpack_unpacker_reserve_buffer_wrap" msgpack_unpacker_reserve_buffer ::
-  Ptr () -> CSize -> IO CChar
-
--- | Get a pointer of unpacker buffer.
-unpackerBuffer :: Unpacker -> IO (Ptr CChar)
-unpackerBuffer up =
-  withForeignPtr up $ \ptr ->
-  msgpack_unpacker_buffer ptr
-
-foreign import ccall "msgpack_unpacker_buffer_wrap" msgpack_unpacker_buffer ::
-  Ptr () -> IO (Ptr CChar)
-
--- | Get size of allocated buffer.
-unpackerBufferCapacity :: Unpacker -> IO Int
-unpackerBufferCapacity up =
-  withForeignPtr up $ \ptr ->
-  liftM fromIntegral $ msgpack_unpacker_buffer_capacity ptr
-
-foreign import ccall "msgpack_unpacker_buffer_capacity_wrap" msgpack_unpacker_buffer_capacity ::
-  Ptr () -> IO CSize
-
--- | 'unpackerBufferConsumed' @up size@ notices that writed @size@ bytes to buffer.
-unpackerBufferConsumed :: Unpacker -> Int -> IO ()
-unpackerBufferConsumed up size =
-  withForeignPtr up $ \ptr ->
-  msgpack_unpacker_buffer_consumed ptr (fromIntegral size)
-
-foreign import ccall "msgpack_unpacker_buffer_consumed_wrap" msgpack_unpacker_buffer_consumed ::
-  Ptr () -> CSize -> IO ()
-
--- | Write byte sequence to Unpacker. It is utility funciton, calls 'unpackerReserveBuffer', 'unpackerBuffer' and 'unpackerBufferConsumed'.
-unpackerFeed :: Unpacker -> ByteString -> IO ()
-unpackerFeed up bs =
-  BS.useAsCStringLen bs $ \(str, len) -> do
-    True <- unpackerReserveBuffer up len
-    ptr <- unpackerBuffer up
-    copyArray ptr str len
-    unpackerBufferConsumed up len
-
--- | Execute deserializing. It returns 0 when buffer contains not enough bytes, returns 1 when succeeded, returns negative value when it failed.
-unpackerExecute :: Unpacker -> IO Int
-unpackerExecute up =
-  withForeignPtr up $ \ptr ->
-  liftM fromIntegral $ msgpack_unpacker_execute ptr
-
-foreign import ccall "msgpack_unpacker_execute" msgpack_unpacker_execute ::
-  Ptr () -> IO CInt
-
--- | Returns a deserialized object when 'unpackerExecute' returned 1.
-unpackerData :: Unpacker -> IO Object
-unpackerData up =
-  withForeignPtr up $ \ptr ->
-  allocaBytes (#size msgpack_object) $ \pobj -> do
-    msgpack_unpacker_data ptr pobj
-    peekObject pobj
-
-foreign import ccall "msgpack_unpacker_data_wrap" msgpack_unpacker_data ::
-  Ptr () -> Ptr () -> IO ()
-
--- | Release memory zone. The returned zone must be freed by calling 'freeZone'.
-unpackerReleaseZone :: Unpacker -> IO Zone
-unpackerReleaseZone up =
-  withForeignPtr up $ \ptr ->
-  msgpack_unpacker_release_zone ptr
-
-foreign import ccall "msgpack_unpacker_release_zone" msgpack_unpacker_release_zone ::
-  Ptr () -> IO (Ptr ())
-
--- | Free memory zone used by Unapcker.
-unpackerResetZone :: Unpacker -> IO ()
-unpackerResetZone up =
-  withForeignPtr up $ \ptr ->
-  msgpack_unpacker_reset_zone ptr
-
-foreign import ccall "msgpack_unpacker_reset_zone" msgpack_unpacker_reset_zone ::
-  Ptr () -> IO ()
-
--- | Reset Unpacker state except memory zone.
-unpackerReset :: Unpacker -> IO ()
-unpackerReset up =
-  withForeignPtr up $ \ptr ->
-  msgpack_unpacker_reset ptr
-
-foreign import ccall "msgpack_unpacker_reset" msgpack_unpacker_reset ::
-  Ptr () -> IO ()
-
--- | Returns number of bytes of sequence of deserializing object.
-unpackerMessageSize :: Unpacker -> IO Int
-unpackerMessageSize up =
-  withForeignPtr up $ \ptr ->
-  liftM fromIntegral $ msgpack_unpacker_message_size ptr
-
-foreign import ccall "msgpack_unpacker_message_size_wrap" msgpack_unpacker_message_size ::
-  Ptr () -> IO CSize
-
-type Zone = Ptr ()
-
--- | Create a new memory zone. It must be freed manually.
-newZone :: IO Zone
-newZone =
-  msgpack_zone_new (#const MSGPACK_ZONE_CHUNK_SIZE)
-
--- | Free a memory zone.
-freeZone :: Zone -> IO ()
-freeZone z =
-  msgpack_zone_free z
-
--- | Create a memory zone, then execute argument, then free memory zone.
-withZone :: (Zone -> IO a) -> IO a
-withZone z =
-  bracket newZone freeZone z
-
-foreign import ccall "msgpack_zone_new" msgpack_zone_new ::
-  CSize -> IO Zone
-
-foreign import ccall "msgpack_zone_free" msgpack_zone_free ::
-  Zone -> IO ()
-
--- | Object Representation of MessagePack data.
-data Object =
-  ObjectNil
-  | ObjectBool Bool
-  | ObjectInteger Int
-  | ObjectDouble Double
-  | ObjectRAW ByteString
-  | ObjectArray [Object]
-  | ObjectMap [(Object, Object)]
-  deriving (Show)
-
-peekObject :: Ptr a -> IO Object
-peekObject ptr = do
-  typ <- (#peek msgpack_object, type) ptr
-  case (typ :: CInt) of
-    (#const MSGPACK_OBJECT_NIL) ->
-      return ObjectNil
-    (#const MSGPACK_OBJECT_BOOLEAN) ->
-      peekObjectBool ptr
-    (#const MSGPACK_OBJECT_POSITIVE_INTEGER) ->
-      peekObjectPositiveInteger ptr
-    (#const MSGPACK_OBJECT_NEGATIVE_INTEGER) ->
-      peekObjectNegativeInteger ptr
-    (#const MSGPACK_OBJECT_DOUBLE) ->
-      peekObjectDouble ptr
-    (#const MSGPACK_OBJECT_RAW) ->
-      peekObjectRAW ptr
-    (#const MSGPACK_OBJECT_ARRAY) ->
-      peekObjectArray ptr
-    (#const MSGPACK_OBJECT_MAP) ->
-      peekObjectMap ptr
-    _ ->
-      fail $ "peekObject: unknown object type (" ++ show typ ++ ")"
-
-peekObjectBool :: Ptr a -> IO Object
-peekObjectBool ptr = do
-  b <- (#peek msgpack_object, via.boolean) ptr
-  return $ ObjectBool $ (b :: CUChar) /= 0
-
-peekObjectPositiveInteger :: Ptr a -> IO Object
-peekObjectPositiveInteger ptr = do
-  n <- (#peek msgpack_object, via.u64) ptr
-  return $ ObjectInteger $ fromIntegral (n :: Word64)
-
-peekObjectNegativeInteger :: Ptr a -> IO Object
-peekObjectNegativeInteger ptr = do
-  n <- (#peek msgpack_object, via.i64) ptr
-  return $ ObjectInteger $ fromIntegral (n :: Int64)
-
-peekObjectDouble :: Ptr a -> IO Object
-peekObjectDouble ptr = do
-  d <- (#peek msgpack_object, via.dec) ptr
-  return $ ObjectDouble $ realToFrac (d :: CDouble)
-
-peekObjectRAW :: Ptr a -> IO Object
-peekObjectRAW ptr = do
-  size <- (#peek msgpack_object, via.raw.size) ptr
-  p    <- (#peek msgpack_object, via.raw.ptr) ptr
-  bs   <- BS.packCStringLen (p, fromIntegral (size :: Word32))
-  return $ ObjectRAW bs
-
-peekObjectArray :: Ptr a -> IO Object
-peekObjectArray ptr = do
-  csize <- (#peek msgpack_object, via.array.size) ptr
-  let size = fromIntegral (csize :: Word32)
-  p     <- (#peek msgpack_object, via.array.ptr) ptr
-  objs  <- mapM (\i -> peekObject $ p `plusPtr`
-                      ((#size msgpack_object) * i))
-           [0..size-1]
-  return $ ObjectArray objs
-
-peekObjectMap :: Ptr a -> IO Object
-peekObjectMap ptr = do
-  csize <- (#peek msgpack_object, via.map.size) ptr
-  let size = fromIntegral (csize :: Word32)
-  p     <- (#peek msgpack_object, via.map.ptr) ptr
-  dat   <- mapM (\i -> peekObjectKV $ p `plusPtr`
-                      ((#size msgpack_object_kv) * i))
-           [0..size-1]
-  return $ ObjectMap dat
-
-peekObjectKV :: Ptr a -> IO (Object, Object)
-peekObjectKV ptr = do
-  k <- peekObject $ ptr `plusPtr` (#offset msgpack_object_kv, key)
-  v <- peekObject $ ptr `plusPtr` (#offset msgpack_object_kv, val)
-  return (k, v)
-
--- | Pack a Object.
-packObject :: Packer -> Object -> IO ()
-packObject pc ObjectNil = packNil pc >> return ()
-
-packObject pc (ObjectBool b) = packBool pc b >> return ()
-
-packObject pc (ObjectInteger n) = packInt pc n >> return ()
-
-packObject pc (ObjectDouble d) = packDouble pc d >> return ()
-
-packObject pc (ObjectRAW bs) = packRAW' pc bs >> return ()
-
-packObject pc (ObjectArray ls) = do
-  _ <- packArray pc (length ls)
-  mapM_ (packObject pc) ls
-
-packObject pc (ObjectMap ls) = do
-  _ <- packMap pc (length ls)
-  mapM_ (\(a, b) -> packObject pc a >> packObject pc b) ls
-
-data UnpackReturn =
-  UnpackContinue     -- ^ not enough bytes to unpack object
-  | UnpackParseError -- ^ got invalid bytes
-  | UnpackError      -- ^ other error
-  deriving (Eq, Show)
-
--- | Unpack a single MessagePack object from byte sequence.
-unpackObject :: Zone -> ByteString -> IO (Either UnpackReturn (Int, Object))
-unpackObject z dat =
-  allocaBytes (#size msgpack_object) $ \ptr ->
-  BS.useAsCStringLen dat $ \(str, len) ->
-  alloca $ \poff -> do
-    poke poff 0
-    ret <- msgpack_unpack str (fromIntegral len) poff z ptr
-    case ret of
-      (#const MSGPACK_UNPACK_SUCCESS) -> do
-        off <- peek poff
-        obj <- peekObject ptr
-        return $ Right (fromIntegral off, obj)
-      (#const MSGPACK_UNPACK_EXTRA_BYTES) -> do
-        off <- peek poff
-        obj <- peekObject ptr
-        return $ Right (fromIntegral off, obj)
-      (#const MSGPACK_UNPACK_CONTINUE) ->
-        return $ Left UnpackContinue
-      (#const MSGPACK_UNPACK_PARSE_ERROR) ->
-        return $ Left UnpackParseError
-      _ ->
-        return $ Left UnpackError
-
-foreign import ccall "msgpack_unpack" msgpack_unpack ::
-  Ptr CChar -> CSize -> Ptr CSize -> Zone -> Ptr () -> IO CInt

haskell/src/Data/MessagePack/Feed.hs

@@ -1,62 +0,0 @@
---------------------------------------------------------------------
--- |
--- Module    : Data.MessagePack.Feed
--- Copyright : (c) Hideyuki Tanaka, 2009
--- License   : BSD3
---
--- Maintainer:  tanaka.hideyuki@gmail.com
--- Stability :  experimental
--- Portability: portable
---
--- Feeders for Stream Deserializers
---
---------------------------------------------------------------------
-
-module Data.MessagePack.Feed(
-  -- * Feeder type
-  Feeder,
-  -- * Feeders
-  feederFromHandle,
-  feederFromFile,
-  feederFromString,
-  ) where
-
-import Data.ByteString (ByteString)
-import qualified Data.ByteString as BS
-import Data.IORef
-import System.IO
-
--- | Feeder returns Just ByteString when bytes remains, otherwise Nothing.
-type Feeder = IO (Maybe ByteString)
-
--- | Feeder from Handle
-feederFromHandle :: Handle -> IO Feeder
-feederFromHandle h = return $ do
-  bs <- BS.hGetNonBlocking h bufSize
-  if BS.length bs > 0
-    then do return $ Just bs
-    else do
-    c <- BS.hGet h 1
-    if BS.length c > 0
-      then do return $ Just c
-      else do
-      hClose h
-      return Nothing
-  where
-    bufSize = 4096
-
--- | Feeder from File
-feederFromFile :: FilePath -> IO Feeder
-feederFromFile path =
-  openFile path ReadMode >>= feederFromHandle
-
--- | Feeder from ByteString
-feederFromString :: ByteString -> IO Feeder
-feederFromString bs = do
-  r <- newIORef (Just bs)
-  return $ f r
-  where
-    f r = do
-      mb <- readIORef r
-      writeIORef r Nothing
-      return mb

haskell/src/Data/MessagePack/Iteratee.hs

@@ -0,0 +1,82 @@
+--------------------------------------------------------------------
+-- |
+-- Module    : Data.MessagePack.Iteratee
+-- Copyright : (c) Hideyuki Tanaka, 2009-2010
+-- License   : BSD3
+--
+-- Maintainer:  tanaka.hideyuki@gmail.com
+-- Stability :  experimental
+-- Portability: portable
+--
+-- MessagePack Deserializer interface to @Data.Iteratee@
+--
+--------------------------------------------------------------------
+
+module Data.MessagePack.Iteratee(
+  -- * Iteratee version of deserializer
+  getI,
+  -- * Non Blocking Enumerator
+  enumHandleNonBlocking,
+  -- * Convert Parser to Iteratee
+  parserToIteratee,
+  ) where
+
+import Control.Exception
+import Control.Monad.IO.Class
+import qualified Data.Attoparsec as A
+import qualified Data.ByteString as B
+import qualified Data.Iteratee as I
+import System.IO
+
+import Data.MessagePack.Parser
+
+-- | Deserialize a value
+getI :: (Monad m, ObjectGet a) => I.Iteratee B.ByteString m a
+getI = parserToIteratee get
+
+-- | Enumerator
+enumHandleNonBlocking :: MonadIO m => Int -> Handle -> I.Enumerator B.ByteString m a
+enumHandleNonBlocking bufSize h =
+  I.enumFromCallback $ readSome bufSize h
+
+readSome :: MonadIO m => Int -> Handle -> m (Either SomeException (Bool, B.ByteString))
+readSome bufSize h = liftIO $ do
+  ebs <- try $ hGetSome bufSize h
+  case ebs of
+    Left exc ->
+      return $ Left (exc :: SomeException)
+    Right bs | B.null bs ->
+      return $ Right (False, B.empty)
+    Right bs ->
+      return $ Right (True, bs)
+
+hGetSome :: Int -> Handle -> IO B.ByteString
+hGetSome bufSize h = do
+  bs <- B.hGetNonBlocking h bufSize
+  if B.null bs
+    then do
+    hd <- B.hGet h 1
+    if B.null hd
+      then do
+      return B.empty
+      else do
+      rest <- B.hGetNonBlocking h (bufSize - 1)
+      return $ B.cons (B.head hd) rest
+    else do
+    return bs
+
+-- | Convert Parser to Iteratee
+parserToIteratee :: Monad m => A.Parser a -> I.Iteratee B.ByteString m a
+parserToIteratee p = I.icont (itr (A.parse p)) Nothing
+  where
+    itr pcont s = case s of
+      I.EOF _ ->
+        I.throwErr (I.setEOF s)
+      I.Chunk bs ->
+        case pcont bs of
+          A.Fail _ _ msg ->
+            I.throwErr (I.iterStrExc msg)
+          A.Partial cont ->
+            I.icont (itr cont) Nothing
+          A.Done remain ret ->
+            I.idone ret (I.Chunk remain)

haskell/src/Data/MessagePack/Monad.hs

@@ -1,156 +0,0 @@
---------------------------------------------------------------------
--- |
--- Module    : Data.MessagePack.Monad
--- Copyright : (c) Hideyuki Tanaka, 2009
--- License   : BSD3
---
--- Maintainer:  tanaka.hideyuki@gmail.com
--- Stability :  experimental
--- Portability: portable
---
--- Monadic Stream Serializers and Deserializers
---
---------------------------------------------------------------------
-
-module Data.MessagePack.Monad(
-  -- * Classes
-  MonadPacker(..),
-  MonadUnpacker(..),
-  
-  -- * Packer and Unpacker type
-  PackerT(..),
-  UnpackerT(..),
-  
-  -- * Packers
-  packToString,
-  packToHandle,
-  packToFile,
-  
-  -- * Unpackers
-  unpackFrom,
-  unpackFromString,
-  unpackFromHandle,
-  unpackFromFile,
-  ) where
-
-import Control.Monad
-import Control.Monad.Trans
-import Data.ByteString (ByteString)
-import qualified Data.ByteString as BS
-import System.IO
-
-import Data.MessagePack.Base hiding (Unpacker)
-import qualified Data.MessagePack.Base as Base
-import Data.MessagePack.Class
-import Data.MessagePack.Feed
-
-class Monad m => MonadPacker m where
-  -- | Serialize a object
-  put :: OBJECT a => a -> m ()
-
-class Monad m => MonadUnpacker m where
-  -- | Deserialize a object
-  get :: OBJECT a => m a
-
--- | Serializer Type
-newtype PackerT m r = PackerT { runPackerT :: Base.Packer -> m r }
-
-instance Monad m => Monad (PackerT m) where
-  a >>= b =
-    PackerT $ \pc -> do
-      r <- runPackerT a pc
-      runPackerT (b r) pc
-  
-  return r =
-    PackerT $ \_ -> return r
-
-instance MonadTrans PackerT where
-  lift m = PackerT $ \_ -> m
-
-instance MonadIO m => MonadIO (PackerT m) where
-  liftIO = lift . liftIO
-
-instance MonadIO m => MonadPacker (PackerT m) where
-  put v = PackerT $ \pc -> liftIO $ do
-    pack pc v
-
--- | Execute given serializer and returns byte sequence.
-packToString :: MonadIO m => PackerT m r -> m ByteString
-packToString m = do
-  sb <- liftIO $ newSimpleBuffer
-  pc <- liftIO $ newPacker sb
-  _ <- runPackerT m pc
-  liftIO $ simpleBufferData sb
-
--- | Execute given serializer and write byte sequence to Handle.
-packToHandle :: MonadIO m => Handle -> PackerT m r -> m ()
-packToHandle h m = do
-  sb <- packToString m
-  liftIO $ BS.hPut h sb
-  liftIO $ hFlush h
-
--- | Execute given serializer and write byte sequence to file.
-packToFile :: MonadIO m => FilePath -> PackerT m r -> m ()
-packToFile p m = do
-  sb <- packToString m
-  liftIO $ BS.writeFile p sb
-
--- | Deserializer type
-newtype UnpackerT m r = UnpackerT { runUnpackerT :: Base.Unpacker -> Feeder -> m r }
-
-instance Monad m => Monad (UnpackerT m) where
-  a >>= b =
-    UnpackerT $ \up feed -> do
-      r <- runUnpackerT a up feed
-      runUnpackerT (b r) up feed
-  
-  return r =
-    UnpackerT $ \_ _ -> return r
-
-instance MonadTrans UnpackerT where
-  lift m = UnpackerT $ \_ _ -> m
-
-instance MonadIO m => MonadIO (UnpackerT m) where
-  liftIO = lift . liftIO
-
-instance MonadIO m => MonadUnpacker (UnpackerT m) where
-  get = UnpackerT $ \up feed -> liftIO $ do
-    executeOne up feed
-    obj <- unpackerData up
-    freeZone =<< unpackerReleaseZone up
-    unpackerReset up
-    let Right r = fromObject obj
-    return r
-    
-    where
-      executeOne up feed = do
-        resp <- unpackerExecute up
-        guard $ resp>=0
-        when (resp==0) $ do
-          Just bs <- feed
-          unpackerFeed up bs
-          executeOne up feed
-
--- | Execute deserializer using given feeder.
-unpackFrom :: MonadIO m => Feeder -> UnpackerT m r -> m r
-unpackFrom f m = do
-  up <- liftIO $ newUnpacker defaultInitialBufferSize
-  runUnpackerT m up f
-
--- | Execute deserializer using given handle.
-unpackFromHandle :: MonadIO m => Handle -> UnpackerT m r -> m r
-unpackFromHandle h m =
-  flip unpackFrom m =<< liftIO (feederFromHandle h)
-
--- | Execute deserializer using given file content.
-unpackFromFile :: MonadIO m => FilePath -> UnpackerT m r -> m r
-unpackFromFile p m = do
-  h <- liftIO $ openFile p ReadMode
-  r <- flip unpackFrom m =<< liftIO (feederFromHandle h)
-  liftIO $ hClose h
-  return r
-
--- | Execute deserializer from given byte sequence.
-unpackFromString :: MonadIO m => ByteString -> UnpackerT m r -> m r
-unpackFromString bs m = do
-  flip unpackFrom m =<< liftIO (feederFromString bs)

haskell/src/Data/MessagePack/Object.hs

@@ -1,38 +1,65 @@
-{-# LANGUAGE TypeSynonymInstances #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE OverlappingInstances #-}
-{-# LANGUAGE IncoherentInstances #-}
+{-# Language TypeSynonymInstances #-}
+{-# Language FlexibleInstances #-}
+{-# Language OverlappingInstances #-}
+{-# Language DeriveDataTypeable #-}
 
 --------------------------------------------------------------------
 -- |
--- Module    : Data.MessagePack.Class
--- Copyright : (c) Hideyuki Tanaka, 2009
+-- Module    : Data.MessagePack.Object
+-- Copyright : (c) Hideyuki Tanaka, 2009-2010
 -- License   : BSD3
 --
 -- Maintainer:  tanaka.hideyuki@gmail.com
 -- Stability :  experimental
 -- Portability: portable
 --
--- Serializing Haskell values to and from MessagePack Objects.
+-- MessagePack object definition
 --
 --------------------------------------------------------------------
 
-module Data.MessagePack.Class(
+module Data.MessagePack.Object(
+  -- * MessagePack Object
+  Object(..),
+  
   -- * Serialization to and from Object
   OBJECT(..),
   Result,
-  pack,
   ) where
 
-import Control.Monad.Error
-import Data.ByteString.Char8 (ByteString)
+import Control.DeepSeq
+import Control.Monad
+import Control.Monad.Trans.Error ()
+import qualified Data.ByteString as B
 import qualified Data.ByteString.Char8 as C8
+import Data.Typeable
 
-import Data.MessagePack.Base
+-- | Object Representation of MessagePack data.
+data Object =
+  ObjectNil
+  | ObjectBool Bool
+  | ObjectInteger Int
+  | ObjectDouble Double
+  | ObjectRAW B.ByteString
+  | ObjectArray [Object]
+  | ObjectMap [(Object, Object)]
+  deriving (Show, Eq, Ord, Typeable)
+
+instance NFData Object where
+  rnf obj =
+    case obj of
+      ObjectNil -> ()
+      ObjectBool b -> rnf b
+      ObjectInteger n -> rnf n
+      ObjectDouble d -> rnf d
+      ObjectRAW bs -> bs `seq` ()
+      ObjectArray a -> rnf a
+      ObjectMap m -> rnf m
 
 -- | The class of types serializable to and from MessagePack object
 class OBJECT a where
+  -- | Encode a value to MessagePack object
   toObject :: a -> Object
+  -- | Decode a value from MessagePack object
   fromObject :: Object -> Result a
 
 -- | A type for parser results
@@ -65,7 +92,7 @@ instance OBJECT Double where
   fromObject (ObjectDouble d) = Right d
   fromObject _ = Left fromObjectError
 
-instance OBJECT ByteString where
+instance OBJECT B.ByteString where
   toObject = ObjectRAW
   fromObject (ObjectRAW bs) = Right bs
   fromObject _ = Left fromObjectError
@@ -95,7 +122,3 @@ instance OBJECT a => OBJECT (Maybe a) where
   
   fromObject ObjectNil = return Nothing
   fromObject obj = liftM Just $ fromObject obj
-
--- | Pack a serializable Haskell value.
-pack :: OBJECT a => Packer -> a -> IO ()
-pack pc = packObject pc . toObject

haskell/src/Data/MessagePack/Parser.hs

@@ -0,0 +1,270 @@
+{-# Language FlexibleInstances #-}
+{-# Language IncoherentInstances #-}
+{-# Language OverlappingInstances #-}
+{-# Language TypeSynonymInstances #-}
+
+--------------------------------------------------------------------
+-- |
+-- Module    : Data.MessagePack.Parser
+-- Copyright : (c) Hideyuki Tanaka, 2009-2010
+-- License   : BSD3
+--
+-- Maintainer:  tanaka.hideyuki@gmail.com
+-- Stability :  experimental
+-- Portability: portable
+--
+-- MessagePack Deserializer using @Data.Attoparsec@
+--
+--------------------------------------------------------------------
+
+module Data.MessagePack.Parser(
+  -- * MessagePack deserializer
+  ObjectGet(..),
+  ) where
+
+import Control.Monad
+import qualified Data.Attoparsec as A
+import Data.Binary.Get
+import Data.Binary.IEEE754
+import Data.Bits
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Char8 as B8
+import qualified Data.ByteString.Lazy as L
+import Data.Int
+import qualified Data.Vector as V
+import Data.Word
+import Text.Printf
+
+import Data.MessagePack.Object
+
+-- | Deserializable class
+class ObjectGet a where
+  -- | Deserialize a value
+  get :: A.Parser a
+
+instance ObjectGet Object where
+  get =
+    A.choice
+    [ liftM ObjectInteger get
+    , liftM (\() -> ObjectNil) get
+    , liftM ObjectBool get
+    , liftM ObjectDouble get
+    , liftM ObjectRAW get
+    , liftM ObjectArray get
+    , liftM ObjectMap get
+    ]
+
+instance ObjectGet Int where
+  get = do
+    c <- A.anyWord8
+    case c of
+      _ | c .&. 0x80 == 0x00 ->
+        return $ fromIntegral c
+      _ | c .&. 0xE0 == 0xE0 ->
+        return $ fromIntegral (fromIntegral c :: Int8)
+      0xCC ->
+        return . fromIntegral =<< A.anyWord8
+      0xCD ->
+        return . fromIntegral =<< parseUint16
+      0xCE ->
+        return . fromIntegral =<< parseUint32
+      0xCF ->
+        return . fromIntegral =<< parseUint64
+      0xD0 ->
+        return . fromIntegral =<< parseInt8
+      0xD1 ->
+        return . fromIntegral =<< parseInt16
+      0xD2 ->
+        return . fromIntegral =<< parseInt32
+      0xD3 ->
+        return . fromIntegral =<< parseInt64
+      _ ->
+        fail $ printf "invlid integer tag: 0x%02X" c
+
+instance ObjectGet () where
+  get = do
+    c <- A.anyWord8
+    case c of
+      0xC0 ->
+        return ()
+      _ ->
+        fail $ printf "invlid nil tag: 0x%02X" c
+
+instance ObjectGet Bool where
+  get = do
+    c <- A.anyWord8
+    case c of
+      0xC3 ->
+        return True
+      0xC2 ->
+        return False
+      _ ->
+        fail $ printf "invlid bool tag: 0x%02X" c
+
+instance ObjectGet Double where
+  get = do
+    c <- A.anyWord8
+    case c of
+      0xCA ->
+        return . realToFrac . runGet getFloat32be . toLBS =<< A.take 4
+      0xCB ->
+        return . runGet getFloat64be . toLBS =<< A.take 8
+      _ ->
+        fail $ printf "invlid double tag: 0x%02X" c
+
+instance ObjectGet String where
+  get = parseString (\n -> return . B8.unpack =<< A.take n)
+
+instance ObjectGet B.ByteString where
+  get = parseString A.take
+
+instance ObjectGet L.ByteString where
+  get = parseString (\n -> do bs <- A.take n; return $ L.fromChunks [bs])
+
+parseString :: (Int -> A.Parser a) -> A.Parser a
+parseString aget = do
+  c <- A.anyWord8
+  case c of
+    _ | c .&. 0xE0 == 0xA0 ->
+      aget . fromIntegral $ c .&. 0x1F
+    0xDA ->
+      aget . fromIntegral =<< parseUint16
+    0xDB ->
+      aget . fromIntegral =<< parseUint32
+    _ ->
+      fail $ printf "invlid raw tag: 0x%02X" c
+
+instance ObjectGet a => ObjectGet [a] where
+  get = parseArray (flip replicateM get)
+
+instance ObjectGet a => ObjectGet (V.Vector a) where
+  get = parseArray (flip V.replicateM get)
+
+instance (ObjectGet a1, ObjectGet a2) => ObjectGet (a1, a2) where
+  get = parseArray f where
+    f 2 = get >>= \a1 -> get >>= \a2 -> return (a1, a2)
+    f n = fail $ printf "wrong tupple size: expected 2 but got " n
+
+instance (ObjectGet a1, ObjectGet a2, ObjectGet a3) => ObjectGet (a1, a2, a3) where
+  get = parseArray f where
+    f 3 = get >>= \a1 -> get >>= \a2 -> get >>= \a3 -> return (a1, a2, a3)
+    f n = fail $ printf "wrong tupple size: expected 3 but got " n
+
+instance (ObjectGet a1, ObjectGet a2, ObjectGet a3, ObjectGet a4) => ObjectGet (a1, a2, a3, a4) where
+  get = parseArray f where
+    f 4 = get >>= \a1 -> get >>= \a2 -> get >>= \a3 -> get >>= \a4 -> return (a1, a2, a3, a4)
+    f n = fail $ printf "wrong tupple size: expected 4 but got " n
+
+instance (ObjectGet a1, ObjectGet a2, ObjectGet a3, ObjectGet a4, ObjectGet a5) => ObjectGet (a1, a2, a3, a4, a5) where
+  get = parseArray f where
+    f 5 = get >>= \a1 -> get >>= \a2 -> get >>= \a3 -> get >>= \a4 -> get >>= \a5 -> return (a1, a2, a3, a4, a5)
+    f n = fail $ printf "wrong tupple size: expected 5 but got " n
+
+instance (ObjectGet a1, ObjectGet a2, ObjectGet a3, ObjectGet a4, ObjectGet a5, ObjectGet a6) => ObjectGet (a1, a2, a3, a4, a5, a6) where
+  get = parseArray f where
+    f 6 = get >>= \a1 -> get >>= \a2 -> get >>= \a3 -> get >>= \a4 -> get >>= \a5 -> get >>= \a6 -> return (a1, a2, a3, a4, a5, a6)
+    f n = fail $ printf "wrong tupple size: expected 6 but got " n
+
+instance (ObjectGet a1, ObjectGet a2, ObjectGet a3, ObjectGet a4, ObjectGet a5, ObjectGet a6, ObjectGet a7) => ObjectGet (a1, a2, a3, a4, a5, a6, a7) where
+  get = parseArray f where
+    f 7 = get >>= \a1 -> get >>= \a2 -> get >>= \a3 -> get >>= \a4 -> get >>= \a5 -> get >>= \a6 -> get >>= \a7 -> return (a1, a2, a3, a4, a5, a6, a7)
+    f n = fail $ printf "wrong tupple size: expected 7 but got " n
+
+instance (ObjectGet a1, ObjectGet a2, ObjectGet a3, ObjectGet a4, ObjectGet a5, ObjectGet a6, ObjectGet a7, ObjectGet a8) => ObjectGet (a1, a2, a3, a4, a5, a6, a7, a8) where
+  get = parseArray f where
+    f 8 = get >>= \a1 -> get >>= \a2 -> get >>= \a3 -> get >>= \a4 -> get >>= \a5 -> get >>= \a6 -> get >>= \a7 -> get >>= \a8 -> return (a1, a2, a3, a4, a5, a6, a7, a8)
+    f n = fail $ printf "wrong tupple size: expected 8 but got " n
+
+instance (ObjectGet a1, ObjectGet a2, ObjectGet a3, ObjectGet a4, ObjectGet a5, ObjectGet a6, ObjectGet a7, ObjectGet a8, ObjectGet a9) => ObjectGet (a1, a2, a3, a4, a5, a6, a7, a8, a9) where
+  get = parseArray f where
+    f 9 = get >>= \a1 -> get >>= \a2 -> get >>= \a3 -> get >>= \a4 -> get >>= \a5 -> get >>= \a6 -> get >>= \a7 -> get >>= \a8 -> get >>= \a9 -> return (a1, a2, a3, a4, a5, a6, a7, a8, a9)
+    f n = fail $ printf "wrong tupple size: expected 9 but got " n
+
+parseArray :: (Int -> A.Parser a) -> A.Parser a
+parseArray aget = do
+  c <- A.anyWord8
+  case c of
+    _ | c .&. 0xF0 == 0x90 ->
+      aget . fromIntegral $ c .&. 0x0F
+    0xDC ->
+      aget . fromIntegral =<< parseUint16
+    0xDD ->
+      aget . fromIntegral =<< parseUint32
+    _ ->
+      fail $ printf "invlid array tag: 0x%02X" c
+
+instance (ObjectGet k, ObjectGet v) => ObjectGet [(k, v)] where
+  get = parseMap (flip replicateM parsePair)
+
+instance (ObjectGet k, ObjectGet v) => ObjectGet (V.Vector (k, v)) where
+  get = parseMap (flip V.replicateM parsePair)
+
+parsePair :: (ObjectGet k, ObjectGet v) => A.Parser (k, v)
+parsePair = do
+  a <- get
+  b <- get
+  return (a, b)
+
+parseMap :: (Int -> A.Parser a) -> A.Parser a
+parseMap aget = do
+  c <- A.anyWord8
+  case c of
+    _ | c .&. 0xF0 == 0x80 ->
+      aget . fromIntegral $ c .&. 0x0F
+    0xDE ->
+      aget . fromIntegral =<< parseUint16
+    0xDF ->
+      aget . fromIntegral =<< parseUint32
+    _ ->
+      fail $ printf "invlid map tag: 0x%02X" c
+
+parseUint16 :: A.Parser Word16
+parseUint16 = do
+  b0 <- A.anyWord8
+  b1 <- A.anyWord8
+  return $ (fromIntegral b0 `shiftL` 8) .|. fromIntegral b1
+
+parseUint32 :: A.Parser Word32
+parseUint32 = do
+  b0 <- A.anyWord8
+  b1 <- A.anyWord8
+  b2 <- A.anyWord8
+  b3 <- A.anyWord8
+  return $ (fromIntegral b0 `shiftL` 24) .|.
+           (fromIntegral b1 `shiftL` 16) .|.
+           (fromIntegral b2 `shiftL` 8) .|.
+           fromIntegral b3
+
+parseUint64 :: A.Parser Word64
+parseUint64 = do
+  b0 <- A.anyWord8
+  b1 <- A.anyWord8
+  b2 <- A.anyWord8
+  b3 <- A.anyWord8
+  b4 <- A.anyWord8
+  b5 <- A.anyWord8
+  b6 <- A.anyWord8
+  b7 <- A.anyWord8
+  return $ (fromIntegral b0 `shiftL` 56) .|.
+           (fromIntegral b1 `shiftL` 48) .|.
+           (fromIntegral b2 `shiftL` 40) .|.
+           (fromIntegral b3 `shiftL` 32) .|.
+           (fromIntegral b4 `shiftL` 24) .|.
+           (fromIntegral b5 `shiftL` 16) .|.
+           (fromIntegral b6 `shiftL` 8) .|.
+           fromIntegral b7
+
+parseInt8 :: A.Parser Int8
+parseInt8 = return . fromIntegral =<< A.anyWord8
+
+parseInt16 :: A.Parser Int16
+parseInt16 = return . fromIntegral =<< parseUint16
+
+parseInt32 :: A.Parser Int32
+parseInt32 = return . fromIntegral =<< parseUint32
+
+parseInt64 :: A.Parser Int64
+parseInt64 = return . fromIntegral =<< parseUint64
+
+toLBS :: B.ByteString -> L.ByteString
+toLBS bs = L.fromChunks [bs]

haskell/src/Data/MessagePack/Put.hs

@@ -0,0 +1,196 @@
+{-# Language FlexibleInstances #-}
+{-# Language IncoherentInstances #-}
+{-# Language OverlappingInstances #-}
+{-# Language TypeSynonymInstances #-}
+
+--------------------------------------------------------------------
+-- |
+-- Module    : Data.MessagePack.Put
+-- Copyright : (c) Hideyuki Tanaka, 2009-2010
+-- License   : BSD3
+--
+-- Maintainer:  tanaka.hideyuki@gmail.com
+-- Stability :  experimental
+-- Portability: portable
+--
+-- MessagePack Serializer using @Data.Binary.Put@
+--
+--------------------------------------------------------------------
+
+module Data.MessagePack.Put(
+  -- * Serializable class
+  ObjectPut(..),
+  ) where
+
+import Data.Binary.Put
+import Data.Binary.IEEE754
+import Data.Bits
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Char8 as B8
+import qualified Data.ByteString.Lazy as L
+import qualified Data.Vector as V
+
+import Data.MessagePack.Object
+
+-- | Serializable class
+class ObjectPut a where
+  -- | Serialize a value
+  put :: a -> Put
+
+instance ObjectPut Object where
+  put obj =
+    case obj of
+      ObjectInteger n ->
+        put n
+      ObjectNil ->
+        put ()
+      ObjectBool b ->
+        put b
+      ObjectDouble d ->
+        put d
+      ObjectRAW raw ->
+        put raw
+      ObjectArray arr ->
+        put arr
+      ObjectMap m ->
+        put m
+
+instance ObjectPut Int where
+  put n =
+    case n of
+      _ | n >= 0 && n <= 127 ->
+        putWord8 $ fromIntegral n
+      _ | n >= -32 && n <= -1 ->
+        putWord8 $ fromIntegral n
+      _ | n >= 0 && n < 0x100 -> do
+        putWord8 0xCC
+        putWord8 $ fromIntegral n
+      _ | n >= 0 && n < 0x10000 -> do
+        putWord8 0xCD
+        putWord16be $ fromIntegral n
+      _ | n >= 0 && n < 0x100000000 -> do
+        putWord8 0xCE
+        putWord32be $ fromIntegral n
+      _ | n >= 0 -> do
+        putWord8 0xCF
+        putWord64be $ fromIntegral n
+      _ | n >= -0x80 -> do
+        putWord8 0xD0
+        putWord8 $ fromIntegral n
+      _ | n >= -0x8000 -> do
+        putWord8 0xD1
+        putWord16be $ fromIntegral n
+      _ | n >= -0x80000000 -> do
+        putWord8 0xD2
+        putWord32be $ fromIntegral n
+      _ -> do
+        putWord8 0xD3
+        putWord64be $ fromIntegral n
+
+instance ObjectPut () where
+  put _ = 
+    putWord8 0xC0
+
+instance ObjectPut Bool where
+  put True = putWord8 0xC3
+  put False = putWord8 0xC2
+
+instance ObjectPut Double where
+  put d = do
+    putWord8 0xCB
+    putFloat64be d
+
+instance ObjectPut String where
+  put = putString length (putByteString . B8.pack)
+
+instance ObjectPut B.ByteString where
+  put = putString B.length putByteString
+
+instance ObjectPut L.ByteString where
+  put = putString (fromIntegral . L.length) putLazyByteString
+
+putString :: (s -> Int) -> (s -> Put) -> s -> Put
+putString lf pf str = do
+  case lf str of
+    len | len <= 31 -> do
+      putWord8 $ 0xA0 .|. fromIntegral len
+    len | len < 0x10000 -> do
+      putWord8 0xDA
+      putWord16be $ fromIntegral len
+    len -> do
+      putWord8 0xDB
+      putWord32be $ fromIntegral len
+  pf str
+
+instance ObjectPut a => ObjectPut [a] where
+  put = putArray length (mapM_ put)
+
+instance ObjectPut a => ObjectPut (V.Vector a) where
+  put = putArray V.length (V.mapM_ put)
+
+instance (ObjectPut a1, ObjectPut a2) => ObjectPut (a1, a2) where
+  put = putArray (const 2) f where
+    f (a1, a2) = put a1 >> put a2
+
+instance (ObjectPut a1, ObjectPut a2, ObjectPut a3) => ObjectPut (a1, a2, a3) where
+  put = putArray (const 3) f where
+    f (a1, a2, a3) = put a1 >> put a2 >> put a3
+
+instance (ObjectPut a1, ObjectPut a2, ObjectPut a3, ObjectPut a4) => ObjectPut (a1, a2, a3, a4) where
+  put = putArray (const 4) f where
+    f (a1, a2, a3, a4) = put a1 >> put a2 >> put a3 >> put a4
+
+instance (ObjectPut a1, ObjectPut a2, ObjectPut a3, ObjectPut a4, ObjectPut a5) => ObjectPut (a1, a2, a3, a4, a5) where
+  put = putArray (const 5) f where
+    f (a1, a2, a3, a4, a5) = put a1 >> put a2 >> put a3 >> put a4 >> put a5
+
+instance (ObjectPut a1, ObjectPut a2, ObjectPut a3, ObjectPut a4, ObjectPut a5, ObjectPut a6) => ObjectPut (a1, a2, a3, a4, a5, a6) where
+  put = putArray (const 6) f where
+    f (a1, a2, a3, a4, a5, a6) = put a1 >> put a2 >> put a3 >> put a4 >> put a5 >> put a6
+
+instance (ObjectPut a1, ObjectPut a2, ObjectPut a3, ObjectPut a4, ObjectPut a5, ObjectPut a6, ObjectPut a7) => ObjectPut (a1, a2, a3, a4, a5, a6, a7) where
+  put = putArray (const 7) f where
+    f (a1, a2, a3, a4, a5, a6, a7) = put a1 >> put a2 >> put a3 >> put a4 >> put a5 >> put a6 >> put a7
+
+instance (ObjectPut a1, ObjectPut a2, ObjectPut a3, ObjectPut a4, ObjectPut a5, ObjectPut a6, ObjectPut a7, ObjectPut a8) => ObjectPut (a1, a2, a3, a4, a5, a6, a7, a8) where
+  put = putArray (const 8) f where
+    f (a1, a2, a3, a4, a5, a6, a7, a8) = put a1 >> put a2 >> put a3 >> put a4 >> put a5 >> put a6 >> put a7 >> put a8
+
+instance (ObjectPut a1, ObjectPut a2, ObjectPut a3, ObjectPut a4, ObjectPut a5, ObjectPut a6, ObjectPut a7, ObjectPut a8, ObjectPut a9) => ObjectPut (a1, a2, a3, a4, a5, a6, a7, a8, a9) where
+  put = putArray (const 9) f where
+    f (a1, a2, a3, a4, a5, a6, a7, a8, a9) = put a1 >> put a2 >> put a3 >> put a4 >> put a5 >> put a6 >> put a7 >> put a8 >> put a9
+
+putArray :: (a -> Int) -> (a -> Put) -> a -> Put
+putArray lf pf arr = do
+  case lf arr of
+    len | len <= 15 ->
+      putWord8 $ 0x90 .|. fromIntegral len
+    len | len < 0x10000 -> do
+      putWord8 0xDC
+      putWord16be $ fromIntegral len
+    len -> do
+      putWord8 0xDD
+      putWord32be $ fromIntegral len
+  pf arr
+
+instance (ObjectPut k, ObjectPut v) => ObjectPut [(k, v)] where
+  put = putMap length (mapM_ putPair)
+
+instance (ObjectPut k, ObjectPut v) => ObjectPut (V.Vector (k, v)) where
+  put = putMap V.length (V.mapM_ putPair)
+
+putPair :: (ObjectPut a, ObjectPut b) => (a, b) -> Put
+putPair (a, b) = put a >> put b
+
+putMap :: (a -> Int) -> (a -> Put) -> a -> Put
+putMap lf pf m = do
+  case lf m of
+    len | len <= 15 ->
+      putWord8 $ 0x80 .|. fromIntegral len
+    len | len < 0x10000 -> do
+      putWord8 0xDE
+      putWord16be $ fromIntegral len
+    len -> do
+      putWord8 0xDF
+      putWord32be $ fromIntegral len
+  pf m

haskell/src/Data/MessagePack/Stream.hs

@@ -1,82 +0,0 @@
---------------------------------------------------------------------
--- |
--- Module    : Data.MessagePack.Stream
--- Copyright : (c) Hideyuki Tanaka, 2009
--- License   : BSD3
---
--- Maintainer:  tanaka.hideyuki@gmail.com
--- Stability :  experimental
--- Portability: portable
---
--- Lazy Stream Serializers and Deserializers
---
---------------------------------------------------------------------
-
-module Data.MessagePack.Stream(
-  unpackObjects,
-  unpackObjectsFromFile,
-  unpackObjectsFromHandle,
-  unpackObjectsFromString,
-  ) where
-
-import Data.ByteString (ByteString)
-import System.IO
-import System.IO.Unsafe
-
-import Data.MessagePack.Base
-import Data.MessagePack.Feed
-
--- | Unpack objects using given feeder.
-unpackObjects :: Feeder -> IO [Object]
-unpackObjects feeder = do
-  up <- newUnpacker defaultInitialBufferSize
-  f up
-  where
-  f up = unsafeInterleaveIO $ do
-    mbo <- unpackOnce up
-    case mbo of
-      Just o -> do
-        os <- f up
-        return $ o:os
-      Nothing ->
-        return []
-
-  unpackOnce up = do
-    resp <- unpackerExecute up
-    case resp of
-      0 -> do
-        r <- feedOnce up
-        if r
-          then unpackOnce up
-          else return Nothing
-      1 -> do
-        obj <- unpackerData up
-        freeZone =<< unpackerReleaseZone up
-        unpackerReset up
-        return $ Just obj
-      _ ->
-        error $ "unpackerExecute fails: " ++ show resp
-
-  feedOnce up = do
-    dat <- feeder
-    case dat of
-      Nothing ->
-        return False
-      Just bs -> do
-        unpackerFeed up bs
-        return True
-
--- | Unpack objects from file.
-unpackObjectsFromFile :: FilePath -> IO [Object]
-unpackObjectsFromFile fname =
-  unpackObjects =<< feederFromFile fname
-
--- | Unpack objects from handle.
-unpackObjectsFromHandle :: Handle -> IO [Object]
-unpackObjectsFromHandle h =
-  unpackObjects =<< feederFromHandle h
-  
--- | Unpack oobjects from given byte sequence.
-unpackObjectsFromString :: ByteString -> IO [Object]
-unpackObjectsFromString bs =
-  unpackObjects =<< feederFromString bs

haskell/test/Monad.hs

@@ -1,16 +1,21 @@
-import Control.Monad.Trans
+{-# Language OverloadedStrings #-}
+
+import Control.Monad.IO.Class
+import qualified Data.ByteString as B
 import Data.MessagePack
 
 main = do
-  sb <- packToString $ do
+  sb <- return $ packToString $ do
     put [1,2,3::Int]
     put (3.14 :: Double)
-    put "Hoge"
+    put ("Hoge" :: B.ByteString)
   
   print sb
   
-  unpackFromString sb $ do
+  r <- unpackFromString sb $ do
     arr <- get
     dbl <- get
     str <- get
-    liftIO $ print (arr :: [Int], dbl :: Double, str :: String)
+    return (arr :: [Int], dbl :: Double, str :: B.ByteString)
+  
+  print r

haskell/test/Stream.hs

@@ -1,14 +0,0 @@
-import Control.Applicative
-import qualified Data.ByteString as BS
-import Data.MessagePack
-
-main = do
-  sb <- newSimpleBuffer
-  pc <- newPacker sb
-  pack pc [1,2,3::Int]
-  pack pc True
-  pack pc "hoge"
-  bs <- simpleBufferData sb
-  
-  os <- unpackObjectsFromString bs
-  mapM_ print os

haskell/test/Test.hs

@@ -1,36 +1,64 @@
+import Test.Framework
+import Test.Framework.Providers.QuickCheck2
+import Test.QuickCheck
+
 import Control.Monad
+import qualified Data.ByteString.Char8 as B
+import qualified Data.ByteString.Lazy.Char8 as L
 import Data.MessagePack
 
-{-
-main = do
-  sb <- newSimpleBuffer
-  pc <- newPacker sb
-  
-  pack pc [(1,2),(2,3),(3::Int,4::Int)]
-  pack pc [4,5,6::Int]
-  pack pc "hoge"
-  
-  bs <- simpleBufferData sb
-  print bs
-  
-  up <- newUnpacker defaultInitialBufferSize
-  
-  unpackerFeed up bs
+mid :: (ObjectGet a, ObjectPut a) => a -> a
+mid = unpack . pack
 
-  let f = do
-        res <- unpackerExecute up
-        when (res==1) $ do
-          obj <- unpackerData up
-          print obj
-          f
-  
-  f
+prop_mid_int a = a == mid a
+  where types = a :: Int
+prop_mid_nil a = a == mid a
+  where types = a :: ()
+prop_mid_bool a = a == mid a
+  where types = a :: Bool
+prop_mid_double a = a == mid a
+  where types = a :: Double
+prop_mid_string a = a == mid a
+  where types = a :: String
+prop_mid_bytestring a = B.pack a == mid (B.pack a)
+  where types = a :: String
+prop_mid_lazy_bytestring a = (L.pack a) == mid (L.pack a)
+  where types = a :: String
+prop_mid_array_int a = a == mid a
+  where types = a :: [Int]
+prop_mid_array_string a = a == mid a
+  where types = a :: [String]
+prop_mid_pair2 a = a == mid a
+  where types = a :: (Int, Int)
+prop_mid_pair3 a = a == mid a
+  where types = a :: (Int, Int, Int)
+prop_mid_pair4 a = a == mid a
+  where types = a :: (Int, Int, Int, Int)
+prop_mid_pair5 a = a == mid a
+  where types = a :: (Int, Int, Int, Int, Int)
+prop_mid_map_int_double a = a == mid a
+  where types = a :: [(Int, Double)]
+prop_mid_map_string_string a = a == mid a
+  where types = a :: [(String, String)]
 
-  return ()
--}
+tests =
+  [ testGroup "simple"
+    [ testProperty "int" prop_mid_int
+    , testProperty "nil" prop_mid_nil
+    , testProperty "bool" prop_mid_bool
+    , testProperty "double" prop_mid_double
+    , testProperty "string" prop_mid_string
+    , testProperty "bytestring" prop_mid_bytestring
+    , testProperty "lazy-bytestring" prop_mid_lazy_bytestring
+    , testProperty "[int]" prop_mid_array_int
+    , testProperty "[string]" prop_mid_array_string
+    , testProperty "(int, int)" prop_mid_pair2
+    , testProperty "(int, int, int)" prop_mid_pair3
+    , testProperty "(int, int, int, int)" prop_mid_pair4
+    , testProperty "(int, int, int, int, int)" prop_mid_pair5
+    , testProperty "[(int, double)]" prop_mid_map_int_double
+    , testProperty "[(string, string)]" prop_mid_map_string_string
+    ]
+  ]
 
-main = do
-  bs <- packb [(1,2),(2,3),(3::Int,4::Int)]
-  print bs
-  dat <- unpackb bs
-  print (dat :: Result [(Int, Int)])
+main = defaultMain tests

java/src/test/java/org/msgpack/TestMessageUnpackable.java

@@ -24,9 +24,7 @@ public class TestMessageUnpackable {
 		Image dst = new Image();
 
 		ByteArrayInputStream in = new ByteArrayInputStream(out.toByteArray());
-		Unpacker pac = new Unpacker(in);
-
-		dst.messageUnpack(pac);
+		dst.messageUnpack(new Unpacker(in));
 
 		assertEquals(src, dst);
 	}

msgpack/pack_template.h

@@ -69,7 +69,7 @@ do { \
 	} else { \
 		/* unsigned 16 */ \
 		unsigned char buf[3]; \
-		buf[0] = 0xcd; _msgpack_store16(&buf[1], d); \
+		buf[0] = 0xcd; _msgpack_store16(&buf[1], (uint16_t)d); \
 		msgpack_pack_append_buffer(x, buf, 3); \
 	} \
 } while(0)
@@ -89,12 +89,12 @@ do { \
 		if(d < (1<<16)) { \
 			/* unsigned 16 */ \
 			unsigned char buf[3]; \
-			buf[0] = 0xcd; _msgpack_store16(&buf[1], d); \
+			buf[0] = 0xcd; _msgpack_store16(&buf[1], (uint16_t)d); \
 			msgpack_pack_append_buffer(x, buf, 3); \
 		} else { \
 			/* unsigned 32 */ \
 			unsigned char buf[5]; \
-			buf[0] = 0xce; _msgpack_store32(&buf[1], d); \
+			buf[0] = 0xce; _msgpack_store32(&buf[1], (uint32_t)d); \
 			msgpack_pack_append_buffer(x, buf, 5); \
 		} \
 	} \
@@ -103,7 +103,7 @@ do { \
 #define msgpack_pack_real_uint64(x, d) \
 do { \
 	if(d < (1ULL<<8)) { \
-		if(d < (1<<7)) { \
+		if(d < (1ULL<<7)) { \
 			/* fixnum */ \
 			msgpack_pack_append_buffer(x, &TAKE8_64(d), 1); \
 		} else { \
@@ -115,12 +115,12 @@ do { \
 		if(d < (1ULL<<16)) { \
 			/* unsigned 16 */ \
 			unsigned char buf[3]; \
-			buf[0] = 0xcd; _msgpack_store16(&buf[1], d); \
+			buf[0] = 0xcd; _msgpack_store16(&buf[1], (uint16_t)d); \
 			msgpack_pack_append_buffer(x, buf, 3); \
 		} else if(d < (1ULL<<32)) { \
 			/* unsigned 32 */ \
 			unsigned char buf[5]; \
-			buf[0] = 0xce; _msgpack_store32(&buf[1], d); \
+			buf[0] = 0xce; _msgpack_store32(&buf[1], (uint32_t)d); \
 			msgpack_pack_append_buffer(x, buf, 5); \
 		} else { \
 			/* unsigned 64 */ \
@@ -149,7 +149,7 @@ do { \
 		if(d < -(1<<7)) { \
 			/* signed 16 */ \
 			unsigned char buf[3]; \
-			buf[0] = 0xd1; _msgpack_store16(&buf[1], d); \
+			buf[0] = 0xd1; _msgpack_store16(&buf[1], (int16_t)d); \
 			msgpack_pack_append_buffer(x, buf, 3); \
 		} else { \
 			/* signed 8 */ \
@@ -167,7 +167,7 @@ do { \
 		} else { \
 			/* unsigned 16 */ \
 			unsigned char buf[3]; \
-			buf[0] = 0xcd; _msgpack_store16(&buf[1], d); \
+			buf[0] = 0xcd; _msgpack_store16(&buf[1], (uint16_t)d); \
 			msgpack_pack_append_buffer(x, buf, 3); \
 		} \
 	} \
@@ -179,12 +179,12 @@ do { \
 		if(d < -(1<<15)) { \
 			/* signed 32 */ \
 			unsigned char buf[5]; \
-			buf[0] = 0xd2; _msgpack_store32(&buf[1], d); \
+			buf[0] = 0xd2; _msgpack_store32(&buf[1], (int32_t)d); \
 			msgpack_pack_append_buffer(x, buf, 5); \
 		} else if(d < -(1<<7)) { \
 			/* signed 16 */ \
 			unsigned char buf[3]; \
-			buf[0] = 0xd1; _msgpack_store16(&buf[1], d); \
+			buf[0] = 0xd1; _msgpack_store16(&buf[1], (int16_t)d); \
 			msgpack_pack_append_buffer(x, buf, 3); \
 		} else { \
 			/* signed 8 */ \
@@ -202,12 +202,12 @@ do { \
 		} else if(d < (1<<16)) { \
 			/* unsigned 16 */ \
 			unsigned char buf[3]; \
-			buf[0] = 0xcd; _msgpack_store16(&buf[1], d); \
+			buf[0] = 0xcd; _msgpack_store16(&buf[1], (uint16_t)d); \
 			msgpack_pack_append_buffer(x, buf, 3); \
 		} else { \
 			/* unsigned 32 */ \
 			unsigned char buf[5]; \
-			buf[0] = 0xce; _msgpack_store32(&buf[1], d); \
+			buf[0] = 0xce; _msgpack_store32(&buf[1], (uint32_t)d); \
 			msgpack_pack_append_buffer(x, buf, 5); \
 		} \
 	} \
@@ -225,14 +225,14 @@ do { \
 			} else { \
 				/* signed 32 */ \
 				unsigned char buf[5]; \
-				buf[0] = 0xd2; _msgpack_store32(&buf[1], d); \
+				buf[0] = 0xd2; _msgpack_store32(&buf[1], (int32_t)d); \
 				msgpack_pack_append_buffer(x, buf, 5); \
 			} \
 		} else { \
 			if(d < -(1<<7)) { \
 				/* signed 16 */ \
 				unsigned char buf[3]; \
-				buf[0] = 0xd1; _msgpack_store16(&buf[1], d); \
+				buf[0] = 0xd1; _msgpack_store16(&buf[1], (int16_t)d); \
 				msgpack_pack_append_buffer(x, buf, 3); \
 			} else { \
 				/* signed 8 */ \
@@ -252,14 +252,14 @@ do { \
 			} else { \
 				/* unsigned 16 */ \
 				unsigned char buf[3]; \
-				buf[0] = 0xcd; _msgpack_store16(&buf[1], d); \
+				buf[0] = 0xcd; _msgpack_store16(&buf[1], (uint16_t)d); \
 				msgpack_pack_append_buffer(x, buf, 3); \
 			} \
 		} else { \
 			if(d < (1LL<<32)) { \
 				/* unsigned 32 */ \
 				unsigned char buf[5]; \
-				buf[0] = 0xce; _msgpack_store32(&buf[1], d); \
+				buf[0] = 0xce; _msgpack_store32(&buf[1], (uint32_t)d); \
 				msgpack_pack_append_buffer(x, buf, 5); \
 			} else { \
 				/* unsigned 64 */ \
@@ -272,63 +272,63 @@ do { \
 } while(0)
 
 
-#ifdef msgpack_pack_inline_func_fastint
+#ifdef msgpack_pack_inline_func_fixint
 
-msgpack_pack_inline_func_fastint(_uint8)(msgpack_pack_user x, uint8_t d)
+msgpack_pack_inline_func_fixint(_uint8)(msgpack_pack_user x, uint8_t d)
 {
 	unsigned char buf[2] = {0xcc, TAKE8_8(d)};
 	msgpack_pack_append_buffer(x, buf, 2);
 }
 
-msgpack_pack_inline_func_fastint(_uint16)(msgpack_pack_user x, uint16_t d)
+msgpack_pack_inline_func_fixint(_uint16)(msgpack_pack_user x, uint16_t d)
 {
 	unsigned char buf[3];
 	buf[0] = 0xcd; _msgpack_store16(&buf[1], d);
 	msgpack_pack_append_buffer(x, buf, 3);
 }
 
-msgpack_pack_inline_func_fastint(_uint32)(msgpack_pack_user x, uint32_t d)
+msgpack_pack_inline_func_fixint(_uint32)(msgpack_pack_user x, uint32_t d)
 {
 	unsigned char buf[5];
 	buf[0] = 0xce; _msgpack_store32(&buf[1], d);
 	msgpack_pack_append_buffer(x, buf, 5);
 }
 
-msgpack_pack_inline_func_fastint(_uint64)(msgpack_pack_user x, uint64_t d)
+msgpack_pack_inline_func_fixint(_uint64)(msgpack_pack_user x, uint64_t d)
 {
 	unsigned char buf[9];
 	buf[0] = 0xcf; _msgpack_store64(&buf[1], d);
 	msgpack_pack_append_buffer(x, buf, 9);
 }
 
-msgpack_pack_inline_func_fastint(_int8)(msgpack_pack_user x, int8_t d)
+msgpack_pack_inline_func_fixint(_int8)(msgpack_pack_user x, int8_t d)
 {
 	unsigned char buf[2] = {0xd0, TAKE8_8(d)};
 	msgpack_pack_append_buffer(x, buf, 2);
 }
 
-msgpack_pack_inline_func_fastint(_int16)(msgpack_pack_user x, int16_t d)
+msgpack_pack_inline_func_fixint(_int16)(msgpack_pack_user x, int16_t d)
 {
 	unsigned char buf[3];
 	buf[0] = 0xd1; _msgpack_store16(&buf[1], d);
 	msgpack_pack_append_buffer(x, buf, 3);
 }
 
-msgpack_pack_inline_func_fastint(_int32)(msgpack_pack_user x, int32_t d)
+msgpack_pack_inline_func_fixint(_int32)(msgpack_pack_user x, int32_t d)
 {
 	unsigned char buf[5];
 	buf[0] = 0xd2; _msgpack_store32(&buf[1], d);
 	msgpack_pack_append_buffer(x, buf, 5);
 }
 
-msgpack_pack_inline_func_fastint(_int64)(msgpack_pack_user x, int64_t d)
+msgpack_pack_inline_func_fixint(_int64)(msgpack_pack_user x, int64_t d)
 {
 	unsigned char buf[9];
 	buf[0] = 0xd3; _msgpack_store64(&buf[1], d);
 	msgpack_pack_append_buffer(x, buf, 9);
 }
 
-#undef msgpack_pack_inline_func_fastint
+#undef msgpack_pack_inline_func_fixint
 #endif
 
 
@@ -690,11 +690,11 @@ msgpack_pack_inline_func(_array)(msgpack_pack_user x, unsigned int n)
 		msgpack_pack_append_buffer(x, &d, 1);
 	} else if(n < 65536) {
 		unsigned char buf[3];
-		buf[0] = 0xdc; _msgpack_store16(&buf[1], n);
+		buf[0] = 0xdc; _msgpack_store16(&buf[1], (uint16_t)n);
 		msgpack_pack_append_buffer(x, buf, 3);
 	} else {
 		unsigned char buf[5];
-		buf[0] = 0xdd; _msgpack_store32(&buf[1], n);
+		buf[0] = 0xdd; _msgpack_store32(&buf[1], (uint32_t)n);
 		msgpack_pack_append_buffer(x, buf, 5);
 	}
 }
@@ -711,11 +711,11 @@ msgpack_pack_inline_func(_map)(msgpack_pack_user x, unsigned int n)
 		msgpack_pack_append_buffer(x, &TAKE8_8(d), 1);
 	} else if(n < 65536) {
 		unsigned char buf[3];
-		buf[0] = 0xde; _msgpack_store16(&buf[1], n);
+		buf[0] = 0xde; _msgpack_store16(&buf[1], (uint16_t)n);
 		msgpack_pack_append_buffer(x, buf, 3);
 	} else {
 		unsigned char buf[5];
-		buf[0] = 0xdf; _msgpack_store32(&buf[1], n);
+		buf[0] = 0xdf; _msgpack_store32(&buf[1], (uint32_t)n);
 		msgpack_pack_append_buffer(x, buf, 5);
 	}
 }
@@ -732,11 +732,11 @@ msgpack_pack_inline_func(_raw)(msgpack_pack_user x, size_t l)
 		msgpack_pack_append_buffer(x, &TAKE8_8(d), 1);
 	} else if(l < 65536) {
 		unsigned char buf[3];
-		buf[0] = 0xda; _msgpack_store16(&buf[1], l);
+		buf[0] = 0xda; _msgpack_store16(&buf[1], (uint16_t)l);
 		msgpack_pack_append_buffer(x, buf, 3);
 	} else {
 		unsigned char buf[5];
-		buf[0] = 0xdb; _msgpack_store32(&buf[1], l);
+		buf[0] = 0xdb; _msgpack_store32(&buf[1], (uint32_t)l);
 		msgpack_pack_append_buffer(x, buf, 5);
 	}
 }

perl/.gitignore

@@ -11,3 +11,4 @@ pm_to_blib
 unpack.o
 MANIFEST
 ppport.h
+.testenv/

perl/Changes

@@ -1,3 +1,39 @@
+0.21
+
+    - doc enhancment
+    - micro performance tuning.
+
+0.20
+
+    - first production ready release with PP driver.
+
+0.16_04
+
+    - no feature changes
+
+0.16_02
+
+    - document enhancement(tokuhirom)
+    - M::I::XSUtil 0.26 is broken. use 0.27.
+
+0.16_01
+
+    - added PP version (used in cases PERL_DATA_MESSAGEPACK=pp or fail to load XS).
+    - made Makefile.PL PP configurable.
+    - test_pp in author's test
+    - modified t/05_preferred_int.t for Win32
+      (makamaka)
+
+0.16
+
+    - tests on 64bit machines with -Duselongdouble
+      (reported by andk)
+
+0.15
+
+    - better argument validation.
+      (Dan Kogai)
+
 0.14
 
     - fixed segv on serializing cyclic reference

perl/MANIFEST.SKIP

@@ -23,3 +23,5 @@
 \.o$
 \.bs$
 ^Data-MessagePack-[0-9.]+/
+^\.testenv/test_pp.pl
+^ppport.h$

perl/Makefile.PL

@@ -5,15 +5,38 @@ name 'Data-MessagePack';
 all_from 'lib/Data/MessagePack.pm';
 readme_from('lib/Data/MessagePack.pm');
 
-perl_version '5.008005';
+perl_version '5.008000';
 license 'perl';
-can_cc or die "This module requires a C compiler";
 
 tests 't/*.t';
 recursive_author_tests('xt');
-use_ppport 3.19;
 
-requires_c99(); # msgpack C library requires C99.
+
+if ( $] >= 5.008005 and want_xs() ) {
+    can_cc or die "This module requires a C compiler. Please retry with --pp";
+
+    my $has_c99 = c99_available(); # msgpack C library requires C99.
+
+    if ( $has_c99 ) {
+        use_ppport 3.19;
+        cc_src_paths('xs-src');
+        if ($ENV{DEBUG}) {
+            cc_append_to_ccflags '-g';
+        }
+    }
+    else {
+        print <<NOT_SUPPORT_C99;
+
+This distribution requires a C99 compiler, but yours seems not to support C99.
+Instead of XS, configure PP version.
+
+NOT_SUPPORT_C99
+
+    }
+}
+else {
+    print "configure PP version\n\n";
+}
 
 clean_files qw{
     *.stackdump
@@ -23,10 +46,6 @@ clean_files qw{
     cover_db
 };
 
-if ($ENV{DEBUG}) {
-    cc_append_to_ccflags '-g';
-}
-
 # copy modules
 if ($Module::Install::AUTHOR && -d File::Spec->catfile('..', 'msgpack')) {
     mkdir 'msgpack' unless -d 'msgpack';
@@ -39,7 +58,50 @@ if ($Module::Install::AUTHOR && -d File::Spec->catfile('..', 'msgpack')) {
 requires 'Test::More' => 0.94; # done_testing
 test_requires('Test::Requires');
 
-auto_set_repository();
+test_with_env( test_pp => PERL_DATA_MESSAGEPACK => 'pp' );
+
+if($Module::Install::AUTHOR) {
+    postamble qq{test :: test_pp\n\n};
+}
+
+repository('http://github.com/msgpack/msgpack');
 auto_include;
 WriteAll;
 
+# copied from Makefile.PL in Text::Xslate.
+sub test_with_env {
+    my($name, %env) = @_;
+
+    my $dir = '.testenv';
+    if(not -e $dir) {
+        mkdir $dir or die "Cannot mkdir '.testenv': $!";
+    }
+    clean_files($dir);
+
+    {
+        open my $out, '>', "$dir/$name.pl"
+            or die "Cannot open '$dir/$name.pl' for writing: $!";
+       print $out "# This file sets the env for 'make $name', \n";
+       print $out "# generated by $0 at ", scalar(localtime), ".\n";
+       print $out "# DO NOT EDIT THIS FILE DIRECTLY.\n";
+       print $out "\n";
+
+        while(my($name, $value) = each %env) {
+            printf $out '$ENV{q{%s}} = q{%s};'."\n", $name, $value;
+        }
+    }
+
+    # repeat testing for pure Perl mode
+    # see also ExtUtils::MM_Any::test_via_harness()
+
+    my $t =  q{$(FULLPERLRUN) -MExtUtils::Command::MM -e}
+            .q{ "do q[%s]; test_harness($(TEST_VERBOSE), '$(INST_LIB)', '$(INST_ARCHLIB)')"}
+            .q{ $(TEST_FILES)};
+
+    postamble qq{$name :: pure_all\n}
+            . qq{\t} . q{$(NOECHO) $(ECHO) TESTING: } . $name . qq{\n}
+            . qq{\t} . sprintf($t, "$dir/$name.pl") . qq{\n\n}
+
+            . qq{testall :: $name\n\n};
+    return;
+}

perl/README

@@ -1,16 +1,45 @@
 NAME
-    Data::MessagePack - messagepack
+    Data::MessagePack - MessagePack serialising/deserialising
 
 SYNOPSIS
         my $packed = Data::MessagePack->pack($dat);
         my $unpacked = Data::MessagePack->unpack($dat);
 
 DESCRIPTION
-    Data::MessagePack is a binary packer for perl.
+    This module converts Perl data structures to MessagePack and vice versa.
+
+ABOUT MESSAGEPACK FORMAT
+    MessagePack is a binary-based efficient object serialization format. It
+    enables to exchange structured objects between many languages like JSON.
+    But unlike JSON, it is very fast and small.
+
+  ADVANTAGES
+    PORTABILITY
+        Messagepack is language independent binary serialize format.
+
+    SMALL SIZE
+            say length(JSON::XS::encode_json({a=>1, b=>2}));   # => 13
+            say length(Storable::nfreeze({a=>1, b=>2}));       # => 21
+            say length(Data::MessagePack->pack({a=>1, b=>2})); # => 7
+
+        MessagePack format saves memory than JSON and Storable format.
+
+    STREAMING DESERIALIZER
+        MessagePack supports streaming deserializer. It is useful for
+        networking such as RPC.
+
+    If you want to get more informations about messagepack format, please
+    visit to <http://msgpack.org/>.
 
 METHODS
-    my $packed = Data::MessagePack->pack($data);
-        pack the $data to messagepack format string.
+    my $packed = Data::MessagePack->pack($data[, $max_depth]);
+        Pack the $data to messagepack format string.
+
+        This method throws exception when nesting perl structure more than
+        $max_depth(default: 512) for detecting circular reference.
+
+        Data::MessagePack->pack() throws exception when encountered blessed
+        object. Because MessagePack is language independent format.
 
     my $unpacked = Data::MessagePack->unpack($msgpackstr);
         unpack the $msgpackstr to messagepack format string.
@@ -19,16 +48,44 @@ Configuration Variables
     $Data::MessagePack::PreferInteger
         Pack the string as int when the value looks like int(EXPERIMENTAL).
 
+SPEED
+    This is result of benchmark/serialize.pl and benchmark/deserialize.pl on
+    my SC440(Linux 2.6.32-23-server #37-Ubuntu SMP).
+
+        -- serialize
+        JSON::XS: 2.3
+        Data::MessagePack: 0.20
+        Storable: 2.21
+        Benchmark: timing 1000000 iterations of json, mp, storable...
+              json:  5 wallclock secs ( 3.95 usr +  0.00 sys =  3.95 CPU) @ 253164.56/s (n=1000000)
+                mp:  3 wallclock secs ( 2.69 usr +  0.00 sys =  2.69 CPU) @ 371747.21/s (n=1000000)
+          storable: 26 wallclock secs (27.21 usr +  0.00 sys = 27.21 CPU) @ 36751.19/s (n=1000000)
+
+        -- deserialize
+        JSON::XS: 2.3
+        Data::MessagePack: 0.20
+        Storable: 2.21
+        Benchmark: timing 1000000 iterations of json, mp, storable...
+              json:  4 wallclock secs ( 4.45 usr +  0.00 sys =  4.45 CPU) @ 224719.10/s (n=1000000)
+                mp:  6 wallclock secs ( 5.45 usr +  0.00 sys =  5.45 CPU) @ 183486.24/s (n=1000000)
+          storable:  7 wallclock secs ( 7.77 usr +  0.00 sys =  7.77 CPU) @ 128700.13/s (n=1000000)
+
 AUTHORS
     Tokuhiro Matsuno
 
+    Makamaka Hannyaharamitu
+
 THANKS TO
     Jun Kuriyama
 
+    Dan Kogai
+
+    FURUHASHI Sadayuki
+
 LICENSE
     This library is free software; you can redistribute it and/or modify it
     under the same terms as Perl itself.
 
 SEE ALSO
-    <http://msgpack.sourceforge.jp/>
+    <http://msgpack.org/> is official web site for MessagePack format.
 

perl/benchmark/deserialize.pl

@@ -3,18 +3,27 @@ use warnings;
 use Data::MessagePack;
 use JSON::XS;
 use Benchmark ':all';
+use Storable;
 
-my $a = [0..2**24];
+my $a = {
+    "method" => "handleMessage",
+    "params" => [ "user1", "we were just talking" ],
+    "id"     => undef,
+    "array"  => [ 1, 11, 234, -5, 1e5, 1e7, 1, 0 ]
+};
 my $j = JSON::XS::encode_json($a);
 my $m = Data::MessagePack->pack($a);
+my $s = Storable::freeze($a);
 
 print "-- deserialize\n";
 print "JSON::XS: $JSON::XS::VERSION\n";
 print "Data::MessagePack: $Data::MessagePack::VERSION\n";
-cmpthese(
-    -1 => {
-        json => sub { JSON::XS::decode_json($j)     },
-        mp   => sub { Data::MessagePack->unpack($m) },
+print "Storable: $Storable::VERSION\n";
+timethese(
+    1000000 => {
+        json     => sub { JSON::XS::decode_json($j)     },
+        mp       => sub { Data::MessagePack->unpack($m) },
+        storable => sub { Storable::thaw($s) },
     }
 );
 

perl/benchmark/serialize.pl

@@ -2,17 +2,25 @@ use strict;
 use warnings;
 use Data::MessagePack;
 use JSON::XS;
+use Storable;
 use Benchmark ':all';
 
-my $a = [0..2**24];
+my $a = {
+    "method" => "handleMessage",
+    "params" => [ "user1", "we were just talking" ],
+    "id"     => undef,
+    "array"  => [ 1, 11, 234, -5, 1e5, 1e7, 1, 0 ]
+};
 
 print "-- serialize\n";
 print "JSON::XS: $JSON::XS::VERSION\n";
 print "Data::MessagePack: $Data::MessagePack::VERSION\n";
-cmpthese(
-    -1 => {
-        json => sub { JSON::XS::encode_json($a)   },
-        mp   => sub { Data::MessagePack->pack($a) },
+print "Storable: $Storable::VERSION\n";
+timethese(
+    1000000 => {
+        json     => sub { JSON::XS::encode_json($a) },
+        storable => sub { Storable::freeze($a) },
+        mp       => sub { Data::MessagePack->pack($a) },
     }
 );
 

perl/lib/Data/MessagePack.pm

@@ -1,10 +1,9 @@
 package Data::MessagePack;
 use strict;
 use warnings;
-use XSLoader;
 use 5.008001;
 
-our $VERSION = '0.14';
+our $VERSION = '0.21';
 our $PreferInteger = 0;
 
 our $true  = do { bless \(my $dummy = 1), "Data::MessagePack::Boolean" };
@@ -12,14 +11,26 @@ our $false = do { bless \(my $dummy = 0), "Data::MessagePack::Boolean" };
 sub true  () { $true  }
 sub false () { $false }
 
-XSLoader::load(__PACKAGE__, $VERSION);
+if ( !__PACKAGE__->can('pack') ) { # this idea comes from Text::Xslate
+    my $backend = $ENV{ PERL_DATA_MESSAGEPACK } || '';
+    if ( $backend !~ /\b pp \b/xms ) {
+        eval {
+            require XSLoader;
+            XSLoader::load(__PACKAGE__, $VERSION);
+        };
+        die $@ if $@ && $backend =~ /\b xs \b/xms; # force XS
+    }
+    if ( !__PACKAGE__->can('pack') ) {
+        require 'Data/MessagePack/PP.pm';
+    }
+}
 
 1;
 __END__
 
 =head1 NAME
 
-Data::MessagePack - messagepack
+Data::MessagePack - MessagePack serialising/deserialising
 
 =head1 SYNOPSIS
 
@@ -28,15 +39,48 @@ Data::MessagePack - messagepack
 
 =head1 DESCRIPTION
 
-Data::MessagePack is a binary packer for perl.
+This module converts Perl data structures to MessagePack and vice versa.
+
+=head1 ABOUT MESSAGEPACK FORMAT
+
+MessagePack is a binary-based efficient object serialization format.
+It enables to exchange structured objects between many languages like JSON. But unlike JSON, it is very fast and small.
+
+=head2 ADVANTAGES
+
+=over 4
+
+=item PORTABILITY
+
+Messagepack is language independent binary serialize format.
+
+=item SMALL SIZE
+
+    say length(JSON::XS::encode_json({a=>1, b=>2}));   # => 13
+    say length(Storable::nfreeze({a=>1, b=>2}));       # => 21
+    say length(Data::MessagePack->pack({a=>1, b=>2})); # => 7
+
+MessagePack format saves memory than JSON and Storable format.
+
+=item STREAMING DESERIALIZER
+
+MessagePack supports streaming deserializer. It is useful for networking such as RPC.
+
+=back
+
+If you want to get more informations about messagepack format, please visit to L<http://msgpack.org/>.
 
 =head1 METHODS
 
 =over 4
 
-=item my $packed = Data::MessagePack->pack($data);
+=item my $packed = Data::MessagePack->pack($data[, $max_depth]);
 
-pack the $data to messagepack format string.
+Pack the $data to messagepack format string.
+
+This method throws exception when nesting perl structure more than $max_depth(default: 512) for detecting circular reference.
+
+Data::MessagePack->pack() throws exception when encountered blessed object. Because MessagePack is language independent format.
 
 =item my $unpacked = Data::MessagePack->unpack($msgpackstr);
 
@@ -54,14 +98,42 @@ Pack the string as int when the value looks like int(EXPERIMENTAL).
 
 =back
 
+=head1 SPEED
+
+This is result of benchmark/serialize.pl and benchmark/deserialize.pl on my SC440(Linux 2.6.32-23-server #37-Ubuntu SMP).
+
+    -- serialize
+    JSON::XS: 2.3
+    Data::MessagePack: 0.20
+    Storable: 2.21
+    Benchmark: timing 1000000 iterations of json, mp, storable...
+          json:  5 wallclock secs ( 3.95 usr +  0.00 sys =  3.95 CPU) @ 253164.56/s (n=1000000)
+            mp:  3 wallclock secs ( 2.69 usr +  0.00 sys =  2.69 CPU) @ 371747.21/s (n=1000000)
+      storable: 26 wallclock secs (27.21 usr +  0.00 sys = 27.21 CPU) @ 36751.19/s (n=1000000)
+
+    -- deserialize
+    JSON::XS: 2.3
+    Data::MessagePack: 0.20
+    Storable: 2.21
+    Benchmark: timing 1000000 iterations of json, mp, storable...
+          json:  4 wallclock secs ( 4.45 usr +  0.00 sys =  4.45 CPU) @ 224719.10/s (n=1000000)
+            mp:  6 wallclock secs ( 5.45 usr +  0.00 sys =  5.45 CPU) @ 183486.24/s (n=1000000)
+      storable:  7 wallclock secs ( 7.77 usr +  0.00 sys =  7.77 CPU) @ 128700.13/s (n=1000000)
+
 =head1 AUTHORS
 
 Tokuhiro Matsuno
 
+Makamaka Hannyaharamitu
+
 =head1 THANKS TO
 
 Jun Kuriyama
 
+Dan Kogai
+
+FURUHASHI Sadayuki
+
 =head1 LICENSE
 
 This library is free software; you can redistribute it and/or modify
@@ -70,5 +142,5 @@ it under the same terms as Perl itself.
 
 =head1 SEE ALSO
 
-L<http://msgpack.sourceforge.jp/>
+L<http://msgpack.org/> is official web site for MessagePack format.
 

perl/lib/Data/MessagePack/PP.pm

@@ -0,0 +1,546 @@
+package Data::MessagePack::PP;
+
+use 5.008000;
+use strict;
+use Carp ();
+
+our $VERSION = '0.15';
+
+# See also
+# http://redmine.msgpack.org/projects/msgpack/wiki/FormatSpec
+# http://cpansearch.perl.org/src/YAPPO/Data-Model-0.00006/lib/Data/Model/Driver/Memcached.pm
+# http://frox25.no-ip.org/~mtve/wiki/MessagePack.html : reference to using CORE::pack, CORE::unpack
+
+
+package
+    Data::MessagePack;
+
+use Scalar::Util qw( blessed );
+use strict;
+use B ();
+
+BEGIN {
+    # for pack and unpack compatibility
+    if ( $] < 5.010 ) {
+        # require $Config{byteorder}; my $bo_is_le = ( $Config{byteorder} =~ /^1234/ );
+        # which better?
+        my $bo_is_le = unpack ( 'd', "\x00\x00\x00\x00\x00\x00\xf0\x3f") == 1; # 1.0LE
+        # In really, since 5.9.2 '>' is introduced. but 'n!' and 'N!'?
+        *pack_uint64 = $bo_is_le ? sub {
+            my @v = unpack( 'V2', pack( 'Q', $_[0] ) );
+            return pack 'CN2', 0xcf, @v[1,0];
+        } : sub { pack 'CQ', 0xcf, $_[0]; };
+        *pack_int64 = $bo_is_le ? sub {
+            my @v = unpack( 'V2', pack( 'q', $_[0] ) );
+            return pack 'CN2', 0xd3, @v[1,0];
+        } : sub { pack 'Cq', 0xd3, $_[0]; };
+        *pack_double = $bo_is_le ? sub {
+            my @v = unpack( 'V2', pack( 'd', $_[0] ) );
+            return pack 'CN2', 0xcb, @v[1,0];
+        } : sub { pack 'Cd', 0xcb, $_[0]; };
+        *unpack_float = $bo_is_le ? sub {
+            my @v = unpack( 'v2', substr( $_[0], $_[1], 4 ) );
+            return unpack( 'f', pack( 'n2', @v[1,0] ) );
+        } : sub { return unpack( 'f', substr( $_[0], $_[1], 4 ) ); };
+        *unpack_double = $bo_is_le ? sub {
+            my @v = unpack( 'V2', substr( $_[0], $_[1], 8 ) );
+            return unpack( 'd', pack( 'N2', @v[1,0] ) );
+        } : sub { return unpack( 'd', substr( $_[0], $_[1], 8 ) ); };
+        *unpack_int16  = sub {
+            my $v = unpack 'n', substr( $_[0], $_[1], 2 );
+            return $v ? $v - 0x10000 : 0;
+        };
+        *unpack_int32  = sub {
+            no warnings; # avoid for warning about Hexadecimal number
+            my $v = unpack 'N', substr( $_[0], $_[1], 4 );
+            return $v ? $v - 0x100000000 : 0;
+        };
+        *unpack_int64 = $bo_is_le ? sub {
+            my @v = unpack( 'V*', substr( $_[0], $_[1], 8 ) );
+            return unpack( 'q', pack( 'N2', @v[1,0] ) );
+        } : sub { pack 'q', substr( $_[0], $_[1], 8 ); };
+        *unpack_uint64 = $bo_is_le ? sub {
+            my @v = unpack( 'V*', substr( $_[0], $_[1], 8 ) );
+            return unpack( 'Q', pack( 'N2', @v[1,0] ) );
+        } : sub { pack 'Q', substr( $_[0], $_[1], 8 ); };
+    }
+    else {
+        *pack_uint64   = sub { return pack 'CQ>', 0xcf, $_[0]; };
+        *pack_int64    = sub { return pack 'Cq>', 0xd3, $_[0]; };
+        *pack_double   = sub { return pack 'Cd>', 0xcb, $_[0]; };
+        *unpack_float  = sub { return unpack( 'f>', substr( $_[0], $_[1], 4 ) ); };
+        *unpack_double = sub { return unpack( 'd>', substr( $_[0], $_[1], 8 ) ); };
+        *unpack_int16  = sub { return unpack( 'n!', substr( $_[0], $_[1], 2 ) ); };
+        *unpack_int32  = sub { return unpack( 'N!', substr( $_[0], $_[1], 4 ) ); };
+        *unpack_int64  = sub { return unpack( 'q>', substr( $_[0], $_[1], 8 ) ); };
+        *unpack_uint64 = sub { return unpack( 'Q>', substr( $_[0], $_[1], 8 ) ); };
+    }
+    # for 5.8 etc.
+    unless ( defined &utf8::is_utf8 ) {
+       require Encode;
+       *utf8::is_utf8 = *Encode::is_utf8;
+    }
+}
+
+
+#
+# PACK
+#
+
+{
+    no warnings 'recursion';
+
+    my $max_depth;
+
+sub pack {
+    Carp::croak('Usage: Data::MessagePack->pack($dat [,$max_depth])') if @_ < 2;
+    $max_depth = defined $_[2] ? $_[2] : 512; # init
+    return _pack( $_[1] );
+}
+
+
+sub _pack {
+    my ( $value ) = @_;
+
+    return CORE::pack( 'C', 0xc0 ) if ( not defined $value );
+
+    my $b_obj = B::svref_2object( ref $value ? $value : \$value );
+
+    if ( $b_obj->isa('B::AV') ) {
+        my $num = @$value;
+        my $header = 
+              $num < 16          ? CORE::pack( 'C',  0x90 + $num )
+            : $num < 2 ** 16 - 1 ? CORE::pack( 'Cn', 0xdc,  $num )
+            : $num < 2 ** 32 - 1 ? CORE::pack( 'CN', 0xdd,  $num )
+            : die "" # don't arrivie here
+        ;
+        if ( --$max_depth <= 0 ) {
+            Carp::croak("perl structure exceeds maximum nesting level (max_depth set too low?)");
+        }
+        return join( '', $header, map { _pack( $_ ) } @$value );
+    }
+
+    elsif ( $b_obj->isa('B::HV') ) {
+        my $num = keys %$value;
+        my $header = 
+              $num < 16          ? CORE::pack( 'C',  0x80 + $num )
+            : $num < 2 ** 16 - 1 ? CORE::pack( 'Cn', 0xde,  $num )
+            : $num < 2 ** 32 - 1 ? CORE::pack( 'CN', 0xdf,  $num )
+            : die "" # don't arrivie here
+        ;
+        if ( --$max_depth <= 0 ) {
+            Carp::croak("perl structure exceeds maximum nesting level (max_depth set too low?)");
+        }
+        return join( '', $header, map { _pack( $_ ) } %$value );
+    }
+
+    elsif ( blessed( $value ) and blessed( $value ) eq 'Data::MessagePack::Boolean' ) {
+        return  CORE::pack( 'C', $$value ? 0xc3 : 0xc2 );
+    }
+
+    my $flags = $b_obj->FLAGS;
+
+    if ( $flags & ( B::SVf_IOK | B::SVp_IOK ) ) {
+
+        if ($value >= 0) {
+            return    $value <= 127 ?    CORE::pack 'C',        $value
+                    : $value < 2 ** 8 ?  CORE::pack 'CC', 0xcc, $value
+                    : $value < 2 ** 16 ? CORE::pack 'Cn', 0xcd, $value
+                    : $value < 2 ** 32 ? CORE::pack 'CN', 0xce, $value
+                    : pack_uint64( $value );
+        }
+        else {
+            return    -$value <= 32 ?      CORE::pack 'C', ($value & 255)
+                    : -$value <= 2 **  7 ? CORE::pack 'Cc', 0xd0, $value
+                    : -$value <= 2 ** 15 ? CORE::pack 'Cn', 0xd1, $value
+                    : -$value <= 2 ** 31 ? CORE::pack 'CN', 0xd2, $value
+                    : pack_int64( $value );
+        }
+
+    }
+
+    elsif ( $flags & B::SVf_POK ) { # raw / check needs before dboule
+
+        if ( $Data::MessagePack::PreferInteger ) {
+            if ( $value =~ /^-?[0-9]+$/ ) { # ok?
+                my $value2 = 0 + $value;
+                if ( $value > 0xFFFFFFFF or $value < '-'.0x80000000 or # <- needless but for XS compat
+                    0 + $value != B::svref_2object( \$value2 )->int_value
+                ) {
+                    local $Data::MessagePack::PreferInteger; # avoid for PV => NV
+                    return _pack( "$value" );
+                }
+                return _pack( $value + 0 );
+            }
+        }
+
+        utf8::encode( $value ) if utf8::is_utf8( $value );
+
+        my $num = length $value;
+        my $header = 
+              $num < 32          ? CORE::pack( 'C',  0xa0 + $num )
+            : $num < 2 ** 16 - 1 ? CORE::pack( 'Cn', 0xda, $num )
+            : $num < 2 ** 32 - 1 ? CORE::pack( 'CN', 0xdb, $num )
+            : die "" # don't arrivie here
+        ;
+
+        return $header . $value;
+
+    }
+
+    elsif ( $flags & ( B::SVf_NOK | B::SVp_NOK ) ) { # double only
+        return pack_double( $value );
+    }
+
+    else {
+        die "???";
+    }
+
+}
+
+} # PACK
+
+
+#
+# UNPACK
+#
+
+{
+
+    my $p; # position variables for speed.
+
+sub unpack {
+    $p = 0; # init
+    _unpack( $_[1] );
+}
+
+
+sub _unpack {
+    my ( $value ) = @_;
+    my $byte = CORE::unpack( 'C', substr( $value, $p++, 1 ) ); # get header
+
+    die "invalid data" unless defined $byte;
+
+    if ( ( $byte >= 0x90 and $byte <= 0x9f ) or $byte == 0xdc or $byte == 0xdd ) {
+        my $num;
+        if ( $byte == 0xdc ) { # array 16
+            $num = CORE::unpack 'n', substr( $value, $p, 2 );
+            $p += 2;
+        }
+        elsif ( $byte == 0xdd ) { # array 32
+            $num = CORE::unpack 'N', substr( $value, $p, 4 );
+            $p += 4;
+        }
+        else { # fix array
+            $num = $byte & ~0x90;
+        }
+        my @array;
+        push @array, _unpack( $value ) while $num-- > 0;
+        return \@array;
+    }
+
+    elsif ( ( $byte >= 0x80 and $byte <= 0x8f ) or $byte == 0xde or $byte == 0xdf ) {
+        my $num;
+        if ( $byte == 0xde ) { # map 16
+            $num = CORE::unpack 'n', substr( $value, $p, 2 );
+            $p += 2;
+        }
+        elsif ( $byte == 0xdf ) { # map 32
+            $num = CORE::unpack 'N', substr( $value, $p, 4 );
+            $p += 4;
+        }
+        else { # fix map
+            $num = $byte & ~0x80;
+        }
+        my %map;
+        for ( 0 .. $num - 1 ) {
+            no warnings; # for undef key case
+            my $key = _unpack( $value );
+            my $val = _unpack( $value );
+            $map{ $key } = $val;
+        }
+        return \%map;
+    }
+
+    elsif ( $byte >= 0x00 and $byte <= 0x7f ) { # positive fixnum
+        return $byte;
+    }
+    elsif ( $byte == 0xcc ) { # uint8
+        CORE::unpack( 'C', substr( $value, $p++, 1 ) );
+    }
+    elsif ( $byte == 0xcd ) { # uint16
+        $p += 2;
+        return CORE::unpack 'n', substr( $value, $p - 2, 2 );
+    }
+    elsif ( $byte == 0xce ) { # unit32
+        $p += 4;
+        return CORE::unpack 'N', substr( $value, $p - 4, 4 );
+    }
+    elsif ( $byte == 0xcf ) { # unit64
+        $p += 8;
+        return unpack_uint64( $value, $p - 8 );
+    }
+    elsif ( $byte == 0xd3 ) { # int64
+        $p += 8;
+        return unpack_int64( $value, $p - 8 );
+    }
+    elsif ( $byte == 0xd2 ) { # int32
+        $p += 4;
+        return unpack_int32( $value, $p - 4 );
+    }
+    elsif ( $byte == 0xd1 ) { # int16
+        $p += 2;
+        return unpack_int16( $value, $p - 2 );
+    }
+    elsif ( $byte == 0xd0 ) { # int8
+        return CORE::unpack 'c',  substr( $value, $p++, 1 ); # c / C
+    }
+    elsif ( $byte >= 0xe0 and $byte <= 0xff ) { # negative fixnum
+        return $byte - 256;
+    }
+
+    elsif ( ( $byte >= 0xa0 and $byte <= 0xbf ) or $byte == 0xda or $byte == 0xdb ) { # raw
+        my $num;
+        if ( $byte == 0xda ) {
+            $num = CORE::unpack 'n', substr( $value, $p, 2 );
+            $p += 2 + $num;
+        }
+        elsif ( $byte == 0xdb ) {
+            $num = CORE::unpack 'N', substr( $value, $p, 4 );
+            $p += 4 + $num;
+        }
+        else { # fix raw
+            $num = $byte & ~0xa0;
+            $p += $num;
+        }
+        return substr( $value, $p - $num, $num );
+    }
+
+    elsif ( $byte == 0xc0 ) { # nil
+        return undef;
+    }
+    elsif ( $byte == 0xc2 ) { # boolean
+        return false;
+    }
+    elsif ( $byte == 0xc3 ) { # boolean
+        return true;
+    }
+
+    elsif ( $byte == 0xcb ) { # double
+        $p += 8;
+        return unpack_double( $value, $p - 8 );
+    }
+
+    elsif ( $byte == 0xca ) { # float
+        $p += 4;
+        return unpack_float( $value, $p - 4 );
+    }
+
+    else {
+        die "???";
+    }
+
+}
+
+
+} # UNPACK
+
+
+#
+# Data::MessagePack::Unpacker
+#
+
+package
+    Data::MessagePack::Unpacker;
+
+use strict;
+
+sub new {
+    bless { stack => [] }, shift;
+}
+
+
+sub execute_limit {
+    execute( @_ );
+}
+
+
+{
+    my $p;
+
+sub execute {
+    my ( $self, $data, $offset, $limit ) = @_;
+    my $value = substr( $data, $offset, $limit ? $limit : length $data );
+    my $len   = length $value;
+
+    $p = 0;
+
+    while ( $len > $p ) {
+        _count( $self, $value ) or last;
+
+        if ( @{ $self->{stack} } > 0 ) {
+            pop @{ $self->{stack} } if --$self->{stack}->[-1] == 0;
+        }
+    }
+
+    if ( $len == $p ) {
+        $self->{ data } .= substr( $value, 0, $p );
+        $self->{ remain } = undef;
+    }
+
+    return $p;
+}
+
+
+sub _count {
+    my ( $self, $value ) = @_;
+    my $byte = unpack( 'C', substr( $value, $p++, 1 ) ); # get header
+
+    if ( ( $byte >= 0x90 and $byte <= 0x9f ) or $byte == 0xdc or $byte == 0xdd ) {
+        my $num;
+        if ( $byte == 0xdc ) { # array 16
+            $num = unpack 'n', substr( $value, $p, 2 );
+            $p += 2;
+        }
+        elsif ( $byte == 0xdd ) { # array 32
+            $num = unpack 'N', substr( $value, $p, 4 );
+            $p += 4;
+        }
+        else { # fix array
+            $num = $byte & ~0x90;
+        }
+
+        push @{ $self->{stack} }, $num + 1;
+
+        return 1;
+    }
+
+    elsif ( ( $byte >= 0x80 and $byte <= 0x8f ) or $byte == 0xde or $byte == 0xdf ) {
+        my $num;
+        if ( $byte == 0xde ) { # map 16
+            $num = unpack 'n', substr( $value, $p, 2 );
+            $p += 2;
+        }
+        elsif ( $byte == 0xdf ) { # map 32
+            $num = unpack 'N', substr( $value, $p, 4 );
+            $p += 4;
+        }
+        else { # fix map
+            $num = $byte & ~0x80;
+        }
+
+        push @{ $self->{stack} }, $num * 2 + 1; # a pair
+
+        return 1;
+    }
+
+    elsif ( $byte == 0xc0 or $byte == 0xc2 or $byte == 0xc3 ) { # nil, false, true
+        return 1;
+    }
+
+    elsif ( $byte >= 0x00 and $byte <= 0x7f ) { # positive fixnum
+        return 1;
+    }
+
+    elsif ( $byte >= 0xcc and $byte <= 0xcf ) { # uint
+        $p += $byte == 0xcc ? 1
+            : $byte == 0xcd ? 2
+            : $byte == 0xce ? 4
+            : $byte == 0xcf ? 8
+            : die;
+        return 1;
+    }
+
+    elsif ( $byte >= 0xd0 and $byte <= 0xd3 ) { # int
+        $p += $byte == 0xd0 ? 1
+            : $byte == 0xd1 ? 2
+            : $byte == 0xd2 ? 4
+            : $byte == 0xd3 ? 8
+            : die;
+        return 1;
+    }
+
+    elsif ( $byte >= 0xe0 and $byte <= 0xff ) { # negative fixnum
+        return 1;
+    }
+
+    elsif ( $byte >= 0xca and $byte <= 0xcb ) { # float, double
+        $p += $byte == 0xca ? 4 : 8;
+        return 1;
+    }
+
+    elsif ( ( $byte >= 0xa0 and $byte <= 0xbf ) or $byte == 0xda or $byte == 0xdb ) {
+        my $num;
+        if ( $byte == 0xda ) {
+            $num = unpack 'n', substr( $value, $p, 2 );
+            $p += 2;
+        }
+        elsif ( $byte == 0xdb ) {
+            $num = unpack 'N', substr( $value, $p, 4 );
+            $p += 4;
+        }
+        else { # fix raw
+            $num = $byte & ~0xa0;
+        }
+        $p += $num;
+        return 1;
+    }
+
+    else {
+        die "???";
+    }
+
+    return 0;
+}
+
+} # execute
+
+
+sub data {
+    my $data = Data::MessagePack->unpack( $_[0]->{ data } );
+    $_[0]->reset;
+    return $data;
+}
+
+
+sub is_finished {
+    my ( $self ) = @_;
+    ( scalar( @{ $self->{stack} } ) or defined $self->{ remain } ) ? 0 : 1;
+}
+
+
+sub reset {
+    $_[0]->{ stack }  = [];
+    $_[0]->{ data }   = undef;
+    $_[0]->{ remain } = undef;
+}
+
+1;
+__END__
+
+=pod
+
+=head1 NAME
+
+Data::MessagePack::PP - Pure Perl implementation of Data::MessagePack
+
+=head1 DESCRIPTION
+
+This module is used by L<Data::MessagePack> internally.
+
+=head1 SEE ALSO
+
+L<http://msgpack.sourceforge.jp/>,
+L<Data::MessagePack>,
+L<http://frox25.no-ip.org/~mtve/wiki/MessagePack.html>,
+
+=head1 AUTHOR
+
+makamaka
+
+=head1 COPYRIGHT AND LICENSE
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself. 
+
+=cut

perl/perlxs.h

@@ -0,0 +1,76 @@
+/*
+    perlxs.h - Standard XS header file
+    Copyright (c) Fuji, Goro (gfx)
+*/
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#define PERL_NO_GET_CONTEXT /* we want efficiency */
+#include <EXTERN.h>
+
+#include <perl.h>
+#define NO_XSLOCKS /* for exceptions */
+#include <XSUB.h>
+
+#ifdef __cplusplus
+} /* extern "C" */
+#endif
+
+#include "ppport.h"
+
+/* portability stuff not supported by ppport.h yet */
+
+#ifndef STATIC_INLINE /* from 5.13.4 */
+#   if defined(__GNUC__) || defined(__cplusplus__) || (defined(__STDC_VERSION__) && (__STDC_VERSION__ >= 199901L))
+#       define STATIC_INLINE static inline
+#   else
+#       define STATIC_INLINE static
+#   endif
+#endif /* STATIC_INLINE */
+
+#ifndef __attribute__format__
+#define __attribute__format__(a,b,c) /* nothing */
+#endif
+
+#ifndef LIKELY /* they are just a compiler's hint */
+#define LIKELY(x)   (x)
+#define UNLIKELY(x) (x)
+#endif
+
+#ifndef newSVpvs_share
+#define newSVpvs_share(s) Perl_newSVpvn_share(aTHX_ STR_WITH_LEN(s), 0U)
+#endif
+
+#ifndef get_cvs
+#define get_cvs(name, flags) get_cv(name, flags)
+#endif
+
+#ifndef GvNAME_get
+#define GvNAME_get GvNAME
+#endif
+#ifndef GvNAMELEN_get
+#define GvNAMELEN_get GvNAMELEN
+#endif
+
+#ifndef CvGV_set
+#define CvGV_set(cv, gv) (CvGV(cv) = (gv))
+#endif
+
+/* general utility */
+
+#if PERL_BCDVERSION >= 0x5008005
+#define LooksLikeNumber(x) looks_like_number(x)
+#else
+#define LooksLikeNumber(x) (SvPOKp(x) ? looks_like_number(x) : (I32)SvNIOKp(x))
+#endif
+
+#define newAV_mortal() (AV*)sv_2mortal((SV*)newAV())
+#define newHV_mortal() (HV*)sv_2mortal((SV*)newHV())
+
+#define DECL_BOOT(name) EXTERN_C XS(CAT2(boot_, name))
+#define CALL_BOOT(name) STMT_START {            \
+        PUSHMARK(SP);                           \
+        CALL_FPTR(CAT2(boot_, name))(aTHX_ cv); \
+    } STMT_END

perl/t/00_compile.t

@@ -3,4 +3,4 @@ use warnings;
 use Test::More tests => 1;
 
 use_ok 'Data::MessagePack';
-
+diag ( $INC{'Data/MessagePack/PP.pm'} ? 'PP' : 'XS' );

perl/t/05_preferred_int.t

@@ -12,10 +12,15 @@ sub packit {
 }
 
 sub pis ($$) {
-    is packit($_[0]), $_[1], 'dump ' . $_[1];
+    if (ref $_[1]) {
+        like packit($_[0]), $_[1], 'dump ' . $_[1];
+    } else {
+        is packit($_[0]), $_[1], 'dump ' . $_[1];
+    }
     # is(Dumper(Data::MessagePack->unpack(Data::MessagePack->pack($_[0]))), Dumper($_[0]));
 }
 
+my $is_win = $^O eq 'MSWin32';
 my @dat = (
     '',      'a0',
     '0',     '00',
@@ -29,12 +34,16 @@ my @dat = (
     ''.0xFFFFFF => 'ce 00 ff ff ff',
     ''.0xFFFFFFFF => 'ce ff ff ff ff',
     ''.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',
+    ''.0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFF => $is_win ? 
+                                            qr{^(b5 38 2e 33 30 37 36 37 34 39 37 33 36 35 35 37 32 65 2b 30 33 34|b8 38 2e 33 30 37 36 37 34 39 37 33 36 35 35 37 32 34 32 31 65 2b 30 33 34)$}
+                                          : qr{^(b4 38 2e 33 30 37 36 37 34 39 37 33 36 35 35 37 32 65 2b 33 34|b7 38 2e 33 30 37 36 37 34 39 37 33 36 35 35 37 32 34 32 31 65 2b 33 34)$},
     '-'.0x8000000 => 'd2 f8 00 00 00',
     '-'.0x80000000 => 'd2 80 00 00 00',
     '-'.0x800000000 => 'ac 2d 33 34 33 35 39 37 33 38 33 36 38',
     '-'.0x8000000000 => 'ad 2d 35 34 39 37 35 35 38 31 33 38 38 38',
-    '-'.0x800000000000000000000000000000 => 'b5 2d 36 2e 36 34 36 31 33 39 39 37 38 39 32 34 35 38 65 2b 33 35',
+    '-'.0x800000000000000000000000000000 => $is_win ? 
+                                              qr{^(b6 2d 36 2e 36 34 36 31 33 39 39 37 38 39 32 34 35 38 65 2b 30 33 35|b9 2d 36 2e 36 34 36 31 33 39 39 37 38 39 32 34 35 37 39 33 36 65 2b 30 33 35)}
+                                            : qr{^(b5 2d 36 2e 36 34 36 31 33 39 39 37 38 39 32 34 35 38 65 2b 33 35|b8 2d 36 2e 36 34 36 31 33 39 39 37 38 39 32 34 35 37 39 33 36 65 2b 33 35)},
     {'0' => '1'}, '81 00 01',
     {'abc' => '1'}, '81 a3 61 62 63 01',
 );

perl/t/08_cycle.t

@@ -2,7 +2,7 @@ use t::Util;
 use Test::More;
 use Data::MessagePack;
 
-plan tests => 5;
+plan tests => 6;
 
 my $aref = [0];
 $aref->[1] = $aref;
@@ -23,3 +23,6 @@ ok !$@;
 
 eval { Data::MessagePack->pack($aref, 2) };
 ok $@, $@;
+
+eval { Data::MessagePack->pack($aref, -1) };
+ok $@, $@;

perl/xs-src/pack.c

@@ -2,16 +2,7 @@
  * code is written by tokuhirom.
  * buffer alocation technique is taken from JSON::XS. thanks to mlehmann.
  */
-#ifdef __cplusplus
-extern "C" {
-#endif
-#include "EXTERN.h"
-#include "perl.h"
-#include "XSUB.h"
-#include "ppport.h"
-#ifdef __cplusplus
-};
-#endif
+#include "perlxs.h"
 
 #include "msgpack/pack_define.h"
 
@@ -52,7 +43,7 @@ static void need(enc_t *enc, STRLEN len);
 #define ERR_NESTING_EXCEEDED "perl structure exceeds maximum nesting level (max_depth set too low?)"
 
 
-static void need(enc_t *enc, STRLEN len)
+STATIC_INLINE void need(enc_t *enc, STRLEN len)
 {
     if (enc->cur + len >= enc->end) {
         STRLEN cur = enc->cur - (char *)SvPVX (enc->sv);
@@ -65,7 +56,7 @@ static void need(enc_t *enc, STRLEN len)
 
 static int s_pref_int = 0;
 
-static int pref_int_set(pTHX_ SV* sv, MAGIC* mg) {
+STATIC_INLINE int pref_int_set(pTHX_ SV* sv, MAGIC* mg) {
     if (SvTRUE(sv)) {
         s_pref_int = 1;
     } else {
@@ -94,7 +85,7 @@ void boot_Data__MessagePack_pack(void) {
 }
 
 
-static int try_int(enc_t* enc, const char *p, size_t len) {
+STATIC_INLINE int try_int(enc_t* enc, const char *p, size_t len) {
     int negative = 0;
     const char* pe = p + len;
     uint64_t num = 0;
@@ -150,8 +141,8 @@ static int try_int(enc_t* enc, const char *p, size_t len) {
 
 static void _msgpack_pack_rv(enc_t *enc, SV* sv, int depth);
 
-static void _msgpack_pack_sv(enc_t *enc, SV* sv, int depth) {
-    if (!depth) Perl_croak(aTHX_ ERR_NESTING_EXCEEDED);
+STATIC_INLINE void _msgpack_pack_sv(enc_t *enc, SV* sv, int depth) {
+    if (depth <= 0) Perl_croak(aTHX_ ERR_NESTING_EXCEEDED);
     SvGETMAGIC(sv);
 
     if (sv==NULL) {
@@ -185,9 +176,9 @@ static void _msgpack_pack_sv(enc_t *enc, SV* sv, int depth) {
     }
 }
 
-static void _msgpack_pack_rv(enc_t *enc, SV* sv, int depth) {
+STATIC_INLINE void _msgpack_pack_rv(enc_t *enc, SV* sv, int depth) {
     svtype svt;
-    if (!depth) Perl_croak(aTHX_ ERR_NESTING_EXCEEDED);
+    if (depth <= 0) Perl_croak(aTHX_ ERR_NESTING_EXCEEDED);
     SvGETMAGIC(sv);
     svt = SvTYPE(sv);
 

perl/xs-src/unpack.c

@@ -2,13 +2,9 @@
 extern "C" {
 #endif
 
-#include "EXTERN.h"
-#include "perl.h"
-#include "XSUB.h"
-#include "util.h"
 #define NEED_newRV_noinc
 #define NEED_sv_2pv_flags
-#include "ppport.h"
+#include "perlxs.h"
 
 #ifdef __cplusplus
 };
@@ -26,7 +22,7 @@ typedef struct {
     struct template ## name
 
 #define msgpack_unpack_func(ret, name) \
-    ret template ## name
+    STATIC_INLINE ret template ## name
 
 #define msgpack_unpack_callback(name) \
     template_callback ## name
@@ -38,7 +34,7 @@ typedef struct {
 /* ---------------------------------------------------------------------- */
 /* utility functions                                                      */
 
-static INLINE SV *
+STATIC_INLINE SV *
 get_bool (const char *name) {
     SV * sv = sv_mortalcopy(get_sv( name, 1 ));
 
@@ -60,19 +56,19 @@ static SV* template_data(msgpack_unpack_t* u);
 static int template_execute(msgpack_unpack_t* u,
     const char* data, size_t len, size_t* off);
 
-static INLINE SV* template_callback_root(unpack_user* u)
+STATIC_INLINE SV* template_callback_root(unpack_user* u)
 { return &PL_sv_undef; }
 
-static INLINE int template_callback_uint8(unpack_user* u, uint8_t d, SV** o)
+STATIC_INLINE int template_callback_uint8(unpack_user* u, uint8_t d, SV** o)
 { *o = sv_2mortal(newSVuv(d)); return 0; }
 
-static INLINE int template_callback_uint16(unpack_user* u, uint16_t d, SV** o)
+STATIC_INLINE int template_callback_uint16(unpack_user* u, uint16_t d, SV** o)
 { *o = sv_2mortal(newSVuv(d)); return 0; }
 
-static INLINE int template_callback_uint32(unpack_user* u, uint32_t d, SV** o)
+STATIC_INLINE int template_callback_uint32(unpack_user* u, uint32_t d, SV** o)
 { *o = sv_2mortal(newSVuv(d)); return 0; }
 
-static INLINE int template_callback_uint64(unpack_user* u, uint64_t d, SV** o)
+STATIC_INLINE int template_callback_uint64(unpack_user* u, uint64_t d, SV** o)
 {
 #if IVSIZE==4
     *o = sv_2mortal(newSVnv(d));
@@ -82,47 +78,47 @@ static INLINE int template_callback_uint64(unpack_user* u, uint64_t d, SV** o)
     return 0;
 }
 
-static INLINE int template_callback_int8(unpack_user* u, int8_t d, SV** o)
+STATIC_INLINE int template_callback_int8(unpack_user* u, int8_t d, SV** o)
 { *o = sv_2mortal(newSViv((long)d)); return 0; }
 
-static INLINE int template_callback_int16(unpack_user* u, int16_t d, SV** o)
+STATIC_INLINE int template_callback_int16(unpack_user* u, int16_t d, SV** o)
 { *o = sv_2mortal(newSViv((long)d)); return 0; }
 
-static INLINE int template_callback_int32(unpack_user* u, int32_t d, SV** o)
+STATIC_INLINE int template_callback_int32(unpack_user* u, int32_t d, SV** o)
 { *o = sv_2mortal(newSViv((long)d)); return 0; }
 
-static INLINE int template_callback_int64(unpack_user* u, int64_t d, SV** o)
+STATIC_INLINE int template_callback_int64(unpack_user* u, int64_t d, SV** o)
 { *o = sv_2mortal(newSViv(d)); return 0; }
 
-static INLINE int template_callback_float(unpack_user* u, float d, SV** o)
+STATIC_INLINE int template_callback_float(unpack_user* u, float d, SV** o)
 { *o = sv_2mortal(newSVnv(d)); return 0; }
 
-static INLINE int template_callback_double(unpack_user* u, double d, SV** o)
+STATIC_INLINE int template_callback_double(unpack_user* u, double d, SV** o)
 { *o = sv_2mortal(newSVnv(d)); return 0; }
 
 /* &PL_sv_undef is not so good. see http://gist.github.com/387743 */
-static INLINE int template_callback_nil(unpack_user* u, SV** o)
+STATIC_INLINE int template_callback_nil(unpack_user* u, SV** o)
 { *o = sv_newmortal(); return 0; }
 
-static INLINE int template_callback_true(unpack_user* u, SV** o)
+STATIC_INLINE int template_callback_true(unpack_user* u, SV** o)
 { *o = get_bool("Data::MessagePack::true") ; return 0; }
 
-static INLINE int template_callback_false(unpack_user* u, SV** o)
+STATIC_INLINE int template_callback_false(unpack_user* u, SV** o)
 { *o = get_bool("Data::MessagePack::false") ; return 0; }
 
-static INLINE int template_callback_array(unpack_user* u, unsigned int n, SV** o)
+STATIC_INLINE int template_callback_array(unpack_user* u, unsigned int n, SV** o)
 { AV* a = (AV*)sv_2mortal((SV*)newAV()); *o = sv_2mortal((SV*)newRV_inc((SV*)a)); av_extend(a, n); return 0; }
 
-static INLINE int template_callback_array_item(unpack_user* u, SV** c, SV* o)
+STATIC_INLINE int template_callback_array_item(unpack_user* u, SV** c, SV* o)
 { av_push((AV*)SvRV(*c), o); SvREFCNT_inc(o); return 0; }  /* FIXME set value directry RARRAY_PTR(obj)[RARRAY_LEN(obj)++] */
 
-static INLINE int template_callback_map(unpack_user* u, unsigned int n, SV** o)
+STATIC_INLINE int template_callback_map(unpack_user* u, unsigned int n, SV** o)
 { HV * h = (HV*)sv_2mortal((SV*)newHV()); *o = sv_2mortal(newRV_inc((SV*)h)); return 0; }
 
-static INLINE int template_callback_map_item(unpack_user* u, SV** c, SV* k, SV* v)
+STATIC_INLINE int template_callback_map_item(unpack_user* u, SV** c, SV* k, SV* v)
 { hv_store_ent((HV*)SvRV(*c), k, v, 0); SvREFCNT_inc(v); return 0; }
 
-static INLINE int template_callback_raw(unpack_user* u, const char* b, const char* p, unsigned int l, SV** o)
+STATIC_INLINE int template_callback_raw(unpack_user* u, const char* b, const char* p, unsigned int l, SV** o)
 { *o = sv_2mortal((l==0) ? newSVpv("", 0) : newSVpv(p, l)); return 0; }
 /* { *o = newSVpvn_flags(p, l, SVs_TEMP); return 0; }  <= this does not works. */
 
@@ -135,7 +131,7 @@ static INLINE int template_callback_raw(unpack_user* u, const char* b, const cha
 
 #include "msgpack/unpack_template.h"
 
-SV* _msgpack_unpack(SV* data, int limit) {
+STATIC_INLINE SV* _msgpack_unpack(SV* data, int limit) {
     msgpack_unpack_t mp;
     unpack_user u = {0, &PL_sv_undef};
 	int ret;
@@ -198,7 +194,7 @@ XS(xs_unpack) {
 /* ------------------------------ stream -- */
 /* http://twitter.com/frsyuki/status/13249304748 */
 
-static void _reset(SV* self) {
+STATIC_INLINE void _reset(SV* self) {
 	unpack_user u = {0, &PL_sv_undef, 0};
 
 	UNPACKER(self, mp);
@@ -224,7 +220,7 @@ XS(xs_unpacker_new) {
     XSRETURN(1);
 }
 
-static SV* _execute_impl(SV* self, SV* data, UV off, I32 limit) {
+STATIC_INLINE SV* _execute_impl(SV* self, SV* data, UV off, I32 limit) {
     UNPACKER(self, mp);
 
     size_t from = off;

python/.gitignore

@@ -3,3 +3,4 @@ build/*
 dist/*
 *.pyc
 *.pyo
+msgpack/__version__.py

python/Makefile

@@ -1,7 +1,12 @@
+.PHONY: test all python3
+
 all:
 	python setup.py build_ext -i -f
 	python setup.py build sdist
 
-.PHONY: test
+python3:
+	python3 setup.py build_ext -i -f
+	python3 setup.py build sdist
+
 test:
 	nosetests test

python/msgpack/__init__.py

@@ -1,5 +1,6 @@
 # coding: utf-8
-from _msgpack import *
+from msgpack.__version__ import *
+from msgpack._msgpack import *
 
 # alias for compatibility to simplejson/marshal/pickle.
 load = unpack

python/msgpack/_msgpack.pyx

@@ -1,26 +1,24 @@
 # coding: utf-8
 
-import cStringIO
-
 cdef extern from "Python.h":
     ctypedef char* const_char_ptr "const char*"
     ctypedef struct PyObject
 
-    cdef object PyString_FromStringAndSize(const_char_ptr b, Py_ssize_t len)
+    cdef object PyBytes_FromStringAndSize(const_char_ptr b, Py_ssize_t len)
     cdef PyObject* Py_True
     cdef PyObject* Py_False
 
-    cdef char* PyString_AsString(object o)
     cdef long long PyLong_AsLongLong(object o)
     cdef unsigned long long PyLong_AsUnsignedLongLong(object o)
 
-    cdef int PyMapping_Check(object o)
-    cdef int PySequence_Check(object o)
-    cdef int PyLong_Check(object o)
-    cdef int PyInt_Check(object o)
-    cdef int PyFloat_Check(object o)
-    cdef int PyString_Check(object o)
-    cdef int PyUnicode_Check(object o)
+    cdef bint PyBool_Check(object o)
+    cdef bint PyDict_Check(object o)
+    cdef bint PySequence_Check(object o)
+    cdef bint PyLong_Check(object o)
+    cdef bint PyInt_Check(object o)
+    cdef bint PyFloat_Check(object o)
+    cdef bint PyBytes_Check(object o)
+    cdef bint PyUnicode_Check(object o)
 
 cdef extern from "stdlib.h":
     void* malloc(size_t)
@@ -71,20 +69,23 @@ cdef class Packer(object):
     def __dealloc__(self):
         free(self.pk.buf);
 
-    cdef int __pack(self, object o) except -1:
+    cdef int _pack(self, object o) except -1:
         cdef long long llval
         cdef unsigned long long ullval
         cdef long longval
         cdef double fval
         cdef char* rawval 
         cdef int ret
+        cdef dict d
 
         if o is None:
             ret = msgpack_pack_nil(&self.pk)
-        elif <PyObject*>o == Py_True:
-            ret = msgpack_pack_true(&self.pk)
-        elif <PyObject*>o == Py_False:
-            ret = msgpack_pack_false(&self.pk)
+            #elif PyBool_Check(o):
+        elif isinstance(o, bool):
+            if o:
+                ret = msgpack_pack_true(&self.pk)
+            else:
+                ret = msgpack_pack_false(&self.pk)
         elif PyLong_Check(o):
             if o > 0:
                 ullval = PyLong_AsUnsignedLongLong(o)
@@ -98,7 +99,7 @@ cdef class Packer(object):
         elif PyFloat_Check(o):
             fval = o
             ret = msgpack_pack_double(&self.pk, fval)
-        elif PyString_Check(o):
+        elif PyBytes_Check(o):
             rawval = o
             ret = msgpack_pack_raw(&self.pk, len(o))
             if ret == 0:
@@ -109,19 +110,20 @@ cdef class Packer(object):
             ret = msgpack_pack_raw(&self.pk, len(o))
             if ret == 0:
                 ret = msgpack_pack_raw_body(&self.pk, rawval, len(o))
-        elif PyMapping_Check(o):
-            ret = msgpack_pack_map(&self.pk, len(o))
+        elif PyDict_Check(o):
+            d = o
+            ret = msgpack_pack_map(&self.pk, len(d))
             if ret == 0:
-                for k,v in o.iteritems():
-                    ret = self.__pack(k)
+                for k,v in d.items():
+                    ret = self._pack(k)
                     if ret != 0: break
-                    ret = self.__pack(v)
+                    ret = self._pack(v)
                     if ret != 0: break
         elif PySequence_Check(o):
             ret = msgpack_pack_array(&self.pk, len(o))
             if ret == 0:
                 for v in o:
-                    ret = self.__pack(v)
+                    ret = self._pack(v)
                     if ret != 0: break
         else:
             # TODO: Serialize with defalt() like simplejson.
@@ -130,10 +132,10 @@ cdef class Packer(object):
 
     def pack(self, object obj):
         cdef int ret
-        ret = self.__pack(obj)
+        ret = self._pack(obj)
         if ret:
             raise TypeError
-        buf = PyString_FromStringAndSize(self.pk.buf, self.pk.length)
+        buf = PyBytes_FromStringAndSize(self.pk.buf, self.pk.length)
         self.pk.length = 0
         return buf
 
@@ -253,19 +255,18 @@ cdef class Unpacker(object):
         template_init(&self.ctx)
         self.ctx.user.use_list = use_list
 
-    def feed(self, next_bytes):
-        if not isinstance(next_bytes, str):
-           raise ValueError, "Argument must be bytes object"
+    def feed(self, bytes next_bytes):
         self.waiting_bytes.append(next_bytes)
 
     cdef append_buffer(self):
         cdef char* buf = self.buf
         cdef Py_ssize_t tail = self.buf_tail
         cdef Py_ssize_t l
+        cdef bytes b
 
         for b in self.waiting_bytes:
             l = len(b)
-            memcpy(buf + tail, PyString_AsString(b), l)
+            memcpy(buf + tail, <char*>(b), l)
             tail += l
         self.buf_tail = tail
         del self.waiting_bytes[:]

python/msgpack/unpack.h

@@ -175,7 +175,7 @@ static inline int template_callback_map_item(unpack_user* u, msgpack_unpack_obje
 static inline int template_callback_raw(unpack_user* u, const char* b, const char* p, unsigned int l, msgpack_unpack_object* o)
 {
     PyObject *py;
-    py = PyString_FromStringAndSize(p, l);
+    py = PyBytes_FromStringAndSize(p, l);
     if (!py)
         return -1;
     *o = py;

python/setup.py

@@ -1,5 +1,6 @@
 #!/usr/bin/env python
 # coding: utf-8
+version = (0, 1, 6, 'final')
 
 import os
 from glob import glob
@@ -14,7 +15,13 @@ except ImportError:
     from distutils.command.build_ext import build_ext
     have_cython = False
 
-version = '0.1.4'
+# make msgpack/__verison__.py
+f = open('msgpack/__version__.py', 'w')
+f.write("version = %r\n" % (version,))
+f.close()
+version_str = '.'.join(str(x) for x in version[:3])
+if len(version) > 3 and version[3] != 'final':
+    version_str += version[3]
 
 # take care of extension modules.
 if have_cython:
@@ -53,7 +60,7 @@ What's MessagePack? (from http://msgpack.sourceforge.net/)
 setup(name='msgpack-python',
       author='INADA Naoki',
       author_email='songofacandy@gmail.com',
-      version=version,
+      version=version_str,
       cmdclass={'build_ext': build_ext, 'sdist': Sdist},
       ext_modules=[msgpack_mod],
       packages=['msgpack'],
@@ -62,6 +69,7 @@ setup(name='msgpack-python',
       url='http://msgpack.sourceforge.net/',
       download_url='http://pypi.python.org/pypi/msgpack/',
       classifiers=[
+          'Programming Language :: Python :: 3',
           'Development Status :: 4 - Beta',
           'Intended Audience :: Developers',
           'License :: OSI Approved :: Apache Software License',

python/test3/test_case.py

@@ -0,0 +1,102 @@
+#!/usr/bin/env python
+# coding: utf-8
+
+from nose import main
+from nose.tools import *
+from msgpack import packs, unpacks
+
+
+def check(length, obj):
+    v = packs(obj)
+    assert_equal(len(v), length, "%r length should be %r but get %r" % (obj, length, len(v)))
+    assert_equal(unpacks(v), obj)
+
+def test_1():
+    for o in [None, True, False, 0, 1, (1 << 6), (1 << 7) - 1, -1,
+              -((1<<5)-1), -(1<<5)]:
+        check(1, o)
+
+def test_2():
+    for o in [1 << 7, (1 << 8) - 1,
+              -((1<<5)+1), -(1<<7)
+             ]:
+        check(2, o)
+
+def test_3():
+    for o in [1 << 8, (1 << 16) - 1,
+              -((1<<7)+1), -(1<<15)]:
+        check(3, o)
+
+def test_5():
+    for o in [1 << 16, (1 << 32) - 1,
+              -((1<<15)+1), -(1<<31)]:
+        check(5, o)
+
+def test_9():
+    for o in [1 << 32, (1 << 64) - 1,
+              -((1<<31)+1), -(1<<63),
+              1.0, 0.1, -0.1, -1.0]:
+        check(9, o)
+
+
+def check_raw(overhead, num):
+    check(num + overhead, b" " * num)
+
+def test_fixraw():
+    check_raw(1, 0)
+    check_raw(1, (1<<5) - 1)
+
+def test_raw16():
+    check_raw(3, 1<<5)
+    check_raw(3, (1<<16) - 1)
+
+def test_raw32():
+    check_raw(5, 1<<16)
+
+
+def check_array(overhead, num):
+    check(num + overhead, (None,) * num)
+
+def test_fixarray():
+    check_array(1, 0)
+    check_array(1, (1 << 4) - 1)
+
+def test_array16():
+    check_array(3, 1 << 4)
+    check_array(3, (1<<16)-1)
+
+def test_array32():
+    check_array(5, (1<<16))
+
+
+def match(obj, buf):
+    assert_equal(packs(obj), buf)
+    assert_equal(unpacks(buf), obj)
+
+def test_match():
+    cases = [
+        (None, b'\xc0'),
+        (False, b'\xc2'),
+        (True, b'\xc3'),
+        (0, b'\x00'),
+        (127, b'\x7f'),
+        (128, b'\xcc\x80'),
+        (256, b'\xcd\x01\x00'),
+        (-1, b'\xff'),
+        (-33, b'\xd0\xdf'),
+        (-129, b'\xd1\xff\x7f'),
+        ({1:1}, b'\x81\x01\x01'),
+        (1.0, b"\xcb\x3f\xf0\x00\x00\x00\x00\x00\x00"),
+        ((), b'\x90'),
+        (tuple(range(15)),b"\x9f\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e"),
+        (tuple(range(16)),b"\xdc\x00\x10\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f"),
+        ({}, b'\x80'),
+        (dict([(x,x) for x in range(15)]), b'\x8f\x00\x00\x01\x01\x02\x02\x03\x03\x04\x04\x05\x05\x06\x06\x07\x07\x08\x08\t\t\n\n\x0b\x0b\x0c\x0c\r\r\x0e\x0e'),
+        (dict([(x,x) for x in range(16)]), b'\xde\x00\x10\x00\x00\x01\x01\x02\x02\x03\x03\x04\x04\x05\x05\x06\x06\x07\x07\x08\x08\t\t\n\n\x0b\x0b\x0c\x0c\r\r\x0e\x0e\x0f\x0f'),
+        ]
+
+    for v, p in cases:
+        match(v, p)
+
+if __name__ == '__main__':
+    main()

python/test3/test_except.py

@@ -0,0 +1,14 @@
+#!/usr/bin/env python
+# coding: utf-8
+
+from nose.tools import *
+from msgpack import packs, unpacks
+
+import datetime
+
+def test_raise_on_find_unsupported_value():
+    assert_raises(TypeError, packs, datetime.datetime.now())
+
+if __name__ == '__main__':
+    from nose import main
+    main()

python/test3/test_format.py

@@ -0,0 +1,75 @@
+#!/usr/bin/env python
+# coding: utf-8
+
+from nose import main
+from nose.tools import *
+from msgpack import unpacks
+
+def check(src, should):
+    assert_equal(unpacks(src), should)
+
+def testSimpleValue():
+    check(b"\x93\xc0\xc2\xc3", 
+            (None, False, True,))
+
+def testFixnum():
+    check(b"\x92\x93\x00\x40\x7f\x93\xe0\xf0\xff",
+          ((0,64,127,), (-32,-16,-1,),)
+          )
+
+def testFixArray():
+    check(b"\x92\x90\x91\x91\xc0",
+          ((),((None,),),),
+          )
+
+def testFixRaw():
+    check(b"\x94\xa0\xa1a\xa2bc\xa3def",
+          (b"", b"a", b"bc", b"def",),
+          )
+
+def testFixMap():
+    check(
+          b"\x82\xc2\x81\xc0\xc0\xc3\x81\xc0\x80",
+          {False: {None: None}, True:{None:{}}},
+          )
+
+def testUnsignedInt():
+    check(
+          b"\x99\xcc\x00\xcc\x80\xcc\xff\xcd\x00\x00\xcd\x80\x00"
+          b"\xcd\xff\xff\xce\x00\x00\x00\x00\xce\x80\x00\x00\x00"
+          b"\xce\xff\xff\xff\xff",
+          (0, 128, 255, 0, 32768, 65535, 0, 2147483648, 4294967295,),
+          )
+
+def testSignedInt():
+    check(b"\x99\xd0\x00\xd0\x80\xd0\xff\xd1\x00\x00\xd1\x80\x00"
+          b"\xd1\xff\xff\xd2\x00\x00\x00\x00\xd2\x80\x00\x00\x00"
+          b"\xd2\xff\xff\xff\xff",
+          (0, -128, -1, 0, -32768, -1, 0, -2147483648, -1,))
+
+def testRaw():
+    check(b"\x96\xda\x00\x00\xda\x00\x01a\xda\x00\x02ab\xdb\x00\x00"
+        b"\x00\x00\xdb\x00\x00\x00\x01a\xdb\x00\x00\x00\x02ab",
+        (b"", b"a", b"ab", b"", b"a", b"ab"))
+
+def testArray():
+    check(b"\x96\xdc\x00\x00\xdc\x00\x01\xc0\xdc\x00\x02\xc2\xc3\xdd\x00"
+        b"\x00\x00\x00\xdd\x00\x00\x00\x01\xc0\xdd\x00\x00\x00\x02"
+        b"\xc2\xc3",
+        ((), (None,), (False,True), (), (None,), (False,True))
+        )
+
+def testMap():
+    check(
+        b"\x96"
+            b"\xde\x00\x00"
+            b"\xde\x00\x01\xc0\xc2"
+            b"\xde\x00\x02\xc0\xc2\xc3\xc2"
+            b"\xdf\x00\x00\x00\x00"
+            b"\xdf\x00\x00\x00\x01\xc0\xc2"
+            b"\xdf\x00\x00\x00\x02\xc0\xc2\xc3\xc2",
+        ({}, {None: False}, {True: False, None: False}, {},
+            {None: False}, {True: False, None: False}))
+
+if __name__ == '__main__':
+    main()

python/test3/test_pack.py

@@ -0,0 +1,28 @@
+#!/usr/bin/env python
+# coding: utf-8
+
+from nose import main
+from nose.tools import *
+
+from msgpack import packs, unpacks
+
+def check(data):
+    re = unpacks(packs(data))
+    assert_equal(re, data)
+
+def testPack():
+    test_data = [
+            0, 1, 127, 128, 255, 256, 65535, 65536,
+            -1, -32, -33, -128, -129, -32768, -32769,
+            1.0,
+        b"", b"a", b"a"*31, b"a"*32,
+        None, True, False,
+        (), ((),), ((), None,), 
+        {None: 0}, 
+        (1<<23), 
+        ]
+    for td in test_data:
+        check(td)
+
+if __name__ == '__main__':
+    main()

python/test3/test_sequnpack.py

@@ -0,0 +1,36 @@
+#!/usr/bin/env python
+# coding: utf-8
+
+
+
+from msgpack import Unpacker
+
+def test_foobar():
+    unpacker = Unpacker(read_size=3)
+    unpacker.feed(b'foobar')
+    assert unpacker.unpack() == ord(b'f')
+    assert unpacker.unpack() == ord(b'o')
+    assert unpacker.unpack() == ord(b'o')
+    assert unpacker.unpack() == ord(b'b')
+    assert unpacker.unpack() == ord(b'a')
+    assert unpacker.unpack() == ord(b'r')
+    try:
+        o = unpacker.unpack()
+        print(("Oops!", o))
+        assert 0
+    except StopIteration:
+        assert 1
+    else:
+        assert 0
+    unpacker.feed(b'foo')
+    unpacker.feed(b'bar')
+
+    k = 0
+    for o, e in zip(unpacker, b'foobarbaz'):
+        assert o == e
+        k += 1
+    assert k == len(b'foobar')
+
+if __name__ == '__main__':
+    test_foobar()
+

ruby/compat.h

@@ -0,0 +1,77 @@
+/*
+ * MessagePack for Ruby
+ *
+ * Copyright (C) 2008-2010 FURUHASHI Sadayuki
+ *
+ *    Licensed under the Apache License, Version 2.0 (the "License");
+ *    you may not use this file except in compliance with the License.
+ *    You may obtain a copy of the License at
+ *
+ *        http://www.apache.org/licenses/LICENSE-2.0
+ *
+ *    Unless required by applicable law or agreed to in writing, software
+ *    distributed under the License is distributed on an "AS IS" BASIS,
+ *    WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ *    See the License for the specific language governing permissions and
+ *    limitations under the License.
+ */
+#ifndef COMPAT_H__
+#define COMPAT_H__
+
+
+#ifdef HAVE_RUBY_ENCODING_H
+#include "ruby/encoding.h"
+#define COMPAT_HAVE_ENCODING
+extern int s_enc_utf8;
+extern int s_enc_ascii8bit;
+extern int s_enc_usascii;
+extern VALUE s_enc_utf8_value;
+#endif
+
+#ifdef RUBY_VM
+#define COMPAT_RERAISE rb_exc_raise(rb_errinfo())
+#else
+#define COMPAT_RERAISE rb_exc_raise(ruby_errinfo)
+#endif
+
+
+/* ruby 1.8 and Rubinius */
+#ifndef RBIGNUM_POSITIVE_P
+# ifdef RUBINIUS
+#  define RBIGNUM_POSITIVE_P(b) (rb_funcall(b, rb_intern(">="), 1, INT2FIX(0)) == Qtrue)
+# else
+#  define RBIGNUM_POSITIVE_P(b) (RBIGNUM(b)->sign)
+# endif
+#endif
+
+
+/* Rubinius */
+#ifdef RUBINIUS
+static inline void rb_gc_enable() { return; }
+static inline void rb_gc_disable() { return; }
+#endif
+
+
+/* ruby 1.8.5 */
+#ifndef RSTRING_PTR
+#define RSTRING_PTR(s) (RSTRING(s)->ptr)
+#endif
+
+/* ruby 1.8.5 */
+#ifndef RSTRING_LEN
+#define RSTRING_LEN(s) (RSTRING(s)->len)
+#endif
+
+/* ruby 1.8.5 */
+#ifndef RARRAY_PTR
+#define RARRAY_PTR(s) (RARRAY(s)->ptr)
+#endif
+
+/* ruby 1.8.5 */
+#ifndef RARRAY_LEN
+#define RARRAY_LEN(s) (RARRAY(s)->len)
+#endif
+
+
+#endif /* compat.h */
+

ruby/extconf.rb

@@ -1,5 +1,5 @@
 require 'mkmf'
 require './version.rb'
-$CFLAGS << %[ -I.. -Wall -O4 -DMESSAGEPACK_VERSION=\\"#{MessagePack::VERSION}\\"]
+$CFLAGS << %[ -I.. -Wall -O4 -DMESSAGEPACK_VERSION=\\"#{MessagePack::VERSION}\\" -g]
 create_makefile('msgpack')
 

ruby/pack.c

@@ -16,6 +16,8 @@
  *    limitations under the License.
  */
 #include "ruby.h"
+#include "compat.h"
+
 #include "msgpack/pack_define.h"
 
 static ID s_to_msgpack;
@@ -116,10 +118,6 @@ static VALUE MessagePack_Fixnum_to_msgpack(int argc, VALUE *argv, VALUE self)
 }
 
 
-#ifndef RBIGNUM_SIGN  // Ruby 1.8
-#define RBIGNUM_SIGN(b) (RBIGNUM(b)->sign)
-#endif
-
 /*
  * Document-method: Bignum#to_msgpack
  *
@@ -131,10 +129,9 @@ static VALUE MessagePack_Fixnum_to_msgpack(int argc, VALUE *argv, VALUE self)
 static VALUE MessagePack_Bignum_to_msgpack(int argc, VALUE *argv, VALUE self)
 {
 	ARG_BUFFER(out, argc, argv);
-	// FIXME bignum
-	if(RBIGNUM_SIGN(self)) {  // positive
+	if(RBIGNUM_POSITIVE_P(self)) {
 		msgpack_pack_uint64(out, rb_big2ull(self));
-	} else {  // negative
+	} else {
 		msgpack_pack_int64(out, rb_big2ll(self));
 	}
 	return out;
@@ -168,6 +165,14 @@ static VALUE MessagePack_Float_to_msgpack(int argc, VALUE *argv, VALUE self)
 static VALUE MessagePack_String_to_msgpack(int argc, VALUE *argv, VALUE self)
 {
 	ARG_BUFFER(out, argc, argv);
+#ifdef COMPAT_HAVE_ENCODING
+	int enc = ENCODING_GET(self);
+	if(enc != s_enc_utf8 && enc != s_enc_ascii8bit && enc != s_enc_usascii) {
+		if(!ENC_CODERANGE_ASCIIONLY(self)) {
+			self = rb_str_encode(self, s_enc_utf8_value, 0, Qnil);
+		}
+	}
+#endif
 	msgpack_pack_raw(out, RSTRING_LEN(self));
 	msgpack_pack_raw_body(out, RSTRING_PTR(self), RSTRING_LEN(self));
 	return out;
@@ -184,12 +189,16 @@ static VALUE MessagePack_String_to_msgpack(int argc, VALUE *argv, VALUE self)
  */
 static VALUE MessagePack_Symbol_to_msgpack(int argc, VALUE *argv, VALUE self)
 {
+#ifdef COMPAT_HAVE_ENCODING
+	return MessagePack_String_to_msgpack(argc, argv, rb_id2str(SYM2ID(self)));
+#else
 	ARG_BUFFER(out, argc, argv);
 	const char* name = rb_id2name(SYM2ID(self));
 	size_t len = strlen(name);
 	msgpack_pack_raw(out, len);
 	msgpack_pack_raw_body(out, name, len);
 	return out;
+#endif
 }
 
 
@@ -205,7 +214,8 @@ static VALUE MessagePack_Symbol_to_msgpack(int argc, VALUE *argv, VALUE self)
 static VALUE MessagePack_Array_to_msgpack(int argc, VALUE *argv, VALUE self)
 {
 	ARG_BUFFER(out, argc, argv);
-	msgpack_pack_array(out, RARRAY_LEN(self));
+	// FIXME check sizeof(long) > sizeof(unsigned int) && RARRAY_LEN(self) > UINT_MAX
+	msgpack_pack_array(out, (unsigned int)RARRAY_LEN(self));
 	VALUE* p = RARRAY_PTR(self);
 	VALUE* const pend = p + RARRAY_LEN(self);
 	for(;p != pend; ++p) {
@@ -239,7 +249,8 @@ static int MessagePack_Hash_to_msgpack_foreach(VALUE key, VALUE value, VALUE out
 static VALUE MessagePack_Hash_to_msgpack(int argc, VALUE *argv, VALUE self)
 {
 	ARG_BUFFER(out, argc, argv);
-	msgpack_pack_map(out, RHASH_SIZE(self));
+	// FIXME check sizeof(st_index_t) > sizeof(unsigned int) && RARRAY_LEN(self) > UINT_MAX
+	msgpack_pack_map(out, (unsigned int)RHASH_SIZE(self));
 	rb_hash_foreach(self, MessagePack_Hash_to_msgpack_foreach, out);
 	return out;
 }

ruby/rbinit.c

@@ -17,9 +17,17 @@
  */
 #include "pack.h"
 #include "unpack.h"
+#include "compat.h"
 
 static VALUE mMessagePack;
 
+#ifdef COMPAT_HAVE_ENCODING
+int s_enc_utf8;
+int s_enc_ascii8bit;
+int s_enc_usascii;
+VALUE s_enc_utf8_value;
+#endif
+
 /**
  * Document-module: MessagePack
  *
@@ -46,6 +54,13 @@ void Init_msgpack(void)
 
 	rb_define_const(mMessagePack, "VERSION", rb_str_new2(MESSAGEPACK_VERSION));
 
+#ifdef COMPAT_HAVE_ENCODING
+	s_enc_ascii8bit = rb_ascii8bit_encindex();
+	s_enc_utf8 = rb_utf8_encindex();
+	s_enc_usascii = rb_usascii_encindex();
+	s_enc_utf8_value = rb_enc_from_encoding(rb_utf8_encoding());
+#endif
+
 	Init_msgpack_unpack(mMessagePack);
 	Init_msgpack_pack(mMessagePack);
 }

ruby/test/test_encoding.rb

@@ -0,0 +1,68 @@
+#!/usr/bin/env ruby
+require File.dirname(__FILE__)+'/test_helper'
+
+if RUBY_VERSION < "1.9"
+	exit
+end
+
+class MessagePackTestEncoding < Test::Unit::TestCase
+	def self.it(name, &block)
+		define_method("test_#{name}", &block)
+	end
+
+	it "US-ASCII" do
+		check_unpack "abc".force_encoding("US-ASCII")
+	end
+
+	it "UTF-8 ascii" do
+		check_unpack "abc".force_encoding("UTF-8")
+	end
+
+	it "UTF-8 mbstr" do
+		check_unpack "\xE3\x81\x82".force_encoding("UTF-8")
+	end
+
+	it "UTF-8 invalid" do
+		check_unpack "\xD0".force_encoding("UTF-8")
+	end
+
+	it "ASCII-8BIT" do
+		check_unpack "\xD0".force_encoding("ASCII-8BIT")
+	end
+
+	it "EUC-JP" do
+		x = "\xA4\xA2".force_encoding("EUC-JP")
+		check_unpack(x)
+	end
+
+	it "EUC-JP invalid" do
+		begin
+			"\xD0".force_encoding("EUC-JP").to_msgpack
+			assert(false)
+		rescue Encoding::InvalidByteSequenceError
+			assert(true)
+		end
+	end
+
+	private
+	def check_unpack(str)
+		if str.encoding.to_s == "ASCII-8BIT"
+			should_str = str.dup.force_encoding("UTF-8")
+		else
+			should_str = str.encode("UTF-8")
+		end
+
+		raw = str.to_msgpack
+		r = MessagePack.unpack(str.to_msgpack)
+		assert_equal(r.encoding.to_s, "UTF-8")
+		assert_equal(r, should_str.force_encoding("UTF-8"))
+
+		if str.valid_encoding?
+			sym = str.to_sym
+			r = MessagePack.unpack(sym.to_msgpack)
+			assert_equal(r.encoding.to_s, "UTF-8")
+			assert_equal(r, should_str.force_encoding("UTF-8"))
+		end
+	end
+end
+

ruby/test/test_helper.rb

@@ -5,4 +5,6 @@ rescue LoadError
 require File.dirname(__FILE__) + '/../lib/msgpack'
 end
 
-#GC.stress = true
+if ENV["GC_STRESS"]
+	GC.stress = true
+end

ruby/test/test_pack_unpack.rb

@@ -153,7 +153,8 @@ class MessagePackTestPackUnpack < Test::Unit::TestCase
 	end
 
 	it "{1=>1}" do
-		match ({1=>1}), "\x81\x01\x01"
+		obj = {1=>1}
+		match obj, "\x81\x01\x01"
 	end
 
 	it "1.0" do
@@ -165,15 +166,18 @@ class MessagePackTestPackUnpack < Test::Unit::TestCase
 	end
 
 	it "[0, 1, ..., 14]" do
-		match (0..14).to_a, "\x9f\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e"
+		obj = (0..14).to_a
+		match obj, "\x9f\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e"
 	end
 
 	it "[0, 1, ..., 15]" do
-		match (0..15).to_a, "\xdc\x00\x10\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f"
+		obj = (0..15).to_a
+		match obj, "\xdc\x00\x10\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f"
 	end
 
 	it "{}" do
-		match ({}), "\x80"
+		obj = {}
+		match obj, "\x80"
 	end
 
 ## FIXME

ruby/unpack.c

@@ -16,17 +16,13 @@
  *    limitations under the License.
  */
 #include "ruby.h"
+#include "compat.h"
 
 #include "msgpack/unpack_define.h"
 
 static ID s_sysread;
 static ID s_readpartial;
 
-#ifdef HAVE_RUBY_ENCODING_H
-#include "ruby/encoding.h"
-int s_ascii_8bit;
-#endif
-
 struct unpack_buffer {
 	size_t size;
 	size_t free;
@@ -136,6 +132,9 @@ static inline int template_callback_raw(unpack_user* u, const char* b, const cha
 	} else {
 		*o = rb_str_substr(u->source, p - b, l);
 	}
+#ifdef COMPAT_HAVE_ENCODING
+	ENCODING_SET(*o, s_enc_utf8);
+#endif
 	return 0;
 }
 
@@ -156,27 +155,11 @@ static inline int template_callback_raw(unpack_user* u, const char* b, const cha
 		rb_raise(rb_eTypeError, "instance of String needed"); \
 	}
 
-#ifdef RUBY_VM
-#define RERAISE rb_exc_raise(rb_errinfo())
-#else
-#define RERAISE rb_exc_raise(ruby_errinfo)
-#endif
-
-
-#ifdef HAVE_RUBY_ENCODING_H
-static VALUE template_execute_rescue_enc(VALUE data)
-{
-	rb_gc_enable();
-	VALUE* resc = (VALUE*)data;
-	rb_enc_set_index(resc[0], (int)resc[1]);
-	RERAISE;
-}
-#endif
 
 static VALUE template_execute_rescue(VALUE nouse)
 {
 	rb_gc_enable();
-	RERAISE;
+	COMPAT_RERAISE;
 }
 
 static VALUE template_execute_do(VALUE argv)
@@ -203,31 +186,16 @@ static int template_execute_wrap(msgpack_unpack_t* mp,
 		(VALUE)from,
 	};
 
-#ifdef HAVE_RUBY_ENCODING_H
-	int enc_orig = rb_enc_get_index(str);
-	rb_enc_set_index(str, s_ascii_8bit);
-#endif
-
 	// FIXME execute実行中はmp->topが更新されないのでGC markが機能しない
 	rb_gc_disable();
 
 	mp->user.source = str;
 
-#ifdef HAVE_RUBY_ENCODING_H
-	VALUE resc[2] = {str, enc_orig};
-	int ret = (int)rb_rescue(template_execute_do, (VALUE)args,
-			template_execute_rescue_enc, (VALUE)resc);
-#else
 	int ret = (int)rb_rescue(template_execute_do, (VALUE)args,
 			template_execute_rescue, Qnil);
-#endif
 
 	rb_gc_enable();
 
-#ifdef HAVE_RUBY_ENCODING_H
-	rb_enc_set_index(str, enc_orig);
-#endif
-
 	return ret;
 }
 
@@ -746,10 +714,6 @@ void Init_msgpack_unpack(VALUE mMessagePack)
 	s_sysread = rb_intern("sysread");
 	s_readpartial = rb_intern("readpartial");
 
-#ifdef HAVE_RUBY_ENCODING_H
-	s_ascii_8bit = rb_enc_find_index("ASCII-8BIT");
-#endif
-
 	eUnpackError = rb_define_class_under(mMessagePack, "UnpackError", rb_eStandardError);
 	cUnpacker = rb_define_class_under(mMessagePack, "Unpacker", rb_cObject);
 	rb_define_alloc_func(cUnpacker, MessagePack_Unpacker_alloc);