diff options
Diffstat (limited to 'Data-MultiValued/lib/Data/MultiValued')
6 files changed, 81 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; |