| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
# |
|
2
|
|
|
|
|
|
|
# This file is part of MooseX-Attribute-Deflator |
|
3
|
|
|
|
|
|
|
# |
|
4
|
|
|
|
|
|
|
# This software is Copyright (c) 2012 by Moritz Onken. |
|
5
|
|
|
|
|
|
|
# |
|
6
|
|
|
|
|
|
|
# This is free software, licensed under: |
|
7
|
|
|
|
|
|
|
# |
|
8
|
|
|
|
|
|
|
# The (three-clause) BSD License |
|
9
|
|
|
|
|
|
|
# |
|
10
|
|
|
|
|
|
|
package MooseX::Attribute::Deflator; |
|
11
|
|
|
|
|
|
|
{ |
|
12
|
|
|
|
|
|
|
$MooseX::Attribute::Deflator::VERSION = '2.1.11'; # TRIAL |
|
13
|
|
|
|
|
|
|
} |
|
14
|
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
# ABSTRACT: Deflate and inflate Moose attribute values |
|
16
|
|
|
|
|
|
|
|
|
17
|
8
|
|
|
8
|
|
1514772
|
use strict; |
|
|
8
|
|
|
|
|
11
|
|
|
|
8
|
|
|
|
|
208
|
|
|
18
|
8
|
|
|
8
|
|
26
|
use warnings; |
|
|
8
|
|
|
|
|
10
|
|
|
|
8
|
|
|
|
|
213
|
|
|
19
|
8
|
|
|
8
|
|
28
|
use Moose::Exporter; |
|
|
8
|
|
|
|
|
10
|
|
|
|
8
|
|
|
|
|
64
|
|
|
20
|
8
|
|
|
8
|
|
3034
|
use MooseX::Attribute::Deflator::Registry; |
|
|
8
|
|
|
|
|
26
|
|
|
|
8
|
|
|
|
|
328
|
|
|
21
|
8
|
|
|
8
|
|
52
|
use Moose::Util qw(); |
|
|
8
|
|
|
|
|
14
|
|
|
|
8
|
|
|
|
|
2264
|
|
|
22
|
|
|
|
|
|
|
|
|
23
|
114
|
|
|
114
|
0
|
18919
|
sub via (&) { $_[0] } |
|
24
|
108
|
|
|
108
|
0
|
200
|
sub inline_as (&) { $_[0] } |
|
25
|
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
Moose::Exporter->setup_import_methods( |
|
27
|
|
|
|
|
|
|
as_is => [ qw( deflate inflate via inline_as ) ], ); |
|
28
|
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
my $REGISTRY = MooseX::Attribute::Deflator::Registry->new; |
|
30
|
|
|
|
|
|
|
|
|
31
|
8
|
|
|
8
|
0
|
19
|
sub get_registry {$REGISTRY} |
|
32
|
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
sub deflate { |
|
34
|
58
|
|
|
58
|
1
|
74
|
my $types = shift; |
|
35
|
58
|
100
|
|
|
|
166
|
$types = [$types] unless ( ref $types eq 'ARRAY' ); |
|
36
|
58
|
|
|
|
|
194
|
$REGISTRY->add_deflator( $_, @_ ) for (@$types); |
|
37
|
|
|
|
|
|
|
} |
|
38
|
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
sub inflate { |
|
40
|
56
|
|
|
56
|
1
|
61
|
my $types = shift; |
|
41
|
56
|
100
|
|
|
|
140
|
$types = [$types] unless ( ref $types eq 'ARRAY' ); |
|
42
|
56
|
|
|
|
|
170
|
$REGISTRY->add_inflator( $_, @_ ) for (@$types); |
|
43
|
|
|
|
|
|
|
} |
|
44
|
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
deflate 'Item', via {$_}, inline_as {'$value'}; |
|
46
|
|
|
|
|
|
|
inflate 'Item', via {$_}, inline_as {'$value'}; |
|
47
|
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
Moose::Util::_create_alias( 'Attribute', 'Deflator', 1, |
|
49
|
|
|
|
|
|
|
'MooseX::Attribute::Deflator::Meta::Role::Attribute' ); |
|
50
|
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
1; |
|
52
|
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
=pod |
|
56
|
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
=head1 NAME |
|
58
|
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
MooseX::Attribute::Deflator - Deflate and inflate Moose attribute values |
|
60
|
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
=head1 VERSION |
|
62
|
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
version 2.1.11 |
|
64
|
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
=head1 SYNOPSIS |
|
66
|
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
package MySynopsis; |
|
68
|
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
use Moose; |
|
70
|
|
|
|
|
|
|
use DateTime; |
|
71
|
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
use MooseX::Attribute::Deflator; |
|
73
|
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
deflate 'DateTime', |
|
75
|
|
|
|
|
|
|
via { $_->epoch }, |
|
76
|
|
|
|
|
|
|
inline_as { '$value->epoch' }; # optional |
|
77
|
|
|
|
|
|
|
inflate 'DateTime', |
|
78
|
|
|
|
|
|
|
via { DateTime->from_epoch( epoch => $_ ) }, |
|
79
|
|
|
|
|
|
|
inline_as { 'DateTime->from_epoch( epoch => $value )' }; # optional |
|
80
|
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
no MooseX::Attribute::Deflator; |
|
82
|
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
# import default deflators and inflators for Moose types |
|
84
|
|
|
|
|
|
|
use MooseX::Attribute::Deflator::Moose; |
|
85
|
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
has now => ( is => 'rw', |
|
87
|
|
|
|
|
|
|
isa => 'DateTime', |
|
88
|
|
|
|
|
|
|
default => sub { DateTime->now }, |
|
89
|
|
|
|
|
|
|
traits => ['Deflator'] ); |
|
90
|
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
has hash => ( is => 'rw', |
|
92
|
|
|
|
|
|
|
isa => 'HashRef', |
|
93
|
|
|
|
|
|
|
default => sub { { foo => 'bar' } }, |
|
94
|
|
|
|
|
|
|
traits => ['Deflator'] ); |
|
95
|
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
package main; |
|
97
|
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
use Test::More; |
|
99
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
my $obj = MySynopsis->new; |
|
101
|
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
{ |
|
103
|
|
|
|
|
|
|
my $attr = $obj->meta->get_attribute('now'); |
|
104
|
|
|
|
|
|
|
my $deflated = $attr->deflate($obj); |
|
105
|
|
|
|
|
|
|
like($deflated, qr/^\d+$/); |
|
106
|
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
my $inflated = $attr->inflate($obj, $deflated); |
|
108
|
|
|
|
|
|
|
isa_ok($inflated, 'DateTime'); |
|
109
|
|
|
|
|
|
|
} |
|
110
|
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
{ |
|
112
|
|
|
|
|
|
|
my $attr = $obj->meta->get_attribute('hash'); |
|
113
|
|
|
|
|
|
|
my $deflated = $attr->deflate($obj); |
|
114
|
|
|
|
|
|
|
is($deflated, '{"foo":"bar"}'); |
|
115
|
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
my $inflated = $attr->inflate($obj, $deflated); |
|
117
|
|
|
|
|
|
|
is_deeply($inflated, {foo => 'bar'}) |
|
118
|
|
|
|
|
|
|
} |
|
119
|
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
done_testing; |
|
121
|
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
123
|
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
This module consists of a a registry (L<MooseX::Attribute::Deflator::Registry>) an attribute trait L<MooseX::Attribute::Deflator::Meta::Role::Attribute> and predefined deflators and inflators |
|
125
|
|
|
|
|
|
|
for Moose L<MooseX::Attribute::Deflator::Moose> and MooseX::Types::Strutured L<MooseX::Attribute::Deflator::Structured>. |
|
126
|
|
|
|
|
|
|
This class is just sugar to set the inflators and deflators. |
|
127
|
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
You can deflate to whatever data structure you want. Loading L<MooseX::Attribute::Deflator::Moose> |
|
129
|
|
|
|
|
|
|
will cause HashRefs and ArrayRefs to be encoded as JSON strings. However, you can simply overwrite |
|
130
|
|
|
|
|
|
|
those deflators (and inflators) to deflate to something different like L<Storable>. |
|
131
|
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
Unlike C<coerce>, you don't need to create a deflator and inflator for every type. Instead this module |
|
133
|
|
|
|
|
|
|
will bubble up the type hierarchy and use the first deflator or inflator it finds. |
|
134
|
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
This comes at a cost: B<Union types are not supported>. |
|
136
|
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
For extra speed, inflators and deflators can be inlined. All in/deflators that come with this |
|
138
|
|
|
|
|
|
|
module have an inlined version as well. Whenever you implment custom type in/deflators, you |
|
139
|
|
|
|
|
|
|
should consider writing the inlining code as well. The performance boost is immense. You |
|
140
|
|
|
|
|
|
|
can check whether an deflator has been inlined by calling: |
|
141
|
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
$attr->is_deflator_inlined; |
|
143
|
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
B<< Inlining works in Moose >= 1.9 only. >> |
|
145
|
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
=head1 FUNCTIONS |
|
147
|
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
=over 4 |
|
149
|
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
=item B<< deflate >> |
|
151
|
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
=item B<< inflate >> |
|
153
|
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
deflate 'DateTime', |
|
155
|
|
|
|
|
|
|
via { $_->epoch }, |
|
156
|
|
|
|
|
|
|
inline_as { '$value->epoch' }; # optional |
|
157
|
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
inflate 'DateTime', |
|
159
|
|
|
|
|
|
|
via { DateTime->from_epoch( epoch => $_ ) }, |
|
160
|
|
|
|
|
|
|
inline_as { 'DateTime->from_epoch( epoch => $value )' }; # optional |
|
161
|
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
Defines a deflator or inflator for a given type constraint. This can also be |
|
163
|
|
|
|
|
|
|
a type constraint defined via L<MooseX::Types> and parameterized types. |
|
164
|
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
The function supplied to C<via> is called with C<$_> set to the attribute's value |
|
166
|
|
|
|
|
|
|
and with the following arguments: |
|
167
|
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
=over 8 |
|
169
|
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
=item C<$attr> |
|
171
|
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
The attribute on which this deflator/inflator has been called |
|
173
|
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
=item C<$constraint> |
|
175
|
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
The type constraint attached to the attribute |
|
177
|
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
=item C<< $deflate/$inflate >> |
|
179
|
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
A code reference to the deflate or inflate function. E.g. this is handy if you want |
|
181
|
|
|
|
|
|
|
to call the type's parent's parent inflate or deflate method: |
|
182
|
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
deflate 'MySubSubType', via { |
|
184
|
|
|
|
|
|
|
my ($attr, $constraint, $deflate) = @_; |
|
185
|
|
|
|
|
|
|
return $deflate->($_, $constraint->parent->parent); |
|
186
|
|
|
|
|
|
|
}; |
|
187
|
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
=item C<$instance> |
|
189
|
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
The object instance on which this deflator/inflator has been called. |
|
191
|
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
=item C<@_> |
|
193
|
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
Any other arguments added to L<MooseX::Attribute::Deflator::Meta::Role::Attribute/inflate> |
|
195
|
|
|
|
|
|
|
or L<MooseX::Attribute::Deflator::Meta::Role::Attribute/deflate>. |
|
196
|
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
=back |
|
198
|
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
For C<inline>, the parameters are handled a bit differently. The code generating subroutine |
|
200
|
|
|
|
|
|
|
is called with the following parameters: |
|
201
|
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
=over 8 |
|
203
|
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
=item C<$constraint> |
|
205
|
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
The type constraint attached to the attribute. |
|
207
|
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
=item C<$attr> |
|
209
|
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
The attribute on which this deflator/inflator has been called. |
|
211
|
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
=item C<$registry> |
|
213
|
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
my $parent = $registry->($constraint->parent); |
|
215
|
|
|
|
|
|
|
my $code = $parent->($constraint->parent, $attr, $registry, @_); |
|
216
|
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
To get the code generator of a type constraint, call this function. |
|
218
|
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
=back |
|
220
|
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
The C<inline> function is expected to return a string. The generated code |
|
222
|
|
|
|
|
|
|
has access to a number of variables: |
|
223
|
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
=over 8 |
|
225
|
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
=item C<$value> |
|
227
|
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
Most important, the value that should be de- or inflated is stored in C<$value>. |
|
229
|
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
=item C<$type_constraint> |
|
231
|
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
=back |
|
233
|
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
For some more advanced examples, have a look at the source of |
|
235
|
|
|
|
|
|
|
L<MooseX::Attribute::Deflator::Moose> and L<MooseX::Attribute::Deflator::Structured>. |
|
236
|
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
=back |
|
238
|
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
=head1 PERFORMANCE |
|
240
|
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
The overhead for having custom deflators or inflators per attribute is minimal. |
|
242
|
|
|
|
|
|
|
The file C<benchmark.pl> tests three ways of deflating the value of a HashRef attribute |
|
243
|
|
|
|
|
|
|
to a json encoded string (using L<JSON>). |
|
244
|
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
my $obj = MyBenchmark->new( hashref => { foo => 'bar' } ); |
|
246
|
|
|
|
|
|
|
my $attr = MyBenchmark->meta->get_attribute('hashref'); |
|
247
|
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
=over |
|
249
|
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
=item deflate |
|
251
|
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
$attr->deflate($obj); |
|
253
|
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
Using the deflate attribute method, supplied by this module. |
|
255
|
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
=item accessor |
|
257
|
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
JSON::encode_json($obj->hashref); |
|
259
|
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
If the attribute comes with an accessor, you can use this |
|
261
|
|
|
|
|
|
|
method, to deflate its value. However, you need to know the |
|
262
|
|
|
|
|
|
|
name of the accessor in order to use this method. |
|
263
|
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
=item get_value |
|
265
|
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
JSON::encode_json($attr->get_value($obj, 'hashref')); |
|
267
|
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
This solves the mentioned problem with not knowing the |
|
269
|
|
|
|
|
|
|
accessor name. |
|
270
|
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
=back |
|
272
|
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
The results clearly states that using the C<deflate> method |
|
274
|
|
|
|
|
|
|
adds only minimal overhead to deflating the attribute |
|
275
|
|
|
|
|
|
|
value manually. |
|
276
|
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
Rate get_value deflate accessor |
|
278
|
|
|
|
|
|
|
get_value 69832/s -- -87% -88% |
|
279
|
|
|
|
|
|
|
deflate 543478/s 678% -- -4% |
|
280
|
|
|
|
|
|
|
accessor 564972/s 709% 4% -- |
|
281
|
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
=head1 AUTHOR |
|
283
|
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
Moritz Onken |
|
285
|
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
|
287
|
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
This software is Copyright (c) 2012 by Moritz Onken. |
|
289
|
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
This is free software, licensed under: |
|
291
|
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
The (three-clause) BSD License |
|
293
|
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
=cut |
|
295
|
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
__END__ |
|
298
|
|
|
|
|
|
|
|