diff options
Diffstat (limited to 'lib/Data/MultiValued')
| -rw-r--r-- | lib/Data/MultiValued/AttributeAccessors.pm | 31 | ||||
| -rw-r--r-- | lib/Data/MultiValued/AttributeTrait.pm | 31 | ||||
| -rw-r--r-- | lib/Data/MultiValued/AttributeTrait/Ranges.pm | 39 | ||||
| -rw-r--r-- | lib/Data/MultiValued/AttributeTrait/Tags.pm | 39 | ||||
| -rw-r--r-- | lib/Data/MultiValued/AttributeTrait/TagsAndRanges.pm | 39 | ||||
| -rw-r--r-- | lib/Data/MultiValued/Exceptions.pm | 63 | ||||
| -rw-r--r-- | lib/Data/MultiValued/RangeContainer.pm | 125 | ||||
| -rw-r--r-- | lib/Data/MultiValued/Ranges.pm | 162 | ||||
| -rw-r--r-- | lib/Data/MultiValued/TagContainer.pm | 144 | ||||
| -rw-r--r-- | lib/Data/MultiValued/TagContainerForRanges.pm | 93 | ||||
| -rw-r--r-- | lib/Data/MultiValued/Tags.pm | 156 | ||||
| -rw-r--r-- | lib/Data/MultiValued/TagsAndRanges.pm | 169 | ||||
| -rw-r--r-- | lib/Data/MultiValued/UglySerializationHelperRole.pm | 31 |
13 files changed, 767 insertions, 355 deletions
diff --git a/lib/Data/MultiValued/AttributeAccessors.pm b/lib/Data/MultiValued/AttributeAccessors.pm index cac3538..abe2459 100644 --- a/lib/Data/MultiValued/AttributeAccessors.pm +++ b/lib/Data/MultiValued/AttributeAccessors.pm @@ -1,4 +1,10 @@ package Data::MultiValued::AttributeAccessors; +BEGIN { + $Data::MultiValued::AttributeAccessors::VERSION = '0.0.1'; +} +BEGIN { + $Data::MultiValued::AttributeAccessors::DIST = 'Data-MultiValued'; +} use strict; use warnings; use base 'Moose::Meta::Method::Accessor'; @@ -107,3 +113,28 @@ sub _generate_multi_clearer_method { } 1; + +__END__ +=pod + +=head1 NAME + +Data::MultiValued::AttributeAccessors + +=head1 VERSION + +version 0.0.1 + +=head1 AUTHOR + +Gianni Ceccarelli <dakkar@thenautilus.net> + +=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 + diff --git a/lib/Data/MultiValued/AttributeTrait.pm b/lib/Data/MultiValued/AttributeTrait.pm index 91e1b13..afeea2e 100644 --- a/lib/Data/MultiValued/AttributeTrait.pm +++ b/lib/Data/MultiValued/AttributeTrait.pm @@ -1,4 +1,10 @@ package Data::MultiValued::AttributeTrait; +BEGIN { + $Data::MultiValued::AttributeTrait::VERSION = '0.0.1'; +} +BEGIN { + $Data::MultiValued::AttributeTrait::DIST = 'Data-MultiValued'; +} use Moose::Role; use Data::MultiValued::AttributeAccessors; use MooseX::Types::Moose qw(Str); @@ -227,3 +233,28 @@ sub _as_hash { } 1; + +__END__ +=pod + +=head1 NAME + +Data::MultiValued::AttributeTrait + +=head1 VERSION + +version 0.0.1 + +=head1 AUTHOR + +Gianni Ceccarelli <dakkar@thenautilus.net> + +=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 + diff --git a/lib/Data/MultiValued/AttributeTrait/Ranges.pm b/lib/Data/MultiValued/AttributeTrait/Ranges.pm index 8d93578..347ee96 100644 --- a/lib/Data/MultiValued/AttributeTrait/Ranges.pm +++ b/lib/Data/MultiValued/AttributeTrait/Ranges.pm @@ -1,4 +1,10 @@ package Data::MultiValued::AttributeTrait::Ranges; +BEGIN { + $Data::MultiValued::AttributeTrait::Ranges::VERSION = '0.0.1'; +} +BEGIN { + $Data::MultiValued::AttributeTrait::Ranges::DIST = 'Data-MultiValued'; +} use Moose::Role; use Data::MultiValued::Ranges; with 'Data::MultiValued::AttributeTrait'; @@ -7,8 +13,39 @@ sub multivalue_storage_class { 'Data::MultiValued::Ranges' }; sub opts_to_pass_set { qw(from to) } sub opts_to_pass_get { qw(at) } -package Moose::Meta::Attribute::Custom::Trait::MultiValued::Ranges;{ +package Moose::Meta::Attribute::Custom::Trait::MultiValued::Ranges; +BEGIN { + $Moose::Meta::Attribute::Custom::Trait::MultiValued::Ranges::VERSION = '0.0.1'; +} +BEGIN { + $Moose::Meta::Attribute::Custom::Trait::MultiValued::Ranges::DIST = 'Data-MultiValued'; +}{ sub register_implementation { 'Data::MultiValued::AttributeTrait::Ranges' } } 1; + +__END__ +=pod + +=head1 NAME + +Data::MultiValued::AttributeTrait::Ranges + +=head1 VERSION + +version 0.0.1 + +=head1 AUTHOR + +Gianni Ceccarelli <dakkar@thenautilus.net> + +=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 + diff --git a/lib/Data/MultiValued/AttributeTrait/Tags.pm b/lib/Data/MultiValued/AttributeTrait/Tags.pm index 7cffb33..4355ebe 100644 --- a/lib/Data/MultiValued/AttributeTrait/Tags.pm +++ b/lib/Data/MultiValued/AttributeTrait/Tags.pm @@ -1,4 +1,10 @@ package Data::MultiValued::AttributeTrait::Tags; +BEGIN { + $Data::MultiValued::AttributeTrait::Tags::VERSION = '0.0.1'; +} +BEGIN { + $Data::MultiValued::AttributeTrait::Tags::DIST = 'Data-MultiValued'; +} use Moose::Role; use Data::MultiValued::Tags; with 'Data::MultiValued::AttributeTrait'; @@ -7,8 +13,39 @@ sub multivalue_storage_class { 'Data::MultiValued::Tags' }; sub opts_to_pass_set { qw(tag) } sub opts_to_pass_get { qw(tag) } -package Moose::Meta::Attribute::Custom::Trait::MultiValued::Tags;{ +package Moose::Meta::Attribute::Custom::Trait::MultiValued::Tags; +BEGIN { + $Moose::Meta::Attribute::Custom::Trait::MultiValued::Tags::VERSION = '0.0.1'; +} +BEGIN { + $Moose::Meta::Attribute::Custom::Trait::MultiValued::Tags::DIST = 'Data-MultiValued'; +}{ sub register_implementation { 'Data::MultiValued::AttributeTrait::Tags' } } 1; + +__END__ +=pod + +=head1 NAME + +Data::MultiValued::AttributeTrait::Tags + +=head1 VERSION + +version 0.0.1 + +=head1 AUTHOR + +Gianni Ceccarelli <dakkar@thenautilus.net> + +=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 + diff --git a/lib/Data/MultiValued/AttributeTrait/TagsAndRanges.pm b/lib/Data/MultiValued/AttributeTrait/TagsAndRanges.pm index e0c56cd..20b4acd 100644 --- a/lib/Data/MultiValued/AttributeTrait/TagsAndRanges.pm +++ b/lib/Data/MultiValued/AttributeTrait/TagsAndRanges.pm @@ -1,4 +1,10 @@ package Data::MultiValued::AttributeTrait::TagsAndRanges; +BEGIN { + $Data::MultiValued::AttributeTrait::TagsAndRanges::VERSION = '0.0.1'; +} +BEGIN { + $Data::MultiValued::AttributeTrait::TagsAndRanges::DIST = 'Data-MultiValued'; +} use Moose::Role; use Data::MultiValued::TagsAndRanges; with 'Data::MultiValued::AttributeTrait'; @@ -7,8 +13,39 @@ sub multivalue_storage_class { 'Data::MultiValued::TagsAndRanges' }; sub opts_to_pass_set { qw(from to tag) } sub opts_to_pass_get { qw(at tag) } -package Moose::Meta::Attribute::Custom::Trait::MultiValued::TagsAndRanges;{ +package Moose::Meta::Attribute::Custom::Trait::MultiValued::TagsAndRanges; +BEGIN { + $Moose::Meta::Attribute::Custom::Trait::MultiValued::TagsAndRanges::VERSION = '0.0.1'; +} +BEGIN { + $Moose::Meta::Attribute::Custom::Trait::MultiValued::TagsAndRanges::DIST = 'Data-MultiValued'; +}{ sub register_implementation { 'Data::MultiValued::AttributeTrait::TagsAndRanges' } } 1; + +__END__ +=pod + +=head1 NAME + +Data::MultiValued::AttributeTrait::TagsAndRanges + +=head1 VERSION + +version 0.0.1 + +=head1 AUTHOR + +Gianni Ceccarelli <dakkar@thenautilus.net> + +=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 + diff --git a/lib/Data/MultiValued/Exceptions.pm b/lib/Data/MultiValued/Exceptions.pm index 8d444c0..77a9e22 100644 --- a/lib/Data/MultiValued/Exceptions.pm +++ b/lib/Data/MultiValued/Exceptions.pm @@ -1,5 +1,17 @@ package Data::MultiValued::Exceptions; -package Data::MultiValued::Exceptions::NotFound;{ +BEGIN { + $Data::MultiValued::Exceptions::VERSION = '0.0.1'; +} +BEGIN { + $Data::MultiValued::Exceptions::DIST = 'Data-MultiValued'; +} +package Data::MultiValued::Exceptions::NotFound; +BEGIN { + $Data::MultiValued::Exceptions::NotFound::VERSION = '0.0.1'; +} +BEGIN { + $Data::MultiValued::Exceptions::NotFound::DIST = 'Data-MultiValued'; +}{ use Moose; extends 'Throwable::Error'; @@ -18,7 +30,13 @@ sub as_string { } } -package Data::MultiValued::Exceptions::TagNotFound;{ +package Data::MultiValued::Exceptions::TagNotFound; +BEGIN { + $Data::MultiValued::Exceptions::TagNotFound::VERSION = '0.0.1'; +} +BEGIN { + $Data::MultiValued::Exceptions::TagNotFound::DIST = 'Data-MultiValued'; +}{ use Moose; extends 'Data::MultiValued::Exceptions::NotFound'; @@ -26,7 +44,13 @@ has '+message' => ( default => 'tag not found: ', ); } -package Data::MultiValued::Exceptions::RangeNotFound;{ +package Data::MultiValued::Exceptions::RangeNotFound; +BEGIN { + $Data::MultiValued::Exceptions::RangeNotFound::VERSION = '0.0.1'; +} +BEGIN { + $Data::MultiValued::Exceptions::RangeNotFound::DIST = 'Data-MultiValued'; +}{ use Moose; extends 'Data::MultiValued::Exceptions::NotFound'; @@ -34,7 +58,13 @@ has '+message' => ( default => 'no range found for value ', ); } -package Data::MultiValued::Exceptions::BadRange;{ +package Data::MultiValued::Exceptions::BadRange; +BEGIN { + $Data::MultiValued::Exceptions::BadRange::VERSION = '0.0.1'; +} +BEGIN { + $Data::MultiValued::Exceptions::BadRange::DIST = 'Data-MultiValued'; +}{ use Moose; extends 'Throwable::Error'; @@ -55,3 +85,28 @@ sub as_string { } 1; + +__END__ +=pod + +=head1 NAME + +Data::MultiValued::Exceptions + +=head1 VERSION + +version 0.0.1 + +=head1 AUTHOR + +Gianni Ceccarelli <dakkar@thenautilus.net> + +=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 + diff --git a/lib/Data/MultiValued/RangeContainer.pm b/lib/Data/MultiValued/RangeContainer.pm index 0bfe8cd..58e9e53 100644 --- a/lib/Data/MultiValued/RangeContainer.pm +++ b/lib/Data/MultiValued/RangeContainer.pm @@ -1,4 +1,10 @@ package Data::MultiValued::RangeContainer; +BEGIN { + $Data::MultiValued::RangeContainer::VERSION = '0.0.1'; +} +BEGIN { + $Data::MultiValued::RangeContainer::DIST = 'Data-MultiValued'; +} use Moose; use Moose::Util::TypeConstraints; use MooseX::Types::Moose qw(Num Str Any Undef ArrayRef); @@ -7,24 +13,6 @@ use Data::MultiValued::Exceptions; # ABSTRACT: container for ranged values -=head1 DESCRIPTION - -Please don't use this module directly, use L<Data::MultiValued::Ranges>. - -This module implements the storage for ranged data. It's similar to -L<Array::IntSpan>, but simpler (and slower). - -A range is defined by a pair of numbers, C<from> and C<to>, and it -contains C<< Num $x : $min <= $x < $max >>. C<undef> is treated as -"inf" (negative infinity if used as C<from> or C<at>, positive -infinity if used as C<to>). - -The internal representation of a range is a hash with three keys, -C<from> C<to> C<value>. - -=head1 METHODS - -=cut has _storage => ( is => 'rw', @@ -39,15 +27,6 @@ has _storage => ( default => sub { [ ] }, ); -=head2 C<get> - - my $value = $obj->get({ at => $point }); - -Retrieves the range that includes the given point. Throws a -L<Data::MultiValued::Exceptions::RangeNotFound> exception if no range -includes the point. - -=cut sub get { my ($self,$args) = @_; @@ -117,16 +96,6 @@ sub _partition_slots { return \@before,\@overlap,\@after; } -=head2 C<get_or_create> - - $obj->get_or_create({ from => $min, to => $max }); - -Retrieves the range that has the given extremes. If no such range -exists, creates a new range, splicing any existing overlapping range, -and returns it. Throws L<Data::MultiValued::Exceptions::BadRange> if -C<< $min > $max >>. - -=cut sub get_or_create { my ($self,$args) = @_; @@ -151,18 +120,6 @@ sub get_or_create { return $range; } -=head2 C<clear> - - $obj->clear({ from => $min, to => $max }); - -Removes the range that has the given extremes. If no such range -exists, splices any existing overlapping range so that C<< -$obj->get({at => $point }) >> for any C<< $min <= $point < $max >> -will die. - -Throws L<Data::MultiValued::Exceptions::BadRange> if C<< $min > $max >>. - -=cut sub clear { my ($self,$args) = @_; @@ -269,3 +226,73 @@ sub _splice_slot { } 1; + +__END__ +=pod + +=head1 NAME + +Data::MultiValued::RangeContainer - container for ranged values + +=head1 VERSION + +version 0.0.1 + +=head1 DESCRIPTION + +Please don't use this module directly, use L<Data::MultiValued::Ranges>. + +This module implements the storage for ranged data. It's similar to +L<Array::IntSpan>, but simpler (and slower). + +A range is defined by a pair of numbers, C<from> and C<to>, and it +contains C<< Num $x : $min <= $x < $max >>. C<undef> is treated as +"inf" (negative infinity if used as C<from> or C<at>, positive +infinity if used as C<to>). + +The internal representation of a range is a hash with three keys, +C<from> C<to> C<value>. + +=head1 METHODS + +=head2 C<get> + + my $value = $obj->get({ at => $point }); + +Retrieves the range that includes the given point. Throws a +L<Data::MultiValued::Exceptions::RangeNotFound> exception if no range +includes the point. + +=head2 C<get_or_create> + + $obj->get_or_create({ from => $min, to => $max }); + +Retrieves the range that has the given extremes. If no such range +exists, creates a new range, splicing any existing overlapping range, +and returns it. Throws L<Data::MultiValued::Exceptions::BadRange> if +C<< $min > $max >>. + +=head2 C<clear> + + $obj->clear({ from => $min, to => $max }); + +Removes the range that has the given extremes. If no such range +exists, splices any existing overlapping range so that C<< +$obj->get({at => $point }) >> for any C<< $min <= $point < $max >> +will die. + +Throws L<Data::MultiValued::Exceptions::BadRange> if C<< $min > $max >>. + +=head1 AUTHOR + +Gianni Ceccarelli <dakkar@thenautilus.net> + +=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 + diff --git a/lib/Data/MultiValued/Ranges.pm b/lib/Data/MultiValued/Ranges.pm index 7193df6..6ea55c1 100644 --- a/lib/Data/MultiValued/Ranges.pm +++ b/lib/Data/MultiValued/Ranges.pm @@ -1,4 +1,10 @@ package Data::MultiValued::Ranges; +BEGIN { + $Data::MultiValued::Ranges::VERSION = '0.0.1'; +} +BEGIN { + $Data::MultiValued::Ranges::DIST = 'Data-MultiValued'; +} use Moose; use MooseX::Params::Validate; use Moose::Util::TypeConstraints; @@ -8,6 +14,83 @@ use Data::MultiValued::RangeContainer; # ABSTRACT: Handle values with validity ranges + +has _storage => ( + is => 'rw', + isa => class_type('Data::MultiValued::RangeContainer'), + init_arg => undef, + lazy_build => 1, +); + +sub _build__storage { + Data::MultiValued::RangeContainer->new(); +} + + +sub set { + my ($self,%args) = validated_hash( + \@_, + from => { isa => Num|Undef, optional => 1, }, + to => { isa => Num|Undef, optional => 1, }, + value => { isa => Any, }, + ); + + $self->_storage->get_or_create(\%args) + ->{value} = $args{value}; +} + + +sub get { + my ($self,%args) = validated_hash( + \@_, + at => { isa => Num|Undef, optional => 1, }, + ); + + $self->_storage->get(\%args) + ->{value}; +} + + +sub clear { + my ($self,%args) = validated_hash( + \@_, + from => { isa => Num|Undef, optional => 1, }, + to => { isa => Num|Undef, optional => 1, }, + ); + + $self->_storage->clear(\%args); +} + + +sub _rebless_storage { + my ($self) = @_; + + bless $self->{_storage},'Data::MultiValued::RangeContainer'; +} + + + +sub _as_hash { + my ($self) = @_; + + my %ret = %{$self->_storage}; + return {_storage=>\%ret}; +} + + +1; + +__END__ +=pod + +=head1 NAME + +Data::MultiValued::Ranges - Handle values with validity ranges + +=head1 VERSION + +version 0.0.1 + =head1 SYNOPSIS use Data::MultiValued::Ranges; @@ -23,19 +106,6 @@ use Data::MultiValued::RangeContainer; =head1 METHODS -=cut - -has _storage => ( - is => 'rw', - isa => class_type('Data::MultiValued::RangeContainer'), - init_arg => undef, - lazy_build => 1, -); - -sub _build__storage { - Data::MultiValued::RangeContainer->new(); -} - =head2 C<set> $obj->set({ from => $min, to => $max, value => $the_value }); @@ -68,20 +138,6 @@ avoid overlaps. In other words: No cloning is done: if you pass in a reference, the reference is just stored. -=cut - -sub set { - my ($self,%args) = validated_hash( - \@_, - from => { isa => Num|Undef, optional => 1, }, - to => { isa => Num|Undef, optional => 1, }, - value => { isa => Any, }, - ); - - $self->_storage->get_or_create(\%args) - ->{value} = $args{value}; -} - =head2 C<get> my $value = $obj->get({ at => $point }); @@ -97,18 +153,6 @@ equivalent to passing C<undef>. No cloning is done: if a reference was stored, you get it back untouched. -=cut - -sub get { - my ($self,%args) = validated_hash( - \@_, - at => { isa => Num|Undef, optional => 1, }, - ); - - $self->_storage->get(\%args) - ->{value}; -} - =head2 C<clear> $obj->clear({ from => $min, to => $max }); @@ -135,18 +179,6 @@ other words: say $obj->get({at => 12}); # prints 'foo' say $obj->get({at => 15}); # dies -=cut - -sub clear { - my ($self,%args) = validated_hash( - \@_, - from => { isa => Num|Undef, optional => 1, }, - to => { isa => Num|Undef, optional => 1, }, - ); - - $self->_storage->clear(\%args); -} - =head1 Serialisation helpers These are used through @@ -156,33 +188,25 @@ L<Data::MultiValued::UglySerializationHelperRole>. Blesses the storage into L<Data::MultiValued::RangeContainer>. -=cut - -sub _rebless_storage { - my ($self) = @_; - - bless $self->{_storage},'Data::MultiValued::RangeContainer'; -} - - =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::RangeContainer>, L<Data::MultiValued::Exceptions> - my %ret = %{$self->_storage}; - return {_storage=>\%ret}; -} +=head1 AUTHOR -=head1 SEE ALSO +Gianni Ceccarelli <dakkar@thenautilus.net> -L<Data::MultiValued::RangeContainer>, 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; diff --git a/lib/Data/MultiValued/TagContainer.pm b/lib/Data/MultiValued/TagContainer.pm index b7a9b13..2408576 100644 --- a/lib/Data/MultiValued/TagContainer.pm +++ b/lib/Data/MultiValued/TagContainer.pm @@ -1,4 +1,10 @@ package Data::MultiValued::TagContainer; +BEGIN { + $Data::MultiValued::TagContainer::VERSION = '0.0.1'; +} +BEGIN { + $Data::MultiValued::TagContainer::DIST = 'Data-MultiValued'; +} use Moose; use Moose::Util::TypeConstraints; use MooseX::Types::Moose qw(HashRef); @@ -6,23 +12,6 @@ use Data::MultiValued::Exceptions; # ABSTRACT: container for tagged values -=head1 DESCRIPTION - -Please don't use this module directly, use L<Data::MultiValued::Tags>. - -This module implements the storage for tagged data. It's almost -exactly a hash, the main difference being that C<undef> is a valid key -and it's distinct from the empty string. - -Another difference is that you get an exception if you try to access a -tag that's not there. - -Data is kept in "storage cells", as created by -L</_create_new_inferior> (by default, a hashref). - -=head1 METHODS - -=cut has _storage => ( is => 'rw', @@ -45,18 +34,6 @@ has _default_tag => ( clearer => '_clear_default_tag', ); -=head2 C<get> - - my $value = $obj->get({ tag => $the_tag }); - -Retrieves the "storage cell" for the given tag. Throws a -L<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 ->>. - -=cut sub get { my ($self,$args) = @_; @@ -81,18 +58,6 @@ sub get { return $self->_get_tag($tag); } -=head2 C<get_or_create> - - $obj->get_or_create({ tag => $the_tag }); - -Retrieves the "storage cell" for the given tag. If the tag does not -exist, creates a new cell (see L</_create_new_inferior>), sets it for -the tag, and returns it. - -Not passing in a C<tag> is equivalent to passing in C<< tag => undef ->>. - -=cut sub get_or_create { my ($self,$args) = @_; @@ -122,18 +87,6 @@ sub _clear_storage { $self->_storage({}); } -=head2 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>, or passing C<< tag => undef >>, clears -everything. If you want to only clear the C<undef> tag, you may call -C<_clear_default_tag> (which is considered a "protected" method). - -=cut sub clear { my ($self,$args) = @_; @@ -150,12 +103,6 @@ sub clear { return; } -=head2 C<_create_new_inferior> - -Returns a new "storage cell", by default an empty hashref. See -L<Data::MultiValued::TagContainerForRanges> for an example of use. - -=cut sub _create_new_inferior { my ($self) = @_; @@ -163,3 +110,82 @@ sub _create_new_inferior { } 1; + +__END__ +=pod + +=head1 NAME + +Data::MultiValued::TagContainer - container for tagged values + +=head1 VERSION + +version 0.0.1 + +=head1 DESCRIPTION + +Please don't use this module directly, use L<Data::MultiValued::Tags>. + +This module implements the storage for tagged data. It's almost +exactly a hash, the main difference being that C<undef> is a valid key +and it's distinct from the empty string. + +Another difference is that you get an exception if you try to access a +tag that's not there. + +Data is kept in "storage cells", as created by +L</_create_new_inferior> (by default, a hashref). + +=head1 METHODS + +=head2 C<get> + + my $value = $obj->get({ tag => $the_tag }); + +Retrieves the "storage cell" for the given tag. Throws a +L<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 +>>. + +=head2 C<get_or_create> + + $obj->get_or_create({ tag => $the_tag }); + +Retrieves the "storage cell" for the given tag. If the tag does not +exist, creates a new cell (see L</_create_new_inferior>), sets it for +the tag, and returns it. + +Not passing in a C<tag> is equivalent to passing in C<< tag => undef +>>. + +=head2 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>, or passing C<< tag => undef >>, clears +everything. If you want to only clear the C<undef> tag, you may call +C<_clear_default_tag> (which is considered a "protected" method). + +=head2 C<_create_new_inferior> + +Returns a new "storage cell", by default an empty hashref. See +L<Data::MultiValued::TagContainerForRanges> for an example of use. + +=head1 AUTHOR + +Gianni Ceccarelli <dakkar@thenautilus.net> + +=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 + diff --git a/lib/Data/MultiValued/TagContainerForRanges.pm b/lib/Data/MultiValued/TagContainerForRanges.pm index 826df9d..071ac04 100644 --- a/lib/Data/MultiValued/TagContainerForRanges.pm +++ b/lib/Data/MultiValued/TagContainerForRanges.pm @@ -1,4 +1,10 @@ package Data::MultiValued::TagContainerForRanges; +BEGIN { + $Data::MultiValued::TagContainerForRanges::VERSION = '0.0.1'; +} +BEGIN { + $Data::MultiValued::TagContainerForRanges::DIST = 'Data-MultiValued'; +} use Moose; use MooseX::Types::Moose qw(HashRef); use Moose::Util::TypeConstraints; @@ -6,18 +12,6 @@ use Data::MultiValued::RangeContainer; # ABSTRACT: container for tagged values that are ranged containers -=head1 DESCRIPTION - -Please don't use this module directly, use -L<Data::MultiValued::TagsAndRanges>. - -This module is a subclass of L<Data::MultiValued::TagContainer>, which -only allows instances of L<Data::MultiValued::RangeContainer> as -"storage cells". - -=head1 METHODS - -=cut extends 'Data::MultiValued::TagContainer'; @@ -29,26 +23,11 @@ has '+_default_tag' => ( isa => class_type('Data::MultiValued::RangeContainer'), ); -=head2 C<_create_new_inferior> - -Returns a new L<Data::MultiValued::RangeContainer> instance. - -=cut sub _create_new_inferior { Data::MultiValued::RangeContainer->new(); } -=head1 Serialisation helpers - -These are used through -L<Data::MultiValued::UglySerializationHelperRole>. - -=head2 C<_rebless_storage> - -Blesses the "storage cells" into L<Data::MultiValued::RangeContainer>. - -=cut sub _rebless_storage { my ($self) = @_; @@ -58,12 +37,6 @@ sub _rebless_storage { return; } -=head2 C<_as_hash> - -Returns the internal representation with no blessed hashes, with as -few copies as possible. - -=cut sub _as_hash { my ($self) = @_; @@ -80,3 +53,57 @@ sub _as_hash { } 1; + +__END__ +=pod + +=head1 NAME + +Data::MultiValued::TagContainerForRanges - container for tagged values that are ranged containers + +=head1 VERSION + +version 0.0.1 + +=head1 DESCRIPTION + +Please don't use this module directly, use +L<Data::MultiValued::TagsAndRanges>. + +This module is a subclass of L<Data::MultiValued::TagContainer>, which +only allows instances of L<Data::MultiValued::RangeContainer> as +"storage cells". + +=head1 METHODS + +=head2 C<_create_new_inferior> + +Returns a new L<Data::MultiValued::RangeContainer> instance. + +=head1 Serialisation helpers + +These are used through +L<Data::MultiValued::UglySerializationHelperRole>. + +=head2 C<_rebless_storage> + +Blesses the "storage cells" into L<Data::MultiValued::RangeContainer>. + +=head2 C<_as_hash> + +Returns the internal representation with no blessed hashes, with as +few copies as possible. + +=head1 AUTHOR + +Gianni Ceccarelli <dakkar@thenautilus.net> + +=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 + diff --git a/lib/Data/MultiValued/Tags.pm b/lib/Data/MultiValued/Tags.pm index 9c52510..38ed17d 100644 --- a/lib/Data/MultiValued/Tags.pm +++ b/lib/Data/MultiValued/Tags.pm @@ -1,4 +1,10 @@ package Data::MultiValued::Tags; +BEGIN { + $Data::MultiValued::Tags::VERSION = '0.0.1'; +} +BEGIN { + $Data::MultiValued::Tags::DIST = 'Data-MultiValued'; +} use Moose; use MooseX::Params::Validate; use Moose::Util::TypeConstraints; @@ -8,6 +14,80 @@ 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 + +=head1 NAME + +Data::MultiValued::Tags - Handle values with tags + +=head1 VERSION + +version 0.0.1 + =head1 SYNOPSIS use Data::MultiValued::Tags; @@ -22,19 +102,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 +115,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 +129,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 +139,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 +148,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; diff --git a/lib/Data/MultiValued/TagsAndRanges.pm b/lib/Data/MultiValued/TagsAndRanges.pm index 204f858..147c38f 100644 --- a/lib/Data/MultiValued/TagsAndRanges.pm +++ b/lib/Data/MultiValued/TagsAndRanges.pm @@ -1,4 +1,10 @@ package Data::MultiValued::TagsAndRanges; +BEGIN { + $Data::MultiValued::TagsAndRanges::VERSION = '0.0.1'; +} +BEGIN { + $Data::MultiValued::TagsAndRanges::DIST = 'Data-MultiValued'; +} use Moose; use MooseX::Params::Validate; use Moose::Util::TypeConstraints; @@ -8,24 +14,6 @@ use Data::MultiValued::TagContainerForRanges; # ABSTRACT: Handle values with tags and validity ranges -=head1 SYNOPSIS - - use Data::MultiValued::TagsAndRanges; - - my $obj = Data::MultiValued::TagsAndRanges->new(); - $obj->set({ - tag => 'tag1', - from => 10, - to => 20, - value => 'foo', - }); - say $obj->get({tag => 'tag1', at => 15}); # prints 'foo' - say $obj->get({tag => 'tag1', at => 35}); # dies - say $obj->get({tag => 'tag2', at => 15}); # dies - -=head1 METHODS - -=cut has _storage => ( is => 'rw', @@ -38,17 +26,6 @@ sub _build__storage { Data::MultiValued::TagContainerForRanges->new(); } -=head2 C<set> - - $obj->set({ tag => $the_tag, from => $min, to => $max, value => $the_value }); - -Stores the given value for the given tag and range. Does not throw -exceptions. - -See L<Data::MultiValued::Tags/set> and -L<Data::MultiValued::Ranges/set> for more details. - -=cut sub set { my ($self,%args) = validated_hash( @@ -64,20 +41,6 @@ sub set { ->{value} = $args{value}; } -=head2 C<get> - - my $value = $obj->get({ tag => $the_tag, at => $point }); - -Retrieves the value for the given tag and point. Throws a -L<Data::MultiValued::Exceptions::RangeNotFound> exception if no ranges -exist in this object that include the point, and -L<Data::MultiValued::Exceptions::TagNotFound> exception if the tag -does not exists in this object. - -See L<Data::MultiValued::Tags/get> and -L<Data::MultiValued::Ranges/get> for more details. - -=cut sub get { my ($self,%args) = validated_hash( @@ -91,19 +54,6 @@ sub get { ->{value}; } -=head2 C<clear> - - $obj->clear({ tag => $the_tag, from => $min, to => $max }); - -If a range is specified, deletes all values for the given range and -tag. If no range is specified, delete all values for the given tag. - -Does not throw exceptions. - -See L<Data::MultiValued::Tags/clear> and -L<Data::MultiValued::Ranges/clear> for more details. - -=cut sub clear { my ($self,%args) = validated_hash( @@ -122,6 +72,87 @@ sub clear { } } + +sub _rebless_storage { + my ($self) = @_; + + bless $self->{_storage},'Data::MultiValued::TagContainerForRanges'; + $self->_storage->_rebless_storage; +} + + +sub _as_hash { + my ($self) = @_; + + my $ret = $self->_storage->_as_hash; + return {_storage=>$ret}; +} + +1; + +__END__ +=pod + +=head1 NAME + +Data::MultiValued::TagsAndRanges - Handle values with tags and validity ranges + +=head1 VERSION + +version 0.0.1 + +=head1 SYNOPSIS + + use Data::MultiValued::TagsAndRanges; + + my $obj = Data::MultiValued::TagsAndRanges->new(); + $obj->set({ + tag => 'tag1', + from => 10, + to => 20, + value => 'foo', + }); + say $obj->get({tag => 'tag1', at => 15}); # prints 'foo' + say $obj->get({tag => 'tag1', at => 35}); # dies + say $obj->get({tag => 'tag2', at => 15}); # dies + +=head1 METHODS + +=head2 C<set> + + $obj->set({ tag => $the_tag, from => $min, to => $max, value => $the_value }); + +Stores the given value for the given tag and range. Does not throw +exceptions. + +See L<Data::MultiValued::Tags/set> and +L<Data::MultiValued::Ranges/set> for more details. + +=head2 C<get> + + my $value = $obj->get({ tag => $the_tag, at => $point }); + +Retrieves the value for the given tag and point. Throws a +L<Data::MultiValued::Exceptions::RangeNotFound> exception if no ranges +exist in this object that include the point, and +L<Data::MultiValued::Exceptions::TagNotFound> exception if the tag +does not exists in this object. + +See L<Data::MultiValued::Tags/get> and +L<Data::MultiValued::Ranges/get> for more details. + +=head2 C<clear> + + $obj->clear({ tag => $the_tag, from => $min, to => $max }); + +If a range is specified, deletes all values for the given range and +tag. If no range is specified, delete all values for the given tag. + +Does not throw exceptions. + +See L<Data::MultiValued::Tags/clear> and +L<Data::MultiValued::Ranges/clear> for more details. + =head1 Serialisation helpers These are used through @@ -132,28 +163,22 @@ L<Data::MultiValued::UglySerializationHelperRole>. Blesses the storage into L<Data::MultiValued::TagContainerForRanges>, then calls C<_rebless_storage> on it. -=cut - -sub _rebless_storage { - my ($self) = @_; - - bless $self->{_storage},'Data::MultiValued::TagContainerForRanges'; - $self->_storage->_rebless_storage; -} - =head2 C<_as_hash> Returns the internal representation with no blessed hashes, with as few copies as possible. Depends on L<Data::MultiValued::TagContainerForRanges/_as_hash>. -=cut +=head1 AUTHOR -sub _as_hash { - my ($self) = @_; +Gianni Ceccarelli <dakkar@thenautilus.net> - my $ret = $self->_storage->_as_hash; - return {_storage=>$ret}; -} +=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; diff --git a/lib/Data/MultiValued/UglySerializationHelperRole.pm b/lib/Data/MultiValued/UglySerializationHelperRole.pm index e586dec..60de111 100644 --- a/lib/Data/MultiValued/UglySerializationHelperRole.pm +++ b/lib/Data/MultiValued/UglySerializationHelperRole.pm @@ -1,4 +1,10 @@ package Data::MultiValued::UglySerializationHelperRole; +BEGIN { + $Data::MultiValued::UglySerializationHelperRole::VERSION = '0.0.1'; +} +BEGIN { + $Data::MultiValued::UglySerializationHelperRole::DIST = 'Data-MultiValued'; +} use Moose::Role; sub new_in_place { @@ -33,3 +39,28 @@ sub as_hash { } 1; + +__END__ +=pod + +=head1 NAME + +Data::MultiValued::UglySerializationHelperRole + +=head1 VERSION + +version 0.0.1 + +=head1 AUTHOR + +Gianni Ceccarelli <dakkar@thenautilus.net> + +=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 + |