diff options
Diffstat (limited to 'lib/Data/MultiValued/Tags.pm')
-rw-r--r-- | lib/Data/MultiValued/Tags.pm | 158 |
1 files changed, 92 insertions, 66 deletions
diff --git a/lib/Data/MultiValued/Tags.pm b/lib/Data/MultiValued/Tags.pm index 59ebbf5..ccf6e52 100644 --- a/lib/Data/MultiValued/Tags.pm +++ b/lib/Data/MultiValued/Tags.pm @@ -1,4 +1,10 @@ package Data::MultiValued::Tags; +{ + $Data::MultiValued::Tags::VERSION = '0.0.1_3'; +} +{ + $Data::MultiValued::Tags::DIST = 'Data-MultiValued'; +} use Moose; use MooseX::Params::Validate; use Moose::Util::TypeConstraints; @@ -8,6 +14,82 @@ use Data::MultiValued::TagContainer; # ABSTRACT: Handle values with tags + +has _storage => ( + is => 'rw', + isa => class_type('Data::MultiValued::TagContainer'), + init_arg => undef, + lazy_build => 1, +); + +sub _build__storage { + Data::MultiValued::TagContainer->new(); +} + + +sub set { + my ($self,%args) = validated_hash( + \@_, + tag => { isa => Str, optional => 1, }, + value => { isa => Any, }, + ); + + $self->_storage->get_or_create(\%args) + ->{value} = $args{value}; +} + + +sub get { + my ($self,%args) = validated_hash( + \@_, + tag => { isa => Str, optional => 1, }, + ); + + $self->_storage->get(\%args) + ->{value}; +} + + +sub clear { + my ($self,%args) = validated_hash( + \@_, + tag => { isa => Str, optional => 1, }, + ); + + $self->_storage->clear(\%args); +} + + +sub _rebless_storage { + my ($self) = @_; + + bless $self->{_storage},'Data::MultiValued::TagContainer'; +} + + +sub _as_hash { + my ($self) = @_; + + my %ret = %{$self->_storage}; + return {_storage=>\%ret}; +} + + +1; + +__END__ +=pod + +=encoding utf-8 + +=head1 NAME + +Data::MultiValued::Tags - Handle values with tags + +=head1 VERSION + +version 0.0.1_3 + =head1 SYNOPSIS use Data::MultiValued::Tags; @@ -22,19 +104,6 @@ use Data::MultiValued::TagContainer; =head1 METHODS -=cut - -has _storage => ( - is => 'rw', - isa => class_type('Data::MultiValued::TagContainer'), - init_arg => undef, - lazy_build => 1, -); - -sub _build__storage { - Data::MultiValued::TagContainer->new(); -} - =head2 C<set> $obj->set({ tag => $the_tag, value => $the_value }); @@ -48,19 +117,6 @@ 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}; -} - =head2 C<get> my $value = $obj->get({ tag => $the_tag }); @@ -75,18 +131,6 @@ 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}; -} - =head2 C<clear> $obj->clear({ tag => $the_tag }); @@ -97,17 +141,6 @@ 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 @@ -117,32 +150,25 @@ L<Data::MultiValued::UglySerializationHelperRole>. 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 +=head1 SEE ALSO -sub _as_hash { - my ($self) = @_; +L<Data::MultiValued::TagContainer>, L<Data::MultiValued::Exceptions> - my %ret = %{$self->_storage}; - return {_storage=>\%ret}; -} +=head1 AUTHOR -=head1 SEE ALSO +Gianni Ceccarelli <dakkar@thenautilus.net> -L<Data::MultiValued::TagContainer>, L<Data::MultiValued::Exceptions> +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2011 by Net-a-Porter.com. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. =cut -1; |