diff options
Diffstat (limited to 'Data-TagsAndRanges/lib/Data/TagsAndRanges/RangeContainer.pm')
-rw-r--r-- | Data-TagsAndRanges/lib/Data/TagsAndRanges/RangeContainer.pm | 114 |
1 files changed, 88 insertions, 26 deletions
diff --git a/Data-TagsAndRanges/lib/Data/TagsAndRanges/RangeContainer.pm b/Data-TagsAndRanges/lib/Data/TagsAndRanges/RangeContainer.pm index 5f3653a..e93805e 100644 --- a/Data-TagsAndRanges/lib/Data/TagsAndRanges/RangeContainer.pm +++ b/Data-TagsAndRanges/lib/Data/TagsAndRanges/RangeContainer.pm @@ -9,8 +9,8 @@ has _storage => ( is => 'rw', isa => ArrayRef[ Dict[ - from => Num|Undef, - to => Num|Undef, + from => Num, + to => Num, value => Any, ], ], @@ -21,7 +21,7 @@ has _storage => ( sub get { my ($self,$args) = @_; - my $at = $args->{at}; + my $at = $args->{at} // 0-'inf'; my ($range) = $self->_get_slot_at($at); @@ -34,42 +34,55 @@ sub get { return $range; } -sub _cmp_less { - return if !defined $_[0]; - return 1 if !defined $_[1]; - return $_[0] <= $_[1]; -} -sub _cmp_more { - return if !defined $_[0]; - return 1 if !defined $_[1]; - return $_[0] > $_[1]; -} -sub _cmp_eq { - return 1 if !defined($_[0]) && !defined($_[1]); - return if defined($_[0]) xor defined($_[1]); - return $_[0] == $_[1]; -} - sub _get_slot_at { my ($self,$at) = @_; for my $slot (@{$self->_storage}) { - next if _cmp_less($slot->{to},$at); - last if _cmp_more($slot->{from},$at); + next if $slot->{to} <= $at; + last if $slot->{from} > $at; return $slot; } return; } +sub _partition_slots { + my ($self,$from,$to) = @_; + + my (@before,@overlap,@after); + my $st=$self->_storage; + + keys @$st; + + while (my ($idx,$slot) = each @$st) { + my ($sf,$st) = @$slot{'from','to'}; + + if ($st<$from) { + push @before,$idx; + } + elsif ($sf>=$to) { + push @after,$idx; + } + else { + push @overlap,$idx; + } + } + return \@before,\@overlap,\@after; +} + sub set_or_create { my ($self,$args) = @_; - my $from = $args->{from}; - my $to = $args->{to}; + my $from = $args->{from} // 0-'inf'; + my $to = $args->{to} // 0+'inf'; + + Data::TagsAndRanges::Exceptions::BadRange->({ + from => $from, + to => $to, + }) if $from > $to; my ($range) = $self->_get_slot_at($from); - if ($range && _cmp_eq($range->{from},$from) && _cmp_eq($range->{to},$to)) { + if ($range && $range->{from}==$from && $range->{to}==$to) { return $range; } @@ -80,12 +93,61 @@ sub set_or_create { sub _create_slot { my ($self,$from,$to) = @_; - push @{$self->_storage},{ + my $new = { from => $from, to => $to, value => undef, }; - return $self->_storage->[-1]; + + if (!@{$self->_storage}) { # empty + push @{$self->_storage},$new; + return $new; + } + + my ($before,$overlap,$after) = $self->_partition_slots($from,$to); + + if (!@$before && !@$overlap) { + unshift @{$self->_storage},$new; + return $new; + } + if (!@$after && !@$overlap) { + push @{$self->_storage},$new; + return $new; + } + + # by costruction, the first and the last may have to be split, all + # others must be removed + my $first_to_replace = $overlap->[0], + my $last_to_replace = $overlap->[-1], + my $how_many = @$overlap; + + my @replacement = ($new); + + if ($how_many > 0) { # we have to splice + my $first = $self->_storage->[$first_to_replace]; + my $last = $self->_storage->[$last_to_replace]; + + if ($first->{from} < $from && $first->{to} >= $from) { + unshift @replacement, { + from => $first->{from}, + to => $from, + value => $first->{value}, + } + } + if ($last->{from} < $to && $last->{to} >= $to) { + push @replacement, { + from => $to, + to => $last->{to}, + value => $last->{value}, + } + } + } + + splice @{$self->_storage}, + $first_to_replace,$how_many, + @replacement; + + return $new; } 1; |