json-ify, works everywhere

ranges now use 'undef' instead of infs… damn json
infinity is not representable in json…

6 files changed, 117 insertions, 33 deletions

diff --git a/Data-MultiValued/lib/Data/MultiValued/AttributeTrait.pm b/Data-MultiValued/lib/Data/MultiValued/AttributeTrait.pm
index 32b40bb..060aa5a 100644
--- a/Data-MultiValued/lib/Data/MultiValued/AttributeTrait.pm
+++ b/Data-MultiValued/lib/Data/MultiValued/AttributeTrait.pm
@@ -76,14 +76,26 @@ after install_accessors => sub {
     }
 };
 
+sub _filter_opts {
+    my ($hr,@fields) = @_;
+
+    my %ret;
+    for my $f (@fields) {
+        if (exists $hr->{$f}) {
+            $ret{$f}=$hr->{$f};
+        }
+    }
+    return \%ret;
+}
+
 sub load_multi_value {
     my ($self,$instance,$opts) = @_;
 
-    my %opts_passed = map { $_ => $opts->{$_} } $self->opts_to_pass_get;
+    my $opts_passed = _filter_opts($opts, $self->opts_to_pass_get);
 
     my $value;my $found=1;
     try {
-        $value = $self->full_storage($instance)->get(\%opts_passed);
+        $value = $self->full_storage($instance)->get($opts_passed);
     }
     catch {
         unless (ref($_) && $_->isa('Data::MultiValued::Exceptions::NotFound')) {
@@ -113,10 +125,11 @@ sub raw_clear_value {
 sub store_multi_value {
     my ($self,$instance,$opts) = @_;
 
-    my %opts_passed = map { $_ => $opts->{$_} } $self->opts_to_pass_set;
+    my $opts_passed = _filter_opts($opts, $self->opts_to_pass_set);
+
+    $opts_passed->{value} = $self->get_raw_value($instance);
 
-    my $value = $self->get_raw_value($instance);
-    $self->full_storage($instance)->set({%opts_passed,value=>$value});
+    $self->full_storage($instance)->set($opts_passed);
 }
 
 our $dyn_opts = {};
diff --git a/Data-MultiValued/lib/Data/MultiValued/RangeContainer.pm b/Data-MultiValued/lib/Data/MultiValued/RangeContainer.pm
index 5c4fb3a..33864da 100644
--- a/Data-MultiValued/lib/Data/MultiValued/RangeContainer.pm
+++ b/Data-MultiValued/lib/Data/MultiValued/RangeContainer.pm
@@ -9,8 +9,8 @@ has _storage => (
     is => 'rw',
     isa => ArrayRef[
         Dict[
-            from => Num,
-            to => Num,
+            from => Num|Undef,
+            to => Num|Undef,
             value => Any,
         ],
     ],
@@ -21,7 +21,7 @@ has _storage => (
 sub get {
     my ($self,$args) = @_;
 
-    my $at = $args->{at} // 0-'inf';
+    my $at = $args->{at};
 
     my ($range) = $self->_get_slot_at($at);
 
@@ -34,12 +34,23 @@ sub get {
     return $range;
 }
 
+# Num|Undef,Num|Undef,Bool,Bool
+# the bools mean "treat the undef as +inf" (-inf when omitted/false)
+sub _cmp {
+    my ($a,$b,$sa,$sb) = @_;
+
+    $a //= $sa ? 0+'inf' : 0-'inf';
+    $b //= $sb ? 0+'inf' : 0-'inf';
+
+    return $a <=> $b;
+}
+
 sub _get_slot_at {
     my ($self,$at) = @_;
 
     for my $slot (@{$self->_storage}) {
-        next if $slot->{to} <= $at;
-        last if $slot->{from} > $at;
+        next if _cmp($slot->{to},$at,1,0) <= 0;
+        last if _cmp($slot->{from},$at,0,0) > 0;
         return $slot;
     }
     return;
@@ -56,10 +67,10 @@ sub _partition_slots {
     while (my ($idx,$slot) = each @$st) {
         my ($sf,$st) = @$slot{'from','to'};
 
-        if ($st<$from) {
+        if (_cmp($st,$from,1,0) <0) {
             push @before,$idx;
         }
-        elsif ($sf>=$to) {
+        elsif (_cmp($sf,$to,0,1) >=0) {
             push @after,$idx;
         }
         else {
@@ -72,17 +83,19 @@ sub _partition_slots {
 sub set_or_create {
     my ($self,$args) = @_;
 
-    my $from = $args->{from} // 0-'inf';
-    my $to = $args->{to} // 0+'inf';
+    my $from = $args->{from};
+    my $to = $args->{to};
 
-    Data::MultiValued::Exceptions::BadRange->({
+    Data::MultiValued::Exceptions::BadRange->throw({
         from => $from,
         to => $to,
-    }) if $from > $to;
+    }) if _cmp($from,$to,0,1)>0;
 
     my ($range) = $self->_get_slot_at($from);
 
-    if ($range && $range->{from}==$from && $range->{to}==$to) {
+    if ($range
+        && _cmp($range->{from},$from,0,0)==0
+        && _cmp($range->{to},$to,1,1)==0) {
         return $range;
     }
 
@@ -127,14 +140,16 @@ sub _create_slot {
         my $first = $self->_storage->[$first_to_replace];
         my $last = $self->_storage->[$last_to_replace];
 
-        if ($first->{from} < $from && $first->{to} >= $from) {
+        if (_cmp($first->{from},$from,0,0)<0
+            && _cmp($first->{to},$from,1,0)>=0) {
             unshift @replacement, {
                 from => $first->{from},
                 to => $from,
                 value => $first->{value},
             }
         }
-        if ($last->{from} < $to && $last->{to} >= $to) {
+        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 b2acdd4..25a1eec 100644
--- a/Data-MultiValued/lib/Data/MultiValued/Ranges.pm
+++ b/Data-MultiValued/lib/Data/MultiValued/Ranges.pm
@@ -19,6 +19,19 @@ sub _build__storage {
     Data::MultiValued::RangeContainer->new();
 }
 
+sub _rebless_storage {
+    my ($self) = @_;
+
+    bless $self->{_storage},'Data::MultiValued::RangeContainer';
+}
+
+sub _as_hash {
+    my ($self) = @_;
+
+    my %ret = %{$self->_storage};
+    return {_storage=>\%ret};
+}
+
 sub set {
     my ($self,%args) = validated_hash(
         \@_,
diff --git a/Data-MultiValued/lib/Data/MultiValued/TagContainerForRanges.pm b/Data-MultiValued/lib/Data/MultiValued/TagContainerForRanges.pm
index 71fd7f9..d3cd4b9 100644
--- a/Data-MultiValued/lib/Data/MultiValued/TagContainerForRanges.pm
+++ b/Data-MultiValued/lib/Data/MultiValued/TagContainerForRanges.pm
@@ -18,4 +18,21 @@ sub _create_new_inferior {
     Data::MultiValued::RangeContainer->new();
 }
 
+sub _rebless_storage {
+    my ($self) = @_;
+    bless $self->{_storage},'Data::MultiValued::RangeContainer';
+    bless $self->{_default_tag},'Data::MultiValued::RangeContainer';
+    return;
+}
+
+sub _as_hash {
+    my ($self) = @_;
+    my %st = %{$self->_storage};
+    my %dt = %{$self->_default_tag};
+    return {
+        _storage => \%st,
+        _default_tag => \%dt,
+    };
+}
+
 1;
diff --git a/Data-MultiValued/lib/Data/MultiValued/TagsAndRanges.pm b/Data-MultiValued/lib/Data/MultiValued/TagsAndRanges.pm
index e940449..82e3271 100644
--- a/Data-MultiValued/lib/Data/MultiValued/TagsAndRanges.pm
+++ b/Data-MultiValued/lib/Data/MultiValued/TagsAndRanges.pm
@@ -19,6 +19,20 @@ sub _build__storage {
     Data::MultiValued::TagContainerForRanges->new();
 }
 
+sub _rebless_storage {
+    my ($self) = @_;
+
+    bless $self->{_storage},'Data::MultiValued::TagContainerForRanges';
+    $self->_storage->_rebless_storage;
+}
+
+sub _as_hash {
+    my ($self) = @_;
+
+    my $ret = $self->_storage->_as_hash;
+    return {_storage=>$ret};
+}
+
 sub set {
     my ($self,%args) = validated_hash(
         \@_,
diff --git a/Data-MultiValued/t/json.t b/Data-MultiValued/t/json.t
index 432ac69..ed3a31a 100644
--- a/Data-MultiValued/t/json.t
+++ b/Data-MultiValued/t/json.t
@@ -4,23 +4,34 @@ use warnings;
 package Foo;{
 use Moose;
 use Data::MultiValued::AttributeTrait::Tags;
+use Data::MultiValued::AttributeTrait::Ranges;
+use Data::MultiValued::AttributeTrait::TagsAndRanges;
 use Data::Printer;
 
-has stuff => (
+has tt => (
     is => 'rw',
     isa => 'Int',
     traits => ['MultiValued::Tags'],
     default => 3,
-    predicate => 'has_stuff',
-    clearer => 'clear_stuff',
+    predicate => 'has_tt',
+    clearer => 'clear_tt',
 );
 
-has other => (
+has rr => (
     is => 'rw',
     isa => 'Str',
-    traits => ['MultiValued::Tags'],
-    predicate => 'has_other',
-    clearer => 'clear_other',
+    traits => ['MultiValued::Ranges'],
+    predicate => 'has_rr',
+    clearer => 'clear_rr',
+);
+
+has ttrr => (
+    is => 'rw',
+    isa => 'Str',
+    default => 'default',
+    traits => ['MultiValued::TagsAndRanges'],
+    predicate => 'has_ttrr',
+    clearer => 'clear_ttrr',
 );
 
 sub new_in_place {
@@ -29,7 +40,7 @@ sub new_in_place {
     my $self = bless $hash,$class;
 
     for my $attr ($class->meta->get_all_attributes) {
-        if ($attr->does('MultiValued::Tags')) {
+        if ($attr->does('Data::MultiValued::AttributeTrait')) {
             $attr->_rebless_slot($self);
         }
     }
@@ -41,7 +52,7 @@ sub as_hash {
 
     my %ret = %$self;
     for my $attr ($self->meta->get_all_attributes) {
-        if ($attr->does('MultiValued::Tags')) {
+        if ($attr->does('Data::MultiValued::AttributeTrait')) {
             my $st = $attr->_as_hash($self);
             if ($st) {
                 $ret{$attr->full_storage_slot} = $st;
@@ -63,11 +74,12 @@ use JSON::XS;
 my $opts={tag=>'something'};
 
 my $json = JSON::XS->new->utf8;
-my $obj = Foo->new(other=>'foo');
-$obj->stuff_multi($opts,1234);
+my $obj = Foo->new(rr=>'foo');
+$obj->tt_multi($opts,1234);
 my $hash = $obj->as_hash;
 note p $hash;
 my $str = $json->encode($hash);
+note p $str;
 
 note "rebuilding";
 my $obj2 = Foo->new_in_place($json->decode($str));
@@ -75,8 +87,8 @@ my $obj2 = Foo->new_in_place($json->decode($str));
 note p $obj;
 note p $obj2;
 
-is($obj2->stuff,$obj->stuff,'stuff');
-is($obj2->stuff_multi($opts),$obj->stuff_multi($opts),'stuff tagged');
-is($obj2->other,$obj->other,'other');
+is($obj2->tt,$obj->tt,'tt');
+is($obj2->tt_multi($opts),$obj->tt_multi($opts),'tt tagged');
+is($obj2->rr,$obj->rr,'rr');
 
 done_testing;