diff --git a/perl/lib/Data/MessagePack.pm b/perl/lib/Data/MessagePack.pm index ece00505..b1e0174d 100644 --- a/perl/lib/Data/MessagePack.pm +++ b/perl/lib/Data/MessagePack.pm @@ -6,22 +6,21 @@ use 5.008001; our $VERSION = '0.23'; our $PreferInteger = 0; -{ - package - Data::MessagePack::Boolean; - use overload - 'bool' => sub { ${ $_[0] } }, - '0+' => sub { ${ $_[0] } }, - '""' => sub { ${ $_[0] } ? 'true' : 'false' }, - - fallback => 1, - ; +sub true () { + require Data::MessagePack::Boolean; + no warnings 'once', 'redefine'; + my $t = $Data::MessagePack::Boolean::true; + *true = sub (){ $t }; + return $t; } -our $true = do { bless \(my $dummy = 1), "Data::MessagePack::Boolean" }; -our $false = do { bless \(my $dummy = 0), "Data::MessagePack::Boolean" }; -sub true () { $true } -sub false () { $false } +sub false () { + require Data::MessagePack::Boolean; + no warnings 'once', 'redefine'; + my $f = $Data::MessagePack::Boolean::false; + *false = sub (){ $f }; + return $f; +} if ( !__PACKAGE__->can('pack') ) { # this idea comes from Text::Xslate my $backend = $ENV{ PERL_DATA_MESSAGEPACK } || ''; diff --git a/perl/lib/Data/MessagePack/Boolean.pm b/perl/lib/Data/MessagePack/Boolean.pm new file mode 100755 index 00000000..2bb3ecad --- /dev/null +++ b/perl/lib/Data/MessagePack/Boolean.pm @@ -0,0 +1,14 @@ +package Data::MessagePack::Boolean; +use strict; +use overload + 'bool' => sub { ${ $_[0] } }, + '0+' => sub { ${ $_[0] } }, + '""' => sub { ${ $_[0] } ? 'true' : 'false' }, + + fallback => 1, +; + +our $true = do { bless \(my $dummy = 1) }; +our $false = do { bless \(my $dummy = 0) }; + +1; diff --git a/perl/xs-src/MessagePack.c b/perl/xs-src/MessagePack.c index aba8ef91..69337f41 100644 --- a/perl/xs-src/MessagePack.c +++ b/perl/xs-src/MessagePack.c @@ -1,5 +1,9 @@ #include "xshelper.h" +#ifndef __cplusplus +#include +#endif + XS(xs_pack); XS(xs_unpack); XS(xs_unpacker_new); @@ -10,13 +14,15 @@ XS(xs_unpacker_data); XS(xs_unpacker_reset); XS(xs_unpacker_destroy); -void boot_Data__MessagePack_pack(void); +void init_Data__MessagePack_pack(pTHX_ bool const cloning); +void init_Data__MessagePack_unpack(pTHX_ bool const cloning); XS(boot_Data__MessagePack) { dXSARGS; PERL_UNUSED_VAR(items); - boot_Data__MessagePack_pack(); + init_Data__MessagePack_pack(aTHX_ false); + init_Data__MessagePack_unpack(aTHX_ false); newXS("Data::MessagePack::pack", xs_pack, __FILE__); newXS("Data::MessagePack::unpack", xs_unpack, __FILE__); diff --git a/perl/xs-src/pack.c b/perl/xs-src/pack.c index 9a58ed05..862808eb 100644 --- a/perl/xs-src/pack.c +++ b/perl/xs-src/pack.c @@ -83,8 +83,7 @@ MGVTBL pref_int_vtbl = { #endif }; -void boot_Data__MessagePack_pack(void) { - dTHX; +void init_Data__MessagePack_pack(pTHX_ bool const cloning) { SV* var = get_sv("Data::MessagePack::PreferInteger", 0); sv_magicext(var, NULL, PERL_MAGIC_ext, &pref_int_vtbl, NULL, 0); SvSETMAGIC(var); diff --git a/perl/xs-src/unpack.c b/perl/xs-src/unpack.c index da985e32..6ebb48c2 100644 --- a/perl/xs-src/unpack.c +++ b/perl/xs-src/unpack.c @@ -2,6 +2,13 @@ #define NEED_sv_2pv_flags #include "xshelper.h" +#define MY_CXT_KEY "Data::MessagePack::_unpack_guts" XS_VERSION +typedef struct { + SV* msgpack_true; + SV* msgpack_false; +} my_cxt_t; +START_MY_CXT + typedef struct { bool finished; bool incremented; @@ -22,13 +29,52 @@ typedef struct { #define msgpack_unpack_user unpack_user +void init_Data__MessagePack_unpack(pTHX_ bool const cloning) { + if(!cloning) { + MY_CXT_INIT; + MY_CXT.msgpack_true = NULL; + MY_CXT.msgpack_false = NULL; + } + else { + MY_CXT_CLONE; + MY_CXT.msgpack_true = NULL; + MY_CXT.msgpack_false = NULL; + } +} + + + /* ---------------------------------------------------------------------- */ /* utility functions */ -STATIC_INLINE SV * -get_bool (const char* const name) { +static SV* +load_bool(pTHX_ const char* const name) { + CV* const cv = get_cv(name, GV_ADD); + dSP; + PUSHMARK(SP); + call_sv((SV*)cv, G_SCALAR); + SPAGAIN; + SV* const sv = newSVsv(POPs); + PUTBACK; + return sv; +} + +static SV* +get_bool(bool const value) { dTHX; - return newSVsv(get_sv( name, GV_ADD )); + dMY_CXT; + if(value) { + if(!MY_CXT.msgpack_true) { + MY_CXT.msgpack_true = load_bool(aTHX_ "Data::MessagePack::true"); + } + return newSVsv(MY_CXT.msgpack_true); + } + else { + if(!MY_CXT.msgpack_false) { + MY_CXT.msgpack_false = load_bool(aTHX_ "Data::MessagePack::false"); + } + return newSVsv(MY_CXT.msgpack_false); + } } /* ---------------------------------------------------------------------- */ @@ -127,15 +173,13 @@ STATIC_INLINE int template_callback_nil(unpack_user* u PERL_UNUSED_DECL, SV** o) STATIC_INLINE int template_callback_true(unpack_user* u PERL_UNUSED_DECL, SV** o) { - dTHX; - *o = get_bool("Data::MessagePack::true"); + *o = get_bool(true); return 0; } STATIC_INLINE int template_callback_false(unpack_user* u PERL_UNUSED_DECL, SV** o) { - dTHX; - *o = get_bool("Data::MessagePack::false"); + *o = get_bool(false); return 0; }