lib/Data/MultiValued/UglySerializationHelperRole.pm


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144

package Data::MultiValued::UglySerializationHelperRole; 
use Moose::Role;
use namespace::autoclean;
 
# ABSTRACT: only use this if you know what you're doing 
 
=head1 SYNOPSIS
 
 package My::Class;
 use Moose;
 use Data::MultiValued::AttributeTrait::Tags;
 
 with 'Data::MultiValued::UglySerializationHelperRole';
 
 has tt => (
    is => 'rw',
    isa => 'Int',
    traits => ['MultiValued::Tags'],
    default => 3,
    predicate => 'has_tt',
    clearer => 'clear_tt',
 );
 
Later:
 
  my $json = JSON::XS->new->utf8;
  my $obj = My::Class->new(rr=>'foo');
 
  my $str = $json->encode($obj->as_hash);
 
  my $obj2 = My::Class->new_in_place($json->decode($str));
 
  # $obj and $obj2 have the same contents
 
=head1 DESCRIPTION
 
This is an ugly hack. It pokes inside the internals of your objects,
and will break if you're not careful. It assumes that your instances
are hashref-based. It mostly assumes that you're not storing blessed
refs inside the multi-value attributes. It goes to these lengths to
give a decent serialisation performance, without lots of unnecessary
copies. Oh, and on de-serialise it will skip all type constraint
checking and bypass the accessors, so it may well give you an unusable
object.
 
=method C<new_in_place>
 
  my $obj = My::Class->new_in_place($hashref);
 
Directly C<bless>es the hashref into the class, then calls
C<_rebless_slot> on any multi-value attribute.
 
This is very dangerous, don't try this at home without the supervision
of an adult.
 
=cut
 
sub new_in_place {
    my ($class,$hash) = @_;
 
    my $self = bless $hash,$class;
 
    for my $attr (@{$class->_dmv_multi_attrs}) {
        $attr->_rebless_slot($self);
    }
    return $self;
}
 
=method C<as_hash>
 
  my $hashref = $obj->as_hash;
 
Performs a shallow copy of the object's hash, then replaces the values
of all the multi-value slots with the results of calling C<_as_hash>
on the corresponding multi-value attribute.
 
This is very dangerous, don't try this at home without the supervision
of an adult.
 
=cut
 
sub as_hash {
    my ($self) = @_;
 
    my %ret = %$self;
    for my $attr (@{$self->_dmv_multi_attrs}) {
        my $st = $attr->_as_hash($self);
        if ($st) {
            $ret{$attr->full_storage_slot} = $st;
        }
        else {
            delete $ret{$attr->full_storage_slot};
        }
    }
    return \%ret;
}
 
{
my (
    %all_attrs_for_class,
    %tagged_attrs_for_class,
    %ranged_attrs_for_class,
    %multi_attrs_for_class,
);
 
sub _dmv_all_attrs {
    my ($class) = @_;$class=ref($class)||$class;
 
    return $all_attrs_for_class{$class} //= [$class->meta->get_all_attributes];
}
sub _dmv_tagged_attrs {
    my ($class) = @_;$class=ref($class)||$class;
 
    return $tagged_attrs_for_class{$class} //=
        [ grep { $_->does('Data::MultiValued::AttributeTrait::Tags') }
              @{$class->_dmv_all_attrs} ];
}
sub _dmv_ranged_attrs {
    my ($class) = @_;$class=ref($class)||$class;
 
    return $ranged_attrs_for_class{$class} //=
        [ grep { $_->does('Data::MultiValued::AttributeTrait::Ranges') }
              @{$class->_dmv_all_attrs} ];
}
sub _dmv_multi_attrs {
    my ($class) = @_;$class=ref($class)||$class;
 
    return $multi_attrs_for_class{$class} //=
        [ grep { $_->does('Data::MultiValued::AttributeTrait') }
              @{$class->_dmv_all_attrs} ];
}
}
 
=head1 FINAL WARNING
 
 my $obj_clone = My::Class->new_in_place($obj->as_hash);
 
This will create a shallow clone. Most internals will be
shared. Things may break. Just don't do it, C<dclone> the hashref, or
do something equivalent (as in the synopsis), instead.
 
=cut
 
1;