summaryrefslogtreecommitdiff
path: root/lib/Data/MultiValued/Tags.pm
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Data/MultiValued/Tags.pm')
-rw-r--r--lib/Data/MultiValued/Tags.pm146
1 files changed, 146 insertions, 0 deletions
diff --git a/lib/Data/MultiValued/Tags.pm b/lib/Data/MultiValued/Tags.pm
new file mode 100644
index 0000000..640db40
--- /dev/null
+++ b/lib/Data/MultiValued/Tags.pm
@@ -0,0 +1,146 @@
+package Data::MultiValued::Tags;
+use Moose;
+use MooseX::Params::Validate;
+use Moose::Util::TypeConstraints;
+use MooseX::Types::Moose qw(Num Str Undef Any);
+use Data::MultiValued::Exceptions;
+use Data::MultiValued::TagContainer;
+
+# ABSTRACT: Handle values with tags
+
+=head1 SYNOPSIS
+
+ use Data::MultiValued::Tags;
+
+ my $obj = Data::MultiValued::Tags->new();
+ $obj->set({
+ tag => 'tag1',
+ value => 'a string',
+ });
+ say $obj->get({tag=>'tag1'}); # prints 'a string'
+ say $obj->get({tag=>'tag2'}); # dies
+
+=cut
+
+has _storage => (
+ is => 'rw',
+ isa => class_type('Data::MultiValued::TagContainer'),
+ init_arg => undef,
+ lazy_build => 1,
+);
+
+sub _build__storage {
+ Data::MultiValued::TagContainer->new();
+}
+
+=method C<set>
+
+ $obj->set({ tag => $the_tag, value => $the_value });
+
+Stores the given value for the given tag. Replaces existing
+values. Does not throw exceptions.
+
+Not passing in a C<tag> is equivalent to passing in C<< tag => undef
+>>.
+
+No cloning is done: if you pass in a reference, the reference is
+just stored.
+
+=cut
+
+sub set {
+ my ($self,%args) = validated_hash(
+ \@_,
+ tag => { isa => Str, optional => 1, },
+ value => { isa => Any, },
+ );
+
+ $self->_storage->get_or_create(\%args)
+ ->{value} = $args{value};
+}
+
+=method C<get>
+
+ my $value = $obj->get({ tag => $the_tag });
+
+Retrieves the value for the given tag. Throws a
+L<Data::MultiValued::Exceptions::TagNotFound|Data::MultiValued::Exceptions/Data::MultiValued::Exceptions::TagNotFound>
+exception if the tag does not exists in this object.
+
+Not passing in a C<tag> is equivalent to passing in C<< tag => undef
+>>.
+
+No cloning is done: if a reference was stored, you get it back
+untouched.
+
+=cut
+
+sub get {
+ my ($self,%args) = validated_hash(
+ \@_,
+ tag => { isa => Str, optional => 1, },
+ );
+
+ $self->_storage->get(\%args)
+ ->{value};
+}
+
+=method C<clear>
+
+ $obj->clear({ tag => $the_tag });
+
+Deletes the given tag and all data associated with it. Does not throw
+exceptions: if the tag does not exist, nothing happens.
+
+Not passing in a C<tag> clears everything. Yes, this means that there
+is no way to just clear the value for the C<undef> tag.
+
+=cut
+
+sub clear {
+ my ($self,%args) = validated_hash(
+ \@_,
+ tag => { isa => Str, optional => 1, },
+ );
+
+ $self->_storage->clear(\%args);
+}
+
+=head1 Serialisation helpers
+
+These are used through
+L<Data::MultiValued::UglySerializationHelperRole>.
+
+=head2 C<_rebless_storage>
+
+Blesses the storage into L<Data::MultiValued::TagContainer>.
+
+=cut
+
+sub _rebless_storage {
+ my ($self) = @_;
+
+ bless $self->{_storage},'Data::MultiValued::TagContainer';
+}
+
+=head2 C<_as_hash>
+
+Returns the internal representation with no blessed hashes, with as
+few copies as possible.
+
+=cut
+
+sub _as_hash {
+ my ($self) = @_;
+
+ my %ret = %{$self->_storage};
+ return {_storage=>\%ret};
+}
+
+=head1 SEE ALSO
+
+L<Data::MultiValued::TagContainer>, L<Data::MultiValued::Exceptions>
+
+=cut
+
+1;