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;