summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Data-MultiValued/lib/Data/MultiValued/AttributeTrait/Tagged.pm19
-rw-r--r--Data-MultiValued/lib/Data/MultiValued/Tags.pm13
-rw-r--r--Data-MultiValued/t/json.t84
3 files changed, 116 insertions, 0 deletions
diff --git a/Data-MultiValued/lib/Data/MultiValued/AttributeTrait/Tagged.pm b/Data-MultiValued/lib/Data/MultiValued/AttributeTrait/Tagged.pm
index 7839e2d..2a45506 100644
--- a/Data-MultiValued/lib/Data/MultiValued/AttributeTrait/Tagged.pm
+++ b/Data-MultiValued/lib/Data/MultiValued/AttributeTrait/Tagged.pm
@@ -187,6 +187,25 @@ sub get_tagged_write_method {
return $self->get_write_method . '_tagged';
}
+sub _rebless_slot {
+ my ($self,$instance) = @_;
+
+ my $st = $self->get_full_storage($instance);
+ return unless $st;
+
+ bless $st, 'Data::MultiValued::Tags';
+ $st->_rebless_storage;
+}
+
+sub _as_hash {
+ my ($self,$instance) = @_;
+
+ my $st = $self->get_full_storage($instance);
+ return unless $st;
+
+ return $st->_as_hash;
+}
+
package Moose::Meta::Attribute::Custom::Trait::MultiValued::Tagged;{
sub register_implementation { 'Data::MultiValued::AttributeTrait::Tagged' }
}
diff --git a/Data-MultiValued/lib/Data/MultiValued/Tags.pm b/Data-MultiValued/lib/Data/MultiValued/Tags.pm
index 0325f61..2262d8a 100644
--- a/Data-MultiValued/lib/Data/MultiValued/Tags.pm
+++ b/Data-MultiValued/lib/Data/MultiValued/Tags.pm
@@ -19,6 +19,19 @@ sub _build__storage {
Data::MultiValued::TagContainer->new();
}
+sub _rebless_storage {
+ my ($self) = @_;
+
+ bless $self->{_storage},'Data::MultiValued::TagContainer';
+}
+
+sub _as_hash {
+ my ($self) = @_;
+
+ my %ret = %{$self->_storage};
+ return {_storage=>\%ret};
+}
+
sub set {
my ($self,%args) = validated_hash(
\@_,
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;