From 04c994801b13d881b9a11dce6080f247af7ac1a9 Mon Sep 17 00:00:00 2001 From: Gianni Ceccarelli Date: Thu, 10 Nov 2011 12:11:38 +0000 Subject: json-ify, works everywhere MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit ranges now use 'undef' instead of infs… damn json infinity is not representable in json… --- .../lib/Data/MultiValued/AttributeTrait.pm | 23 +++++++++--- .../lib/Data/MultiValued/RangeContainer.pm | 43 +++++++++++++++------- Data-MultiValued/lib/Data/MultiValued/Ranges.pm | 13 +++++++ .../lib/Data/MultiValued/TagContainerForRanges.pm | 17 +++++++++ .../lib/Data/MultiValued/TagsAndRanges.pm | 14 +++++++ Data-MultiValued/t/json.t | 40 +++++++++++++------- 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; -- cgit v1.2.3