diff options
Diffstat (limited to 'Data-MultiValued/lib/Data')
5 files changed, 361 insertions, 0 deletions
diff --git a/Data-MultiValued/lib/Data/MultiValued.pm b/Data-MultiValued/lib/Data/MultiValued.pm new file mode 100644 index 0000000..65b041d --- /dev/null +++ b/Data-MultiValued/lib/Data/MultiValued.pm @@ -0,0 +1,54 @@ +package Data::MultiValued; +use Moose; +use MooseX::Params::Validate; +use Moose::Util::TypeConstraints; +use MooseX::Types::Moose qw(Num Str Undef Any); +use Data::MultiValued::Exceptions; +use Data::MultiValued::TagContainerForRanges; + +# ABSTRACT: Handle values with tags and validity ranges + +has _storage => ( + is => 'rw', + isa => class_type('Data::MultiValued::TagContainerForRanges'), + init_arg => undef, + lazy_build => 1, +); + +sub _build__storage { + Data::MultiValued::TagContainerForRanges->new(); +} + +sub set { + my ($self,%args) = validated_hash( + \@_, + from => { isa => Num|Undef, optional => 1, }, + to => { isa => Num|Undef, optional => 1, }, + tag => { isa => Str, optional => 1, }, + value => { isa => Any, }, + ); + + $self->_storage->get_or_create(\%args) + ->set_or_create(\%args) + ->{value} = $args{value}; +} + +sub get { + my ($self,%args) = validated_hash( + \@_, + at => { isa => Num|Undef, optional => 1, }, + tag => { isa => Str, optional => 1, }, + ); + + $self->_storage->get(\%args) + ->get(\%args) + ->{value}; +} + +sub clear { + my ($self) = @_; + + $self->_clear_storage; +} + +1; diff --git a/Data-MultiValued/lib/Data/MultiValued/Exceptions.pm b/Data-MultiValued/lib/Data/MultiValued/Exceptions.pm new file mode 100644 index 0000000..571db0a --- /dev/null +++ b/Data-MultiValued/lib/Data/MultiValued/Exceptions.pm @@ -0,0 +1,57 @@ +package Data::MultiValued::Exceptions; +package Data::MultiValued::Exceptions::NotFound;{ +use Moose; +extends 'Throwable::Error'; + +has value => ( + is => 'ro', + required => 1, +); + +sub as_string { + my ($self) = @_; + + my $str = $self->message . $self->value; + $str .= "\n\n" . $self->stack_trace->as_string; + + return $str; +} + +} +package Data::MultiValued::Exceptions::TagNotFound;{ +use Moose; +extends 'Data::MultiValued::Exceptions::NotFound'; + +has '+message' => ( + default => 'tag not found: ', +); +} +package Data::MultiValued::Exceptions::RangeNotFound;{ +use Moose; +extends 'Data::MultiValued::Exceptions::NotFound'; + +has '+message' => ( + default => 'no range found for value ', +); +} +package Data::MultiValued::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-MultiValued/lib/Data/MultiValued/RangeContainer.pm b/Data-MultiValued/lib/Data/MultiValued/RangeContainer.pm new file mode 100644 index 0000000..5c4fb3a --- /dev/null +++ b/Data-MultiValued/lib/Data/MultiValued/RangeContainer.pm @@ -0,0 +1,153 @@ +package Data::MultiValued::RangeContainer; +use Moose; +use Moose::Util::TypeConstraints; +use MooseX::Types::Moose qw(Num Str Any Undef ArrayRef); +use MooseX::Types::Structured qw(Dict); +use Data::MultiValued::Exceptions; + +has _storage => ( + is => 'rw', + isa => ArrayRef[ + Dict[ + from => Num, + to => Num, + value => Any, + ], + ], + init_arg => undef, + default => sub { [ ] }, +); + +sub get { + my ($self,$args) = @_; + + my $at = $args->{at} // 0-'inf'; + + my ($range) = $self->_get_slot_at($at); + + if (!$range) { + Data::MultiValued::Exceptions::RangeNotFound->throw({ + value => $at, + }); + } + + return $range; +} + +sub _get_slot_at { + my ($self,$at) = @_; + + for my $slot (@{$self->_storage}) { + 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} // 0-'inf'; + my $to = $args->{to} // 0+'inf'; + + Data::MultiValued::Exceptions::BadRange->({ + from => $from, + to => $to, + }) if $from > $to; + + my ($range) = $self->_get_slot_at($from); + + if ($range && $range->{from}==$from && $range->{to}==$to) { + return $range; + } + + $range = $self->_create_slot($from,$to); + return $range; +} + +sub _create_slot { + my ($self,$from,$to) = @_; + + my $new = { + from => $from, + to => $to, + value => undef, + }; + + 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-MultiValued/lib/Data/MultiValued/TagContainer.pm b/Data-MultiValued/lib/Data/MultiValued/TagContainer.pm new file mode 100644 index 0000000..e0c7f4f --- /dev/null +++ b/Data-MultiValued/lib/Data/MultiValued/TagContainer.pm @@ -0,0 +1,76 @@ +package Data::MultiValued::TagContainer; +use Moose; +use Moose::Util::TypeConstraints; +use MooseX::Types::Moose qw(HashRef); +use Data::MultiValued::Exceptions; + +has _storage => ( + is => 'rw', + isa => HashRef, + init_arg => undef, + default => sub { { } }, + traits => ['Hash'], + handles => { + _has_tag => 'exists', + _get_tag => 'get', + _create_tag => 'set', + }, +); + +has _default_tag => ( + is => 'rw', + init_arg => undef, + predicate => '_has_default_tag', +); + +sub get { + my ($self,$args) = @_; + + my $tag = $args->{tag}; + + if (!defined($tag)) { + if ($self->_has_default_tag) { + return $self->_default_tag; + } + + Data::MultiValued::Exceptions::TagNotFound->throw({ + value => $tag, + }); + } + + if (!$self->_has_tag($tag)) { + Data::MultiValued::Exceptions::TagNotFound->throw({ + value => $tag, + }); + } + return $self->_get_tag($tag); +} + +sub get_or_create { + my ($self,$args) = @_; + + my $tag = $args->{tag}; + + if (!defined($tag)) { + if ($self->_has_default_tag) { + return $self->_default_tag; + } + else { + return $self->_default_tag( + $self->_create_new_inferior + ); + } + } + + if (!$self->_has_tag($tag)) { + $self->_create_tag($tag,$self->_create_new_inferior); + } + return $self->_get_tag($tag); +} + +sub _create_new_inferior { + my ($self) = @_; + return {}; +} + +1; diff --git a/Data-MultiValued/lib/Data/MultiValued/TagContainerForRanges.pm b/Data-MultiValued/lib/Data/MultiValued/TagContainerForRanges.pm new file mode 100644 index 0000000..71fd7f9 --- /dev/null +++ b/Data-MultiValued/lib/Data/MultiValued/TagContainerForRanges.pm @@ -0,0 +1,21 @@ +package Data::MultiValued::TagContainerForRanges; +use Moose; +use MooseX::Types::Moose qw(HashRef); +use Moose::Util::TypeConstraints; +use Data::MultiValued::RangeContainer; + +extends 'Data::MultiValued::TagContainer'; + +has '+_storage' => ( + isa => HashRef[class_type('Data::MultiValued::RangeContainer')], +); + +has '+_default_tag' => ( + isa => class_type('Data::MultiValued::RangeContainer'), +); + +sub _create_new_inferior { + Data::MultiValued::RangeContainer->new(); +} + +1; |