line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Data::MultiValued::TagsAndRanges; |
2
|
|
|
|
|
|
|
{ |
3
|
|
|
|
|
|
|
$Data::MultiValued::TagsAndRanges::VERSION = '0.0.1_4'; |
4
|
|
|
|
|
|
|
} |
5
|
|
|
|
|
|
|
{ |
6
|
|
|
|
|
|
|
$Data::MultiValued::TagsAndRanges::DIST = 'Data-MultiValued'; |
7
|
|
|
|
|
|
|
} |
8
|
7
|
|
|
7
|
|
188903
|
use Moose; |
|
7
|
|
|
|
|
624361
|
|
|
7
|
|
|
|
|
72
|
|
9
|
7
|
|
|
7
|
|
62000
|
use namespace::autoclean; |
|
7
|
|
|
|
|
8202
|
|
|
7
|
|
|
|
|
83
|
|
10
|
7
|
|
|
7
|
|
1705
|
use MooseX::Params::Validate; |
|
7
|
|
|
|
|
13287
|
|
|
7
|
|
|
|
|
75
|
|
11
|
7
|
|
|
7
|
|
4720
|
use Moose::Util::TypeConstraints; |
|
7
|
|
|
|
|
47
|
|
|
7
|
|
|
|
|
82
|
|
12
|
7
|
|
|
7
|
|
20573
|
use MooseX::Types::Moose qw(Num Str Undef Any); |
|
7
|
|
|
|
|
71371
|
|
|
7
|
|
|
|
|
88
|
|
13
|
7
|
|
|
7
|
|
61902
|
use Data::MultiValued::Exceptions; |
|
7
|
|
|
|
|
22
|
|
|
7
|
|
|
|
|
199
|
|
14
|
7
|
|
|
7
|
|
6336
|
use Data::MultiValued::TagContainerForRanges; |
|
7
|
|
|
|
|
34
|
|
|
7
|
|
|
|
|
4639
|
|
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
# ABSTRACT: Handle values with tags and validity ranges |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
has _storage => ( |
20
|
|
|
|
|
|
|
is => 'rw', |
21
|
|
|
|
|
|
|
isa => class_type('Data::MultiValued::TagContainerForRanges'), |
22
|
|
|
|
|
|
|
init_arg => undef, |
23
|
|
|
|
|
|
|
lazy_build => 1, |
24
|
|
|
|
|
|
|
); |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
sub _build__storage { |
27
|
7
|
|
|
7
|
|
684
|
Data::MultiValued::TagContainerForRanges->new(); |
28
|
|
|
|
|
|
|
} |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
sub set { |
32
|
21
|
|
|
21
|
1
|
5777
|
my ($self,%args) = validated_hash( |
33
|
|
|
|
|
|
|
\@_, |
34
|
|
|
|
|
|
|
from => { isa => Num|Undef, optional => 1, }, |
35
|
|
|
|
|
|
|
to => { isa => Num|Undef, optional => 1, }, |
36
|
|
|
|
|
|
|
tag => { isa => Str, optional => 1, }, |
37
|
|
|
|
|
|
|
value => { isa => Any, }, |
38
|
|
|
|
|
|
|
); |
39
|
|
|
|
|
|
|
|
40
|
21
|
|
|
|
|
225227
|
$self->_storage->get_or_create(\%args) |
41
|
|
|
|
|
|
|
->get_or_create(\%args) |
42
|
|
|
|
|
|
|
->{value} = $args{value}; |
43
|
|
|
|
|
|
|
} |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
sub get { |
47
|
76
|
|
|
76
|
1
|
66518
|
my ($self,%args) = validated_hash( |
48
|
|
|
|
|
|
|
\@_, |
49
|
|
|
|
|
|
|
at => { isa => Num|Undef, optional => 1, }, |
50
|
|
|
|
|
|
|
tag => { isa => Str, optional => 1, }, |
51
|
|
|
|
|
|
|
); |
52
|
|
|
|
|
|
|
|
53
|
74
|
|
|
|
|
372578
|
$self->_storage->get(\%args) |
54
|
|
|
|
|
|
|
->get(\%args) |
55
|
|
|
|
|
|
|
->{value}; |
56
|
|
|
|
|
|
|
} |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
sub clear { |
60
|
6
|
|
|
6
|
1
|
1955
|
my ($self,%args) = validated_hash( |
61
|
|
|
|
|
|
|
\@_, |
62
|
|
|
|
|
|
|
from => { isa => Num|Undef, optional => 1, }, |
63
|
|
|
|
|
|
|
to => { isa => Num|Undef, optional => 1, }, |
64
|
|
|
|
|
|
|
tag => { isa => Str, optional => 1, }, |
65
|
|
|
|
|
|
|
); |
66
|
|
|
|
|
|
|
|
67
|
6
|
100
|
66
|
|
|
64333
|
if (exists $args{from} || exists $args{to}) { |
68
|
2
|
|
|
|
|
112
|
$self->_storage->get(\%args) |
69
|
|
|
|
|
|
|
->clear(\%args); |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
else { |
72
|
4
|
|
|
|
|
193
|
$self->_storage->clear(\%args); |
73
|
|
|
|
|
|
|
} |
74
|
|
|
|
|
|
|
} |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
sub _rebless_storage { |
78
|
1
|
|
|
1
|
|
4
|
my ($self) = @_; |
79
|
|
|
|
|
|
|
|
80
|
1
|
|
|
|
|
5
|
bless $self->{_storage},'Data::MultiValued::TagContainerForRanges'; |
81
|
1
|
|
|
|
|
47
|
$self->_storage->_rebless_storage; |
82
|
|
|
|
|
|
|
} |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
sub _as_hash { |
86
|
1
|
|
|
1
|
|
3
|
my ($self) = @_; |
87
|
|
|
|
|
|
|
|
88
|
1
|
|
|
|
|
46
|
my $ret = $self->_storage->_as_hash; |
89
|
1
|
|
|
|
|
6
|
return {_storage=>$ret}; |
90
|
|
|
|
|
|
|
} |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
__PACKAGE__->meta->make_immutable(); |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
1; |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
__END__ |
97
|
|
|
|
|
|
|
=pod |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
=encoding utf-8 |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
=head1 NAME |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
Data::MultiValued::TagsAndRanges - Handle values with tags and validity ranges |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
=head1 VERSION |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
version 0.0.1_4 |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
=head1 SYNOPSIS |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
use Data::MultiValued::TagsAndRanges; |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
my $obj = Data::MultiValued::TagsAndRanges->new(); |
114
|
|
|
|
|
|
|
$obj->set({ |
115
|
|
|
|
|
|
|
tag => 'tag1', |
116
|
|
|
|
|
|
|
from => 10, |
117
|
|
|
|
|
|
|
to => 20, |
118
|
|
|
|
|
|
|
value => 'foo', |
119
|
|
|
|
|
|
|
}); |
120
|
|
|
|
|
|
|
say $obj->get({tag => 'tag1', at => 15}); # prints 'foo' |
121
|
|
|
|
|
|
|
say $obj->get({tag => 'tag1', at => 35}); # dies |
122
|
|
|
|
|
|
|
say $obj->get({tag => 'tag2', at => 15}); # dies |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
=head1 METHODS |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
=head2 C<set> |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
$obj->set({ tag => $the_tag, from => $min, to => $max, value => $the_value }); |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
Stores the given value for the given tag and range. Does not throw |
131
|
|
|
|
|
|
|
exceptions. |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
See L<Data::MultiValued::Tags/set> and |
134
|
|
|
|
|
|
|
L<Data::MultiValued::Ranges/set> for more details. |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
=head2 C<get> |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
my $value = $obj->get({ tag => $the_tag, at => $point }); |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
Retrieves the value for the given tag and point. Throws a |
141
|
|
|
|
|
|
|
L<Data::MultiValued::Exceptions::RangeNotFound|Data::MultiValued::Exceptions/Data::MultiValued::Exceptions::RangeNotFound> |
142
|
|
|
|
|
|
|
exception if no ranges exist in this object that include the point, |
143
|
|
|
|
|
|
|
and |
144
|
|
|
|
|
|
|
L<Data::MultiValued::Exceptions::TagNotFound|Data::MultiValued::Exceptions/Data::MultiValued::Exceptions::TagNotFound> |
145
|
|
|
|
|
|
|
exception if the tag does not exists in this object. |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
See L<Data::MultiValued::Tags/get> and |
148
|
|
|
|
|
|
|
L<Data::MultiValued::Ranges/get> for more details. |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
=head2 C<clear> |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
$obj->clear({ tag => $the_tag, from => $min, to => $max }); |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
If a range is specified, deletes all values for the given range and |
155
|
|
|
|
|
|
|
tag. If no range is specified, delete all values for the given tag. |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
Does not throw exceptions. |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
See L<Data::MultiValued::Tags/clear> and |
160
|
|
|
|
|
|
|
L<Data::MultiValued::Ranges/clear> for more details. |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
=head1 Serialisation helpers |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
These are used through |
165
|
|
|
|
|
|
|
L<Data::MultiValued::UglySerializationHelperRole>. |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
=head2 C<_rebless_storage> |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
Blesses the storage into L<Data::MultiValued::TagContainerForRanges>, |
170
|
|
|
|
|
|
|
then calls C<_rebless_storage> on it. |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
=head2 C<_as_hash> |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
Returns the internal representation with no blessed hashes, with as |
175
|
|
|
|
|
|
|
few copies as possible. Depends on |
176
|
|
|
|
|
|
|
L<Data::MultiValued::TagContainerForRanges/_as_hash>. |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
=head1 AUTHOR |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
Gianni Ceccarelli <dakkar@thenautilus.net> |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
This software is copyright (c) 2011 by Net-a-Porter.com. |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
This is free software; you can redistribute it and/or modify it under |
187
|
|
|
|
|
|
|
the same terms as the Perl 5 programming language system itself. |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
=cut |
190
|
|
|
|
|
|
|
|