diff options
author | Gianni Ceccarelli <dakkar@thenautilus.net> | 2011-11-10 15:10:26 +0000 |
---|---|---|
committer | Gianni Ceccarelli <dakkar@thenautilus.net> | 2011-11-10 15:10:26 +0000 |
commit | dc07be4ac45756a0e664ee29e888f86b7609784a (patch) | |
tree | dca7e4467f73625604886e8910a609ccc978b0ce /Data-MultiValued/lib/Data/MultiValued/RangeContainer.pm | |
parent | 'clear' almost completely implemneted (diff) | |
download | data-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.pm | 192 |
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; |