"fast" hash/bless for serialization

1 files changed, 84 insertions, 0 deletions

diff --git a/Data-MultiValued/t/json.t b/Data-MultiValued/t/json.t
new file mode 100644
index 0000000..09664bf
--- /dev/null
+++ b/Data-MultiValued/t/json.t
@@ -0,0 +1,84 @@
+#!perl
+use strict;
+use warnings;
+package Foo;{
+use Moose;
+use Data::MultiValued::AttributeTrait::Tagged;
+use Data::Printer;
+
+has stuff => (
+    is => 'rw',
+    isa => 'Int',
+    traits => ['MultiValued::Tagged'],
+    default => 3,
+    predicate => 'has_stuff',
+    clearer => 'clear_stuff',
+);
+
+has other => (
+    is => 'rw',
+    isa => 'Str',
+    traits => ['MultiValued::Tagged'],
+    predicate => 'has_other',
+    clearer => 'clear_other',
+);
+
+sub new_in_place {
+    my ($class,$hash) = @_;
+
+    my $self = bless $hash,$class;
+
+    p $self;
+
+    for my $attr ($class->meta->get_all_attributes) {
+        if ($attr->does('MultiValued::Tagged')) {
+            $attr->_rebless_slot($self);
+        }
+    }
+    return $self;
+}
+
+sub as_hash {
+    my ($self) = @_;
+
+    my %ret = %$self;
+    for my $attr ($self->meta->get_all_attributes) {
+        if ($attr->does('MultiValued::Tagged')) {
+            my $st = $attr->_as_hash($self);
+            if ($st) {
+                $ret{$attr->full_storage_slot} = $st;
+            }
+            else {
+                delete $ret{$attr->full_storage_slot};
+            }
+        }
+    }
+    return \%ret;
+}
+
+}
+package main;
+use Test::Most 'die';
+use Data::Printer;
+use JSON::XS;
+
+my $opts={tag=>'something'};
+
+my $json = JSON::XS->new->utf8;
+my $obj = Foo->new(other=>'foo');
+$obj->stuff_tagged($opts,1234);
+my $hash = $obj->as_hash;
+note p $hash;
+my $str = $json->encode($hash);
+
+note "rebuilding";
+my $obj2 = Foo->new_in_place($json->decode($str));
+
+note p $obj;
+note p $obj2;
+
+is($obj2->stuff,$obj->stuff,'stuff');
+is($obj2->stuff_tagged($opts),$obj->stuff_tagged($opts),'stuff tagged');
+is($obj2->other,$obj->other,'other');
+
+done_testing;