renaming

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;