diff --git a/lib/Data/MessagePack.pm b/lib/Data/MessagePack.pm
index 9eb6f62..58bddf2 100644
--- a/lib/Data/MessagePack.pm
+++ b/lib/Data/MessagePack.pm
@@ -36,7 +36,7 @@ sub new {
return bless \%args, $class;
}
-foreach my $name(qw(canonical prefer_integer utf8)) {
+foreach my $name(qw(canonical prefer_integer utf8 prefer_types_serialiser)) {
my $setter = sub {
my($self, $value) = @_;
$self->{$name} = defined($value) ? $value : 1;
@@ -109,6 +109,25 @@ details.
If you want to get more information about the MessagePack format,
please visit to L.
+=head1 ABOUT BOOLEANS
+
+Because Perl lacks a boolean type, this module follows the following
+conventions:
+
+=over
+
+=item * C and C
+are serialized as boolean true. Likewise, C and
+C are serialized as boolean false.
+
+=item * By default, this module’s C method recreates boolean
+values as either C or
+C. If you enable the
+C flag, then C will use
+C and C instead.
+
+=back
+
=head1 METHODS
=over
@@ -158,6 +177,15 @@ apply C to all the string values.
In other words, this property tell C<$mp> to deal with B.
See L for the meaning of B.
+=item C<< $mp = $mp->prefer_types_serialiser([ $enable ]) >>
+
+=item C<< $enabled = $mp->get_prefer_types_serialiser() >>
+
+If I<$enable> is true (or missing), then the C method will use
+L (rather than C) to represent
+boolean values. This is useful for interoperability with other Perl
+serialization modules like L.
+
=item C<< $packed = $mp->pack($data) >>
=item C<< $packed = $mp->encode($data) >>
diff --git a/lib/Data/MessagePack/PP.pm b/lib/Data/MessagePack/PP.pm
index 5d85c31..f9051e9 100644
--- a/lib/Data/MessagePack/PP.pm
+++ b/lib/Data/MessagePack/PP.pm
@@ -223,7 +223,7 @@ sub _pack {
}
}
- elsif ( ref( $value ) eq 'Data::MessagePack::Boolean' ) {
+ elsif ( ref( $value ) eq 'Data::MessagePack::Boolean' || ref( $value )->isa('Types::Serialiser::Boolean') ) {
return CORE::pack( 'C', ${$value} ? 0xc3 : 0xc2 );
}
@@ -307,9 +307,14 @@ sub _insufficient {
Carp::confess("Insufficient bytes (pos=$p, type=@_)");
}
+my @byte2value;
+
sub unpack :method {
$p = 0; # init
$_utf8 = (ref($_[0]) && $_[0]->{utf8}) || $_utf8;
+
+ local @byte2value[ 0xc3, 0xc2 ] = ( $Types::Serialiser::true, $Types::Serialiser::false ) if $_[0]->{'prefer_types_serialiser'};
+
my $data = _unpack( $_[1] );
if($p < length($_[1])) {
Carp::croak("Data::MessagePack->unpack: extra bytes");
@@ -347,7 +352,6 @@ $typemap[$_] |= $T_BIN for
0xc6, # bin 32
;
-my @byte2value;
foreach my $pair(
[0xc3, true],
[0xc2, false],
diff --git a/t/60_types_serialiser.t b/t/60_types_serialiser.t
new file mode 100644
index 0000000..d5e7712
--- /dev/null
+++ b/t/60_types_serialiser.t
@@ -0,0 +1,24 @@
+use Test::More;
+
+use strict;
+use warnings;
+
+use Data::MessagePack;
+
+if ( eval { require Types::Serialiser } ) {
+ plan tests => 1;
+
+ my $mp = Data::MessagePack->new();
+
+ $mp->prefer_types_serialiser(1);
+
+ my $src = [ Types::Serialiser::false(), Types::Serialiser::true() ];
+
+ my $enc = $mp->pack($src);
+ my $dec = $mp->unpack($enc);
+
+ is_deeply( $dec, $src, 'round-trip' ) or diag explain $dec;
+}
+else {
+ plan skip_all => $@;
+};
diff --git a/t/61_types_serialiser_pp.t b/t/61_types_serialiser_pp.t
new file mode 100644
index 0000000..84fb014
--- /dev/null
+++ b/t/61_types_serialiser_pp.t
@@ -0,0 +1,26 @@
+use Test::More;
+
+use strict;
+use warnings;
+
+BEGIN { $ENV{PERL_ONLY} = 1 }
+
+use Data::MessagePack;
+
+if ( eval { require Types::Serialiser } ) {
+ plan tests => 1;
+
+ my $mp = Data::MessagePack->new();
+
+ $mp->prefer_types_serialiser(1);
+
+ my $src = [ Types::Serialiser::false(), Types::Serialiser::true() ];
+
+ my $enc = $mp->pack($src);
+ my $dec = $mp->unpack($enc);
+
+ is_deeply( $dec, $src, 'round-trip' ) or diag explain $dec;
+}
+else {
+ plan skip_all => $@;
+};
diff --git a/xs-src/MessagePack.xs b/xs-src/MessagePack.xs
index bd092dc..1ed2f40 100644
--- a/xs-src/MessagePack.xs
+++ b/xs-src/MessagePack.xs
@@ -9,6 +9,8 @@ XS(xs_unpack);
XS(xs_unpacker_new);
XS(xs_unpacker_utf8);
XS(xs_unpacker_get_utf8);
+XS(xs_unpacker_prefer_types_serialiser);
+XS(xs_unpacker_get_prefer_types_serialiser);
XS(xs_unpacker_execute);
XS(xs_unpacker_execute_limit);
XS(xs_unpacker_is_finished);
@@ -38,6 +40,9 @@ BOOT:
newXS("Data::MessagePack::Unpacker::data", xs_unpacker_data, __FILE__);
newXS("Data::MessagePack::Unpacker::reset", xs_unpacker_reset, __FILE__);
newXS("Data::MessagePack::Unpacker::DESTROY", xs_unpacker_destroy, __FILE__);
+
+ newXS("Data::MessagePack::Unpacker::prefer_types_serialiser", xs_unpacker_prefer_types_serialiser, __FILE__);
+ newXS("Data::MessagePack::Unpacker::get_prefer_types_serialiser", xs_unpacker_get_prefer_types_serialiser, __FILE__);
}
#ifdef USE_ITHREADS
diff --git a/xs-src/pack.c b/xs-src/pack.c
index f09a747..0b28284 100644
--- a/xs-src/pack.c
+++ b/xs-src/pack.c
@@ -231,8 +231,17 @@ STATIC_INLINE void _msgpack_pack_rv(pTHX_ enc_t *enc, SV* sv, int depth, bool ut
msgpack_pack_false(enc);
}
} else {
- croak ("encountered object '%s', Data::MessagePack doesn't allow the object",
- SvPV_nolen(sv_2mortal(newRV_inc(sv))));
+ HV *stash = gv_stashpv ("Types::Serialiser::Boolean", 1); // TODO: cache?
+ if (stash && (SvSTASH (sv) == stash)) {
+ if (SvIV(sv)) {
+ msgpack_pack_true(enc);
+ } else {
+ msgpack_pack_false(enc);
+ }
+ } else {
+ croak ("encountered object '%s', Data::MessagePack doesn't allow the object",
+ SvPV_nolen(sv_2mortal(newRV_inc(sv))));
+ }
}
} else if (svt == SVt_PVHV) {
HV* hval = (HV*)sv;
diff --git a/xs-src/unpack.c b/xs-src/unpack.c
index 2cefee4..d3f0fcc 100644
--- a/xs-src/unpack.c
+++ b/xs-src/unpack.c
@@ -13,9 +13,10 @@ START_MY_CXT
typedef struct {
bool finished;
bool utf8;
+ bool prefer_types_serialiser;
SV* buffer;
} unpack_user;
-#define UNPACK_USER_INIT { false, false, NULL }
+#define UNPACK_USER_INIT { false, false, false, NULL }
#include "msgpack/unpack_define.h"
@@ -47,8 +48,6 @@ void init_Data__MessagePack_unpack(pTHX_ bool const cloning) {
MY_CXT.msgpack_false = NULL;
}
-
-
/* ---------------------------------------------------------------------- */
/* utility functions */
@@ -74,18 +73,26 @@ load_bool(pTHX_ const char* const name) {
}
static SV*
-get_bool(bool const value) {
+get_bool(unpack_user* u, bool const value) {
dTHX;
dMY_CXT;
if(value) {
if(!MY_CXT.msgpack_true) {
- MY_CXT.msgpack_true = load_bool(aTHX_ "Data::MessagePack::true");
+ if(u->prefer_types_serialiser) {
+ MY_CXT.msgpack_true = load_bool(aTHX_ "Types::Serialiser::true");
+ } else {
+ 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");
+ if(u->prefer_types_serialiser) {
+ MY_CXT.msgpack_false = load_bool(aTHX_ "Types::Serialiser::false");
+ } else {
+ MY_CXT.msgpack_false = load_bool(aTHX_ "Data::MessagePack::false");
+ }
}
return newSVsv(MY_CXT.msgpack_false);
}
@@ -208,15 +215,15 @@ STATIC_INLINE int template_callback_nil(unpack_user* u PERL_UNUSED_DECL, SV** o)
return 0;
}
-STATIC_INLINE int template_callback_true(unpack_user* u PERL_UNUSED_DECL, SV** o)
+STATIC_INLINE int template_callback_true(unpack_user* u, SV** o)
{
- *o = get_bool(true);
+ *o = get_bool(u, true);
return 0;
}
-STATIC_INLINE int template_callback_false(unpack_user* u PERL_UNUSED_DECL, SV** o)
+STATIC_INLINE int template_callback_false(unpack_user* u, SV** o)
{
- *o = get_bool(false);
+ *o = get_bool(u, false);
return 0;
}
@@ -313,6 +320,11 @@ XS(xs_unpack) {
if(svp) {
u.utf8 = SvTRUE(*svp) ? true : false;
}
+
+ svp = hv_fetchs(hv, "prefer_types_serialiser", FALSE);
+ if(svp) {
+ u.prefer_types_serialiser = SvTRUE(*svp) ? true : false;
+ }
}
if (!(items == 2 || items == 3)) {
@@ -372,10 +384,35 @@ XS(xs_unpacker_new) {
XSRETURN(1);
}
+XS(xs_unpacker_prefer_types_serialiser) {
+ dXSARGS;
+ if (!(items == 1 || items == 2)) {
+ Perl_croak(aTHX_ "Usage: $unpacker->prefer_types_serialiser([$bool])");
+ }
+ UNPACKER(ST(0), mp);
+ mp->user.prefer_types_serialiser = (items == 1 || sv_true(ST(1))) ? true : false;
+
+ dMY_CXT;
+ MY_CXT.msgpack_true = NULL;
+ MY_CXT.msgpack_false = NULL;
+
+ XSRETURN(1); // returns $self
+}
+
+XS(xs_unpacker_get_prefer_types_serialiser) {
+ dXSARGS;
+ if (items != 1) {
+ Perl_croak(aTHX_ "Usage: $unpacker->get_prefer_types_serialiser()");
+ }
+ UNPACKER(ST(0), mp);
+ ST(0) = boolSV(mp->user.prefer_types_serialiser);
+ XSRETURN(1);
+}
+
XS(xs_unpacker_utf8) {
dXSARGS;
if (!(items == 1 || items == 2)) {
- Perl_croak(aTHX_ "Usage: $unpacker->utf8([$bool)");
+ Perl_croak(aTHX_ "Usage: $unpacker->utf8([$bool])");
}
UNPACKER(ST(0), mp);
mp->user.utf8 = (items == 1 || sv_true(ST(1))) ? true : false;