Build results of 831f847 (on master)

8 files changed, 282 insertions, 54 deletions

diff --git a/Changes b/Changes
index 8a0f738..dca68d5 100644
--- a/Changes
+++ b/Changes
@@ -1,4 +1,4 @@
 Revision history for Data::MultiValued
 
-0.0.1     2011-11-14 14:46:57 Europe/London
+0.0.1     2011-11-14 15:52:09 Europe/London
   - first working version
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>
diff --git a/t/json.t b/t/json.t
index 5e00080..d1162b3 100644
--- a/t/json.t
+++ b/t/json.t
@@ -43,10 +43,12 @@ use Data::Printer;
 use JSON::XS;
 
 my $opts={tag=>'something'};
+my $ropts={tag=>'something',from=>10,to=>20};
 
 my $json = JSON::XS->new->utf8;
 my $obj = Foo->new(rr=>'foo');
 $obj->tt_multi($opts,1234);
+$obj->ttrr_multi($ropts,777);
 my $hash = $obj->as_hash;
 note p $hash;
 my $str = $json->encode($hash);
@@ -60,6 +62,7 @@ note p $obj2;
 
 is($obj2->tt,$obj->tt,'tt');
 is($obj2->tt_multi($opts),$obj->tt_multi($opts),'tt tagged');
+is($obj2->ttrr_multi({at => 15}),$obj->ttrr_multi({at => 15}),'ttrr');
 is($obj2->rr,$obj->rr,'rr');
 
 done_testing;