'clear' almost completely implemneted

9 files changed, 133 insertions, 15 deletions

diff --git a/Data-MultiValued/lib/Data/MultiValued/AttributeTrait.pm b/Data-MultiValued/lib/Data/MultiValued/AttributeTrait.pm
index 060aa5a..91e1b13 100644
--- a/Data-MultiValued/lib/Data/MultiValued/AttributeTrait.pm
+++ b/Data-MultiValued/lib/Data/MultiValued/AttributeTrait.pm
@@ -185,8 +185,8 @@ sub has_multi_value {
 after clear_value => sub {
     my ($self,$instance) = @_;
 
-    # XXX NIY
     $self->full_storage($instance)->clear($dyn_opts);
+    return;
 };
 
 sub clear_multi_value {
diff --git a/Data-MultiValued/lib/Data/MultiValued/RangeContainer.pm b/Data-MultiValued/lib/Data/MultiValued/RangeContainer.pm
index 33864da..474626f 100644
--- a/Data-MultiValued/lib/Data/MultiValued/RangeContainer.pm
+++ b/Data-MultiValued/lib/Data/MultiValued/RangeContainer.pm
@@ -103,28 +103,52 @@ sub set_or_create {
     return $range;
 }
 
+sub clear {
+    my ($self,$args) = @_;
+
+    my $from = $args->{from};
+    my $to = $args->{to};
+
+    Data::MultiValued::Exceptions::BadRange->throw({
+        from => $from,
+        to => $to,
+    }) if _cmp($from,$to,0,1)>0;
+
+    return $self->_clear_slot($from,$to);
+}
+
 sub _create_slot {
     my ($self,$from,$to) = @_;
 
-    my $new = {
+    $self->_splice_slot($from,$to,{
         from => $from,
         to => $to,
         value => undef,
-    };
+    });
+}
+
+sub _clear_slot {
+    my ($self,$from,$to) = @_;
+
+    $self->_splice_slot($from,$to);
+}
+
+sub _splice_slot {
+    my ($self,$from,$to,$new) = @_;
 
     if (!@{$self->_storage}) { # empty
-        push @{$self->_storage},$new;
+        push @{$self->_storage},$new if $new;
         return $new;
     }
 
     my ($before,$overlap,$after) = $self->_partition_slots($from,$to);
 
     if (!@$before && !@$overlap) {
-        unshift @{$self->_storage},$new;
+        unshift @{$self->_storage},$new if $new;
         return $new;
     }
     if (!@$after && !@$overlap) {
-        push @{$self->_storage},$new;
+        push @{$self->_storage},$new if $new;
         return $new;
     }
 
@@ -134,7 +158,7 @@ sub _create_slot {
     my $last_to_replace = $overlap->[-1],
     my $how_many = @$overlap;
 
-    my @replacement = ($new);
+    my @replacement = $new ? ($new) : ();
 
     if ($how_many > 0) { # we have to splice
         my $first = $self->_storage->[$first_to_replace];
@@ -148,8 +172,8 @@ sub _create_slot {
                 value => $first->{value},
             }
         }
-        if (_cmp($last->{from},$to,0,1)<0
-            && _cmp($last->{to},$to,1,1)>=0) {
+        if (_cmp($last->{from},$to,0,1)<=0
+            && _cmp($last->{to},$to,1,1)>0) {
             push @replacement, {
                 from => $to,
                 to => $last->{to},
diff --git a/Data-MultiValued/lib/Data/MultiValued/Ranges.pm b/Data-MultiValued/lib/Data/MultiValued/Ranges.pm
index 25a1eec..9c69626 100644
--- a/Data-MultiValued/lib/Data/MultiValued/Ranges.pm
+++ b/Data-MultiValued/lib/Data/MultiValued/Ranges.pm
@@ -55,9 +55,14 @@ sub get {
 }
 
 sub clear {
-    my ($self) = @_;
+    my ($self,%args) = validated_hash(
+        \@_,
+        from => { isa => Num|Undef, optional => 1, },
+        to => { isa => Num|Undef, optional => 1, },
+    );
 
-    $self->_clear_storage;
+    $self->_storage->clear(\%args);
 }
 
+
 1;
diff --git a/Data-MultiValued/lib/Data/MultiValued/TagContainer.pm b/Data-MultiValued/lib/Data/MultiValued/TagContainer.pm
index e0c7f4f..cdd0456 100644
--- a/Data-MultiValued/lib/Data/MultiValued/TagContainer.pm
+++ b/Data-MultiValued/lib/Data/MultiValued/TagContainer.pm
@@ -14,6 +14,7 @@ has _storage => (
         _has_tag => 'exists',
         _get_tag => 'get',
         _create_tag => 'set',
+        _delete_tag => 'delete',
     },
 );
 
@@ -21,6 +22,7 @@ has _default_tag => (
     is => 'rw',
     init_arg => undef,
     predicate => '_has_default_tag',
+    clearer => '_clear_default_tag',
 );
 
 sub get {
@@ -68,6 +70,27 @@ sub get_or_create {
     return $self->_get_tag($tag);
 }
 
+sub _clear_storage {
+    my ($self) = @_;
+
+    $self->_storage({});
+}
+
+sub clear {
+    my ($self,$args) = @_;
+
+    my $tag = $args->{tag};
+
+    if (!defined($tag)) {
+        $self->_clear_default_tag;
+        $self->_clear_storage;
+    }
+    elsif ($self->_has_tag($tag)) {
+        $self->_delete_tag($tag);
+    }
+    return;
+}
+
 sub _create_new_inferior {
     my ($self) = @_;
     return {};
diff --git a/Data-MultiValued/lib/Data/MultiValued/Tags.pm b/Data-MultiValued/lib/Data/MultiValued/Tags.pm
index 2262d8a..fbf7948 100644
--- a/Data-MultiValued/lib/Data/MultiValued/Tags.pm
+++ b/Data-MultiValued/lib/Data/MultiValued/Tags.pm
@@ -54,9 +54,12 @@ sub get {
 }
 
 sub clear {
-    my ($self) = @_;
+    my ($self,%args) = validated_hash(
+        \@_,
+        tag => { isa => Str, optional => 1, },
+    );
 
-    $self->_clear_storage;
+    $self->_storage->clear(\%args);
 }
 
 1;
diff --git a/Data-MultiValued/lib/Data/MultiValued/TagsAndRanges.pm b/Data-MultiValued/lib/Data/MultiValued/TagsAndRanges.pm
index 82e3271..6208435 100644
--- a/Data-MultiValued/lib/Data/MultiValued/TagsAndRanges.pm
+++ b/Data-MultiValued/lib/Data/MultiValued/TagsAndRanges.pm
@@ -60,9 +60,20 @@ sub get {
 }
 
 sub clear {
-    my ($self) = @_;
+    my ($self,%args) = validated_hash(
+        \@_,
+        from => { isa => Num|Undef, optional => 1, },
+        to => { isa => Num|Undef, optional => 1, },
+        tag => { isa => Str, optional => 1, },
+    );
 
-    $self->_clear_storage;
+    if (exists $args{from} || exists $args{to}) {
+        $self->_storage->get(\%args)
+            ->clear(\%args);
+    }
+    else {
+        $self->_storage->clear(\%args);
+    }
 }
 
 1;
diff --git a/Data-MultiValued/t/ranges-setting.t b/Data-MultiValued/t/ranges-setting.t
index ff6a6b3..b8d2a57 100644
--- a/Data-MultiValued/t/ranges-setting.t
+++ b/Data-MultiValued/t/ranges-setting.t
@@ -57,6 +57,23 @@ sub test_it {
     dies_ok {
         $obj->get({});
     } 'default get dies';
+
+    $obj->clear({from=>10,to=>20});
+
+    dies_ok {
+        $obj->get({at => 15})
+    } 'getting 15 after clearing dies';
+
+    cmp_deeply($obj->get({at => 30}),
+               [4,5,6],
+               'getting 30 after clearing');
+
+    $obj->clear();
+
+    dies_ok {
+        $obj->get({at => 30})
+    } 'getting 30 after clearing all dies';
+
 }
 
 subtest 'ranges' => sub {
diff --git a/Data-MultiValued/t/tags-ranges-setting.t b/Data-MultiValued/t/tags-ranges-setting.t
index 5f82a4e..e25a9f1 100644
--- a/Data-MultiValued/t/tags-ranges-setting.t
+++ b/Data-MultiValued/t/tags-ranges-setting.t
@@ -65,4 +65,21 @@ for my $tag (@tags) {
     }
 }
 
+$obj->clear({tag=>$tags[1],from=>$ranges[0]->[0],to=>$ranges[0]->[1]});
+dies_ok {
+    $obj->get({
+        tag=>$tags[1],
+        at => $ranges[0]->[0]+1,
+    })
+} 'getting deleted range from inside tag dies';
+
+cmp_ok(
+    $obj->get({
+        tag => $tags[1],
+        at => $ranges[1]->[0]+1,
+    }),
+    '==',
+    $ranges[1]->[2],
+    'other ranges in same tag are still there');
+
 done_testing();
diff --git a/Data-MultiValued/t/tags-setting.t b/Data-MultiValued/t/tags-setting.t
index 5029d2d..929ad3d 100644
--- a/Data-MultiValued/t/tags-setting.t
+++ b/Data-MultiValued/t/tags-setting.t
@@ -39,6 +39,24 @@ sub test_it {
     dies_ok {
         $obj->get({});
     } 'default get dies';
+
+    $obj->clear({tag=>'tag1'});
+
+    dies_ok {
+        $obj->get({tag=>'tag1'});
+    } 'getting cleared tag';
+
+    cmp_ok($obj->get({tag => 'tag2'}),
+           'eq',
+           'another string',
+           'getting tag2 after clearing');
+
+    $obj->clear();
+
+    dies_ok {
+        $obj->get({tag=>'tag2'});
+    } 'getting tag2 after clearing all dies';
+
 }
 
 subtest 'tags' => sub {