perl: add $unpacker->utf8 mode, decoding strings as UTF-8.

This commit is contained in:
Fuji, Goro
2010-10-05 17:10:10 +09:00
parent f2d13cd647
commit a4a04872a3
5 changed files with 86 additions and 5 deletions

View File

@@ -7,6 +7,8 @@
XS(xs_pack);
XS(xs_unpack);
XS(xs_unpacker_new);
XS(xs_unpacker_utf8);
XS(xs_unpacker_get_utf8);
XS(xs_unpacker_execute);
XS(xs_unpacker_execute_limit);
XS(xs_unpacker_is_finished);
@@ -28,6 +30,8 @@ XS(boot_Data__MessagePack) {
newXS("Data::MessagePack::unpack", xs_unpack, __FILE__);
newXS("Data::MessagePack::Unpacker::new", xs_unpacker_new, __FILE__);
newXS("Data::MessagePack::Unpacker::utf8", xs_unpacker_utf8, __FILE__);
newXS("Data::MessagePack::Unpacker::get_utf8", xs_unpacker_get_utf8, __FILE__);
newXS("Data::MessagePack::Unpacker::execute", xs_unpacker_execute, __FILE__);
newXS("Data::MessagePack::Unpacker::execute_limit", xs_unpacker_execute_limit, __FILE__);
newXS("Data::MessagePack::Unpacker::is_finished", xs_unpacker_is_finished, __FILE__);

View File

@@ -13,6 +13,7 @@ START_MY_CXT
typedef struct {
bool finished;
bool incremented;
bool utf8;
} unpack_user;
#include "msgpack/unpack_define.h"
@@ -237,6 +238,9 @@ STATIC_INLINE int template_callback_raw(unpack_user* u PERL_UNUSED_DECL, const c
dTHX;
/* newSVpvn(p, l) returns an undef if p == NULL */
*o = ((l==0) ? newSVpvs("") : newSVpvn(p, l));
if(u->utf8) {
sv_utf8_decode(*o);
}
return 0;
}
@@ -276,7 +280,7 @@ XS(xs_unpack) {
msgpack_unpack_t mp;
template_init(&mp);
unpack_user const u = {false, false};
unpack_user const u = {false, false, false};
mp.user = u;
size_t from = 0;
@@ -303,7 +307,7 @@ XS(xs_unpack) {
STATIC_INLINE void _reset(SV* const self) {
dTHX;
unpack_user const u = {false, false};
unpack_user const u = {false, false, false};
UNPACKER(self, mp);
template_init(mp);
@@ -328,6 +332,26 @@ XS(xs_unpacker_new) {
XSRETURN(1);
}
XS(xs_unpacker_utf8) {
dXSARGS;
if (!(items == 1 || items == 2)) {
Perl_croak(aTHX_ "Usage: $unpacker->utf8([$bool)");
}
UNPACKER(ST(0), mp);
mp->user.utf8 = (items == 1 || sv_true(ST(1))) ? true : false;
XSRETURN(1); // returns $self
}
XS(xs_unpacker_get_utf8) {
dXSARGS;
if (items != 1) {
Perl_croak(aTHX_ "Usage: $unpacker->get_utf8()");
}
UNPACKER(ST(0), mp);
ST(0) = boolSV(mp->user.utf8);
XSRETURN(1);
}
STATIC_INLINE size_t
_execute_impl(SV* const self, SV* const data, UV const offset, UV const limit) {
dTHX;