overlapping ranges

also, use inifinites instead of magic undefs

3 files changed, 155 insertions, 26 deletions

diff --git a/Data-TagsAndRanges/lib/Data/TagsAndRanges/Exceptions.pm b/Data-TagsAndRanges/lib/Data/TagsAndRanges/Exceptions.pm
index c28824b..def6108 100644
--- a/Data-TagsAndRanges/lib/Data/TagsAndRanges/Exceptions.pm
+++ b/Data-TagsAndRanges/lib/Data/TagsAndRanges/Exceptions.pm
@@ -34,5 +34,24 @@ has '+message' => (
     default => 'no range found for value ',
 );
 }
+package Data::TagsAndRanges::Exceptions::BadRange;{
+use Moose;
+extends 'Throwable::Error';
+
+has ['from','to'] => ( is => 'ro', required => 1 );
+has '+message' => (
+    default => 'invalid range: ',
+);
+
+sub as_string {
+    my ($self) = @_;
+
+    my $str = $self->message . $self->from . ', ' . $self->to;
+    $str .= "\n\n" . $self->stack_trace->as_string;
+
+    return $str;
+}
+
+}
 
 1;
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;
diff --git a/Data-TagsAndRanges/t/overlapping-ranges.t b/Data-TagsAndRanges/t/overlapping-ranges.t
new file mode 100644
index 0000000..55355ef
--- /dev/null
+++ b/Data-TagsAndRanges/t/overlapping-ranges.t
@@ -0,0 +1,48 @@
+#!perl
+use strict;
+use warnings;
+use Test::Most 'die';
+use Data::Printer;
+use Data::TagsAndRanges;
+
+my $obj = Data::TagsAndRanges->new();
+ok($obj,'constructor works');
+
+$obj->set({
+    from=>10,
+    to=>20,
+    value=>1,
+});
+$obj->set({
+    from=>15,
+    to => 30,
+    value => 2,
+});
+
+my %points = (
+    10,1,
+    12,1,
+    13,1,
+    14,1,
+    15,2,
+    17,2,
+    19,2,
+    20,2,
+    25,2,
+    29,2,
+);
+while (my ($at,$v) = each %points) {
+    cmp_ok($obj->get({at=>$at}),
+           '==',
+           $v,
+           "value at $at");
+}
+
+dies_ok {
+    $obj->get({at=>30})
+} 'far end';
+dies_ok {
+    $obj->get({at=>9})
+} 'far end';
+
+done_testing();