diff options
-rw-r--r-- | Data-MultiValued/lib/Data/MultiValued/AttributeTrait/Tagged.pm | 19 | ||||
-rw-r--r-- | Data-MultiValued/lib/Data/MultiValued/Tags.pm | 13 | ||||
-rw-r--r-- | Data-MultiValued/t/json.t | 84 |
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; |