summaryrefslogtreecommitdiff
path: root/Data-MultiValued/lib/Data/MultiValued/RangeContainer.pm
diff options
context:
space:
mode:
authorGianni Ceccarelli <dakkar@thenautilus.net>2011-11-10 15:10:26 +0000
committerGianni Ceccarelli <dakkar@thenautilus.net>2011-11-10 15:10:26 +0000
commitdc07be4ac45756a0e664ee29e888f86b7609784a (patch)
treedca7e4467f73625604886e8910a609ccc978b0ce /Data-MultiValued/lib/Data/MultiValued/RangeContainer.pm
parent'clear' almost completely implemneted (diff)
downloaddata-multivalued-dc07be4ac45756a0e664ee29e888f86b7609784a.tar.gz
data-multivalued-dc07be4ac45756a0e664ee29e888f86b7609784a.tar.bz2
data-multivalued-dc07be4ac45756a0e664ee29e888f86b7609784a.zip
move up a level
Diffstat (limited to 'Data-MultiValued/lib/Data/MultiValued/RangeContainer.pm')
-rw-r--r--Data-MultiValued/lib/Data/MultiValued/RangeContainer.pm192
1 files changed, 0 insertions, 192 deletions
diff --git a/Data-MultiValued/lib/Data/MultiValued/RangeContainer.pm b/Data-MultiValued/lib/Data/MultiValued/RangeContainer.pm
deleted file mode 100644
index 474626f..0000000
--- a/Data-MultiValued/lib/Data/MultiValued/RangeContainer.pm
+++ /dev/null
@@ -1,192 +0,0 @@
-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|Undef,
- to => Num|Undef,
- value => Any,
- ],
- ],
- init_arg => undef,
- default => sub { [ ] },
-);
-
-sub get {
- my ($self,$args) = @_;
-
- my $at = $args->{at};
-
- my ($range) = $self->_get_slot_at($at);
-
- if (!$range) {
- Data::MultiValued::Exceptions::RangeNotFound->throw({
- value => $at,
- });
- }
-
- 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 _cmp($slot->{to},$at,1,0) <= 0;
- last if _cmp($slot->{from},$at,0,0) > 0;
- 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 (_cmp($st,$from,1,0) <0) {
- push @before,$idx;
- }
- elsif (_cmp($sf,$to,0,1) >=0) {
- 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};
-
- Data::MultiValued::Exceptions::BadRange->throw({
- from => $from,
- to => $to,
- }) if _cmp($from,$to,0,1)>0;
-
- my ($range) = $self->_get_slot_at($from);
-
- if ($range
- && _cmp($range->{from},$from,0,0)==0
- && _cmp($range->{to},$to,1,1)==0) {
- return $range;
- }
-
- $range = $self->_create_slot($from,$to);
- return $range;
-}
-
-sub clear {
- my ($self,$args) = @_;
-
- my $from = $args->{from};
- my $to = $args->{to};
-
- Data::MultiValued::Exceptions::BadRange->throw({
- from => $from,
- to => $to,
- }) if _cmp($from,$to,0,1)>0;
-
- return $self->_clear_slot($from,$to);
-}
-
-sub _create_slot {
- my ($self,$from,$to) = @_;
-
- $self->_splice_slot($from,$to,{
- from => $from,
- to => $to,
- value => undef,
- });
-}
-
-sub _clear_slot {
- my ($self,$from,$to) = @_;
-
- $self->_splice_slot($from,$to);
-}
-
-sub _splice_slot {
- my ($self,$from,$to,$new) = @_;
-
- if (!@{$self->_storage}) { # empty
- push @{$self->_storage},$new if $new;
- return $new;
- }
-
- my ($before,$overlap,$after) = $self->_partition_slots($from,$to);
-
- if (!@$before && !@$overlap) {
- unshift @{$self->_storage},$new if $new;
- return $new;
- }
- if (!@$after && !@$overlap) {
- push @{$self->_storage},$new if $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 ? ($new) : ();
-
- if ($how_many > 0) { # we have to splice
- my $first = $self->_storage->[$first_to_replace];
- my $last = $self->_storage->[$last_to_replace];
-
- 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 (_cmp($last->{from},$to,0,1)<=0
- && _cmp($last->{to},$to,1,1)>0) {
- push @replacement, {
- from => $to,
- to => $last->{to},
- value => $last->{value},
- }
- }
- }
-
- splice @{$self->_storage},
- $first_to_replace,$how_many,
- @replacement;
-
- return $new;
-}
-
-1;