diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/Data/MultiValued/RangeContainer.pm | 81 | ||||
| -rw-r--r-- | lib/Data/MultiValued/Ranges.pm | 51 | ||||
| -rw-r--r-- | lib/Data/MultiValued/TagContainer.pm | 63 | ||||
| -rw-r--r-- | lib/Data/MultiValued/TagContainerForRanges.pm | 46 | ||||
| -rw-r--r-- | lib/Data/MultiValued/Tags.pm | 42 | ||||
| -rw-r--r-- | lib/Data/MultiValued/TagsAndRanges.pm | 48 |
6 files changed, 278 insertions, 53 deletions
diff --git a/lib/Data/MultiValued/RangeContainer.pm b/lib/Data/MultiValued/RangeContainer.pm index 69dcc38..58e9e53 100644 --- a/lib/Data/MultiValued/RangeContainer.pm +++ b/lib/Data/MultiValued/RangeContainer.pm @@ -11,6 +11,9 @@ use MooseX::Types::Moose qw(Num Str Any Undef ArrayRef); use MooseX::Types::Structured qw(Dict); use Data::MultiValued::Exceptions; +# ABSTRACT: container for ranged values + + has _storage => ( is => 'rw', isa => ArrayRef[ @@ -24,6 +27,7 @@ has _storage => ( default => sub { [ ] }, ); + sub get { my ($self,$args) = @_; @@ -51,6 +55,8 @@ sub _cmp { return $a <=> $b; } +# a binary search would be a good idea. + sub _get_slot_at { my ($self,$at) = @_; @@ -62,6 +68,10 @@ sub _get_slot_at { return; } +# this is quite probably uselessly slow: we don't really need all of +# @before and @after, we just need to know if they're not empty; also, +# a binary search would be a good idea. + sub _partition_slots { my ($self,$from,$to) = @_; @@ -86,7 +96,8 @@ sub _partition_slots { return \@before,\@overlap,\@after; } -sub set_or_create { + +sub get_or_create { my ($self,$args) = @_; my $from = $args->{from}; @@ -109,6 +120,7 @@ sub set_or_create { return $range; } + sub clear { my ($self,$args) = @_; @@ -139,10 +151,16 @@ sub _clear_slot { $self->_splice_slot($from,$to); } +# Most of the splicing mechanics is here. Given a range and something +# to put in it, do "the right thing" + sub _splice_slot { my ($self,$from,$to,$new) = @_; - if (!@{$self->_storage}) { # empty + # if !$new, it's like C<splice> without a replacement list: we + # just delete the range + + if (!@{$self->_storage}) { # empty, just store push @{$self->_storage},$new if $new; return $new; } @@ -150,27 +168,33 @@ sub _splice_slot { my ($before,$overlap,$after) = $self->_partition_slots($from,$to); if (!@$before && !@$overlap) { + # nothing before, nothing overlapping: put $new at the beginning unshift @{$self->_storage},$new if $new; return $new; } if (!@$after && !@$overlap) { + # nothing after, nothing overlapping: put $new at the end push @{$self->_storage},$new if $new; return $new; } - # by costruction, the first and the last may have to be split, all - # others must be removed + # ok, we have to insert in the middle of things, and maybe we have + # to trim existing ranges + my $first_to_replace; my $how_many = @$overlap; my @replacement = $new ? ($new) : (); if ($how_many > 0) { # we have to splice + # by costruction, the first and the last may have to be split, all + # others must be removed $first_to_replace = $overlap->[0]; my $last_to_replace = $overlap->[-1]; my $first = $self->_storage->[$first_to_replace]; my $last = $self->_storage->[$last_to_replace]; + # does the first overlapping range need trimming? if (_cmp($first->{from},$from,0,0)<0 && _cmp($first->{to},$from,1,0)>=0) { unshift @replacement, { @@ -179,6 +203,7 @@ sub _splice_slot { value => $first->{value}, } } + # does the last overlapping range need trimming? if (_cmp($last->{from},$to,0,1)<=0 && _cmp($last->{to},$to,1,1)>0) { push @replacement, { @@ -189,6 +214,7 @@ sub _splice_slot { } } else { + # no overlaps, just insert between @before and @after $first_to_replace = $before->[-1]+1; } @@ -206,12 +232,57 @@ __END__ =head1 NAME -Data::MultiValued::RangeContainer +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> diff --git a/lib/Data/MultiValued/Ranges.pm b/lib/Data/MultiValued/Ranges.pm index 296ae76..6ea55c1 100644 --- a/lib/Data/MultiValued/Ranges.pm +++ b/lib/Data/MultiValued/Ranges.pm @@ -26,19 +26,6 @@ sub _build__storage { Data::MultiValued::RangeContainer->new(); } -sub _rebless_storage { - my ($self) = @_; - - bless $self->{_storage},'Data::MultiValued::RangeContainer'; -} - -sub _as_hash { - my ($self) = @_; - - my %ret = %{$self->_storage}; - return {_storage=>\%ret}; -} - sub set { my ($self,%args) = validated_hash( @@ -48,7 +35,7 @@ sub set { value => { isa => Any, }, ); - $self->_storage->set_or_create(\%args) + $self->_storage->get_or_create(\%args) ->{value} = $args{value}; } @@ -75,6 +62,22 @@ sub clear { } +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__ @@ -107,7 +110,8 @@ version 0.0.1 $obj->set({ from => $min, to => $max, value => $the_value }); -Stores the given value for the given range. Does not throw exceptions. +Stores the given value for the given range. Throws +L<Data::MultiValued::Exceptions::BadRange> if C<< $min > $max >>. The range is defined as C<< Num $x : $min <= $x < $max >>. A C<< from => undef >> means "from -Inf", and a C<< to => undef >> means "to @@ -153,7 +157,8 @@ untouched. $obj->clear({ from => $min, to => $max }); -Deletes all values for the given range. Does not throw exceptions. +Deletes all values for the given range. Throws +L<Data::MultiValued::Exceptions::BadRange> if C<< $min > $max >>. A C<< from => undef >> means "from -Inf", and a C<< to => undef >> means "to +Inf". Not passing in C<from> or C<to> is equivalent to @@ -174,6 +179,20 @@ other words: say $obj->get({at => 12}); # prints 'foo' say $obj->get({at => 15}); # dies +=head1 Serialisation helpers + +These are used through +L<Data::MultiValued::UglySerializationHelperRole>. + +=head2 C<_rebless_storage> + +Blesses the storage into L<Data::MultiValued::RangeContainer>. + +=head2 C<_as_hash> + +Returns the internal representation with no blessed hashes, with as +few copies as possible. + =head1 SEE ALSO L<Data::MultiValued::RangeContainer>, L<Data::MultiValued::Exceptions> diff --git a/lib/Data/MultiValued/TagContainer.pm b/lib/Data/MultiValued/TagContainer.pm index a65115b..2408576 100644 --- a/lib/Data/MultiValued/TagContainer.pm +++ b/lib/Data/MultiValued/TagContainer.pm @@ -10,6 +10,9 @@ use Moose::Util::TypeConstraints; use MooseX::Types::Moose qw(HashRef); use Data::MultiValued::Exceptions; +# ABSTRACT: container for tagged values + + has _storage => ( is => 'rw', isa => HashRef, @@ -31,6 +34,7 @@ has _default_tag => ( clearer => '_clear_default_tag', ); + sub get { my ($self,$args) = @_; @@ -54,6 +58,7 @@ sub get { return $self->_get_tag($tag); } + sub get_or_create { my ($self,$args) = @_; @@ -82,6 +87,7 @@ sub _clear_storage { $self->_storage({}); } + sub clear { my ($self,$args) = @_; @@ -97,6 +103,7 @@ sub clear { return; } + sub _create_new_inferior { my ($self) = @_; return {}; @@ -109,12 +116,66 @@ __END__ =head1 NAME -Data::MultiValued::TagContainer +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> diff --git a/lib/Data/MultiValued/TagContainerForRanges.pm b/lib/Data/MultiValued/TagContainerForRanges.pm index 27af25a..071ac04 100644 --- a/lib/Data/MultiValued/TagContainerForRanges.pm +++ b/lib/Data/MultiValued/TagContainerForRanges.pm @@ -10,6 +10,9 @@ use MooseX::Types::Moose qw(HashRef); use Moose::Util::TypeConstraints; use Data::MultiValued::RangeContainer; +# ABSTRACT: container for tagged values that are ranged containers + + extends 'Data::MultiValued::TagContainer'; has '+_storage' => ( @@ -20,20 +23,28 @@ has '+_default_tag' => ( isa => class_type('Data::MultiValued::RangeContainer'), ); + sub _create_new_inferior { Data::MultiValued::RangeContainer->new(); } + sub _rebless_storage { my ($self) = @_; - bless $self->{_storage},'Data::MultiValued::RangeContainer'; + bless $_,'Data::MultiValued::RangeContainer' + for values %{$self->{_storage}}; bless $self->{_default_tag},'Data::MultiValued::RangeContainer'; return; } + sub _as_hash { my ($self) = @_; - my %st = %{$self->_storage}; + my %st; + for my $k (keys %{$self->_storage}) { + my %v = %{$self->_storage->{$k}}; + $st{$k}=\%v; + } my %dt = %{$self->_default_tag}; return { _storage => \%st, @@ -48,12 +59,41 @@ __END__ =head1 NAME -Data::MultiValued::TagContainerForRanges +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> diff --git a/lib/Data/MultiValued/Tags.pm b/lib/Data/MultiValued/Tags.pm index a42caf4..38ed17d 100644 --- a/lib/Data/MultiValued/Tags.pm +++ b/lib/Data/MultiValued/Tags.pm @@ -26,19 +26,6 @@ sub _build__storage { Data::MultiValued::TagContainer->new(); } -sub _rebless_storage { - my ($self) = @_; - - bless $self->{_storage},'Data::MultiValued::TagContainer'; -} - -sub _as_hash { - my ($self) = @_; - - my %ret = %{$self->_storage}; - return {_storage=>\%ret}; -} - sub set { my ($self,%args) = validated_hash( @@ -73,6 +60,21 @@ sub clear { } +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__ @@ -137,6 +139,20 @@ 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. +=head1 Serialisation helpers + +These are used through +L<Data::MultiValued::UglySerializationHelperRole>. + +=head2 C<_rebless_storage> + +Blesses the storage into L<Data::MultiValued::TagContainer>. + +=head2 C<_as_hash> + +Returns the internal representation with no blessed hashes, with as +few copies as possible. + =head1 SEE ALSO L<Data::MultiValued::TagContainer>, L<Data::MultiValued::Exceptions> diff --git a/lib/Data/MultiValued/TagsAndRanges.pm b/lib/Data/MultiValued/TagsAndRanges.pm index 0217a69..147c38f 100644 --- a/lib/Data/MultiValued/TagsAndRanges.pm +++ b/lib/Data/MultiValued/TagsAndRanges.pm @@ -26,20 +26,6 @@ sub _build__storage { Data::MultiValued::TagContainerForRanges->new(); } -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}; -} - sub set { my ($self,%args) = validated_hash( @@ -51,7 +37,7 @@ sub set { ); $self->_storage->get_or_create(\%args) - ->set_or_create(\%args) + ->get_or_create(\%args) ->{value} = $args{value}; } @@ -86,6 +72,22 @@ 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__ @@ -151,6 +153,22 @@ 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 +L<Data::MultiValued::UglySerializationHelperRole>. + +=head2 C<_rebless_storage> + +Blesses the storage into L<Data::MultiValued::TagContainerForRanges>, +then calls C<_rebless_storage> on it. + +=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>. + =head1 AUTHOR Gianni Ceccarelli <dakkar@thenautilus.net> |