From 9b3887ba26cfa17344567d9a1b89921892d02dda Mon Sep 17 00:00:00 2001 From: Gianni Ceccarelli Date: Thu, 10 Nov 2011 12:53:24 +0000 Subject: 'clear' almost completely implemneted --- .../lib/Data/MultiValued/AttributeTrait.pm | 2 +- .../lib/Data/MultiValued/RangeContainer.pm | 40 +++++++++++++++++----- Data-MultiValued/lib/Data/MultiValued/Ranges.pm | 9 +++-- .../lib/Data/MultiValued/TagContainer.pm | 23 +++++++++++++ Data-MultiValued/lib/Data/MultiValued/Tags.pm | 7 ++-- .../lib/Data/MultiValued/TagsAndRanges.pm | 15 ++++++-- Data-MultiValued/t/ranges-setting.t | 17 +++++++++ Data-MultiValued/t/tags-ranges-setting.t | 17 +++++++++ Data-MultiValued/t/tags-setting.t | 18 ++++++++++ 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 { -- cgit v1.2.3