added perl support

2025-10-13 14:45:38 +02:00 · 2009-04-15 12:55:41 +09:00
parent b8cc8b72bd
commit 8c62d93bca
16 changed files with 7734 additions and 0 deletions
--- a/perl/pack.c
+++ b/perl/pack.c
@@ -0,0 +1,122 @@
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#include "ppport.h"
+#ifdef __cplusplus
+};
+#endif
+
+#include "msgpack/pack_define.h"
+
+#define msgpack_pack_inline_func(name) \
+    static inline void msgpack_pack ## name
+
+#define msgpack_pack_inline_func_cint(name) \
+    static inline void msgpack_pack ## name
+
+#define msgpack_pack_user SV*
+
+#define msgpack_pack_append_buffer(user, buf, len) \
+    sv_catpvn(user, (const char*)(buf), len);
+
+#include "msgpack/pack_template.h"
+
+#define _PACK_WRAPPER(t) msgpack_pack_##t
+#define PACK_WRAPPER(t) _PACK_WRAPPER(t)
+
+// move to pack.c
+static void _msgpack_pack_sv(SV* buf, SV* val) {
+    if (val==NULL) {
+        msgpack_pack_nil(buf);
+        return;
+    }
+
+    switch (SvTYPE(val)) {
+    case SVt_NULL:
+        msgpack_pack_nil(buf);
+        break;
+    case SVt_IV:
+        if (SvIOK_UV(val)) {
+            msgpack_pack_uint32(buf, SvUV(val));
+        } else {
+            PACK_WRAPPER(IVTYPE)(buf, SvIV(val));
+        }
+        break;
+    case SVt_PVNV:
+        {
+            STRLEN len = 0;
+            char *pv = SvPV(val, len);
+            if (len == 1 && *pv == '1') {
+                msgpack_pack_true(buf);
+            } else if (len == 0 && *pv==0) {
+                msgpack_pack_false(buf);
+            } else {
+                msgpack_pack_nil(buf);
+            }
+        }
+        break;
+    case SVt_PV:
+        {
+            STRLEN len;
+            char * cval = SvPV(val, len);
+            msgpack_pack_raw(buf, len);
+            msgpack_pack_raw_body(buf, cval, len);
+        }
+        break;
+    case SVt_NV:
+        PACK_WRAPPER(NVTYPE)(buf, SvNV(val));
+        break;
+    case SVt_PVAV:
+        {
+            AV* ary = (AV*)val;
+            int len = av_len(ary) + 1;
+            int i;
+            msgpack_pack_array(buf, len);
+            for (i=0; i<len; i++) {
+                SV** svp = av_fetch(ary, i, 0);
+                if (svp) {
+                    _msgpack_pack_sv(buf, *svp);
+                } else {
+                    msgpack_pack_nil(buf);
+                }
+            }
+        }
+        break;
+    case SVt_PVHV:
+        {
+            HV* hval = (HV*)val;
+            int count = hv_iterinit(hval);
+            HE* he;
+
+            msgpack_pack_map(buf, count);
+
+            while (he = hv_iternext(hval)) {
+                _msgpack_pack_sv(buf, hv_iterkeysv(he));
+                _msgpack_pack_sv(buf, HeVAL(he));
+            }
+        }
+        break;
+    case SVt_RV:
+        _msgpack_pack_sv(buf, SvRV(val));
+        break;
+    default:
+        sv_dump(val);
+        Perl_croak(aTHX_ "msgpack for perl doesn't supported this type: %d\n", SvTYPE(val));
+    }
+}
+
+XS(xs_pack) {
+    dXSARGS;
+    PERL_UNUSED_VAR(items);
+
+    SV* buf = newSVpv("", 0);
+    SV* val = ST(1);
+
+    _msgpack_pack_sv(buf, val);
+
+    ST(0) = buf;
+    XSRETURN(1);
+}