summaryrefslogtreecommitdiff
path: root/lib
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 /lib
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 'lib')
-rw-r--r--lib/Data/MultiValued/AttributeAccessors.pm109
-rw-r--r--lib/Data/MultiValued/AttributeTrait.pm229
-rw-r--r--lib/Data/MultiValued/AttributeTrait/Ranges.pm14
-rw-r--r--lib/Data/MultiValued/AttributeTrait/Tags.pm14
-rw-r--r--lib/Data/MultiValued/AttributeTrait/TagsAndRanges.pm14
-rw-r--r--lib/Data/MultiValued/Exceptions.pm57
-rw-r--r--lib/Data/MultiValued/RangeContainer.pm192
-rw-r--r--lib/Data/MultiValued/Ranges.pm68
-rw-r--r--lib/Data/MultiValued/TagContainer.pm99
-rw-r--r--lib/Data/MultiValued/TagContainerForRanges.pm38
-rw-r--r--lib/Data/MultiValued/Tags.pm65
-rw-r--r--lib/Data/MultiValued/TagsAndRanges.pm79
-rw-r--r--lib/Data/MultiValued/UglySerializationHelperRole.pm35
13 files changed, 1013 insertions, 0 deletions
diff --git a/lib/Data/MultiValued/AttributeAccessors.pm b/lib/Data/MultiValued/AttributeAccessors.pm
new file mode 100644
index 0000000..cac3538
--- /dev/null
+++ b/lib/Data/MultiValued/AttributeAccessors.pm
@@ -0,0 +1,109 @@
+package Data::MultiValued::AttributeAccessors;
+use strict;
+use warnings;
+use base 'Moose::Meta::Method::Accessor';
+use Carp 'confess';
+
+sub _instance_is_inlinable { 0 }
+
+sub _generate_accessor_method {
+ my $self = shift;
+ my $attr = $self->associated_attribute;
+
+ return sub {
+ if (@_ >= 2) {
+ $attr->set_multi_value($_[0], {}, $_[1]);
+ }
+ $attr->get_multi_value($_[0], {});
+ }
+}
+
+sub _generate_reader_method {
+ my $self = shift;
+ my $attr = $self->associated_attribute;
+
+ return sub {
+ confess "Cannot assign a value to a read-only accessor"
+ if @_ > 1;
+ $attr->get_multi_value($_[0], {});
+ };
+}
+
+sub _generate_writer_method {
+ my $self = shift;
+ my $attr = $self->associated_attribute;
+
+ return sub {
+ $attr->set_multi_value($_[0], {}, $_[1]);
+ };
+}
+
+sub _generate_predicate_method {
+ my $self = shift;
+ my $attr = $self->associated_attribute;
+
+ return sub {
+ $attr->has_multi_value($_[0], {})
+ };
+}
+
+sub _generate_clearer_method {
+ my $self = shift;
+ my $attr = $self->associated_attribute;
+
+ return sub {
+ $attr->clear_multi_value($_[0], {})
+ };
+}
+
+sub _generate_multi_accessor_method {
+ my $self = shift;
+ my $attr = $self->associated_attribute;
+
+ return sub {
+ if (@_ >= 3) {
+ $attr->set_multi_value($_[0], $_[1], $_[2]);
+ }
+ $attr->get_multi_value($_[0],$_[1]);
+ }
+}
+
+sub _generate_multi_reader_method {
+ my $self = shift;
+ my $attr = $self->associated_attribute;
+
+ return sub {
+ confess "Cannot assign a value to a read-only accessor"
+ if @_ > 2;
+ $attr->get_multi_value($_[0],$_[1]);
+ };
+}
+
+sub _generate_multi_writer_method {
+ my $self = shift;
+ my $attr = $self->associated_attribute;
+
+ return sub {
+ $attr->set_multi_value($_[0], $_[1], $_[2]);
+ };
+}
+
+sub _generate_multi_predicate_method {
+ my $self = shift;
+ my $attr = $self->associated_attribute;
+
+ return sub {
+ $attr->has_multi_value($_[0],$_[1])
+ };
+}
+
+sub _generate_multi_clearer_method {
+ my $self = shift;
+ my $attr = $self->associated_attribute;
+
+ return sub {
+ $attr->clear_multi_value($_[0],$_[1])
+ };
+}
+
+1;
diff --git a/lib/Data/MultiValued/AttributeTrait.pm b/lib/Data/MultiValued/AttributeTrait.pm
new file mode 100644
index 0000000..91e1b13
--- /dev/null
+++ b/lib/Data/MultiValued/AttributeTrait.pm
@@ -0,0 +1,229 @@
+package Data::MultiValued::AttributeTrait;
+use Moose::Role;
+use Data::MultiValued::AttributeAccessors;
+use MooseX::Types::Moose qw(Str);
+use Try::Tiny;
+use namespace::autoclean;
+
+has 'full_storage_slot' => (
+ is => 'ro',
+ isa => Str,
+ lazy_build => 1,
+ init_arg => undef,
+);
+sub _build_full_storage_slot { shift->name . '__MULTIVALUED_STORAGE__' }
+
+requires 'multivalue_storage_class';
+requires 'opts_to_pass_set';
+requires 'opts_to_pass_get';
+
+around slots => sub {
+ my ($orig, $self) = @_;
+ return ($self->$orig(), $self->full_storage_slot);
+};
+
+sub set_full_storage {
+ my ($self,$instance) = @_;
+
+ my $ret = $self->multivalue_storage_class->new();
+ $self->associated_class->get_meta_instance->set_slot_value(
+ $instance,
+ $self->full_storage_slot,
+ $ret,
+ );
+ return $ret;
+}
+
+sub get_full_storage {
+ my ($self,$instance) = @_;
+
+ return $self->associated_class->get_meta_instance
+ ->get_slot_value(
+ $instance,
+ $self->full_storage_slot,
+ );
+}
+
+sub full_storage {
+ my ($self,$instance) = @_;
+
+ return $self->get_full_storage($instance)
+ || $self->set_full_storage($instance);
+}
+
+sub accessor_metaclass { 'Data::MultiValued::AttributeAccessors' }
+
+after install_accessors => sub {
+ my ($self) = @_;
+
+ my $class = $self->associated_class;
+
+ for my $meth (qw(accessor reader writer predicate clearer)) {
+ my $check = "has_$meth";
+ next unless $self->$check;
+
+ my $type = "multi_$meth";
+ my $basename = $self->$meth;
+
+ die 'MultiValued attribute trait is not compatible with subref accessors'
+ if ref($basename);
+
+ my $name = "${basename}_multi";
+
+ $class->add_method(
+ $self->_process_accessors($type => $name,0)
+ );
+ }
+};
+
+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 = _filter_opts($opts, $self->opts_to_pass_get);
+
+ my $value;my $found=1;
+ try {
+ $value = $self->full_storage($instance)->get($opts_passed);
+ }
+ catch {
+ unless (ref($_) && $_->isa('Data::MultiValued::Exceptions::NotFound')) {
+ die $_;
+ }
+ $found = 0;
+ };
+
+ if ($found) {
+ $self->set_raw_value($instance,$value);
+ }
+ else {
+ $self->raw_clear_value($instance);
+ }
+}
+
+sub raw_clear_value {
+ my ($self,$instance) = @_;
+
+ $self->associated_class->get_meta_instance
+ ->deinitialize_slot(
+ $instance,
+ $self->name,
+ );
+}
+
+sub store_multi_value {
+ my ($self,$instance,$opts) = @_;
+
+ my $opts_passed = _filter_opts($opts, $self->opts_to_pass_set);
+
+ $opts_passed->{value} = $self->get_raw_value($instance);
+
+ $self->full_storage($instance)->set($opts_passed);
+}
+
+our $dyn_opts = {};
+
+before get_value => sub {
+ my ($self,$instance) = @_;
+
+ $self->load_multi_value($instance,$dyn_opts);
+};
+
+sub get_multi_value {
+ my ($self,$instance,$opts,$value) = @_;
+
+ local $dyn_opts = $opts;
+
+ return $self->get_value($instance,$value);
+}
+
+after set_initial_value => sub {
+ my ($self,$instance,$value) = @_;
+
+ $self->store_multi_value($instance,$dyn_opts);
+};
+
+after set_value => sub {
+ my ($self,$instance,$value) = @_;
+
+ $self->store_multi_value($instance,$dyn_opts);
+};
+
+sub set_multi_value {
+ my ($self,$instance,$opts,$value) = @_;
+
+ local $dyn_opts = $opts;
+
+ return $self->set_value($instance,$value);
+}
+
+before has_value => sub {
+ my ($self,$instance) = @_;
+
+ $self->load_multi_value($instance,$dyn_opts);
+};
+
+sub has_multi_value {
+ my ($self,$instance,$opts) = @_;
+
+ local $dyn_opts = $opts;
+
+ return $self->has_value($instance);
+}
+
+after clear_value => sub {
+ my ($self,$instance) = @_;
+
+ $self->full_storage($instance)->clear($dyn_opts);
+ return;
+};
+
+sub clear_multi_value {
+ my ($self,$instance,$opts) = @_;
+
+ local $dyn_opts = $opts;
+
+ return $self->clear_value($instance);
+}
+
+sub get_multi_read_method {
+ my $self = shift;
+ return $self->get_read_method . '_multi';
+}
+
+sub get_multi_write_method {
+ my $self = shift;
+ return $self->get_write_method . '_multi';
+}
+
+sub _rebless_slot {
+ my ($self,$instance) = @_;
+
+ my $st = $self->get_full_storage($instance);
+ return unless $st;
+
+ bless $st, $self->multivalue_storage_class;
+ $st->_rebless_storage;
+}
+
+sub _as_hash {
+ my ($self,$instance) = @_;
+
+ my $st = $self->get_full_storage($instance);
+ return unless $st;
+
+ return $st->_as_hash;
+}
+
+1;
diff --git a/lib/Data/MultiValued/AttributeTrait/Ranges.pm b/lib/Data/MultiValued/AttributeTrait/Ranges.pm
new file mode 100644
index 0000000..8d93578
--- /dev/null
+++ b/lib/Data/MultiValued/AttributeTrait/Ranges.pm
@@ -0,0 +1,14 @@
+package Data::MultiValued::AttributeTrait::Ranges;
+use Moose::Role;
+use Data::MultiValued::Ranges;
+with 'Data::MultiValued::AttributeTrait';
+
+sub multivalue_storage_class { 'Data::MultiValued::Ranges' };
+sub opts_to_pass_set { qw(from to) }
+sub opts_to_pass_get { qw(at) }
+
+package Moose::Meta::Attribute::Custom::Trait::MultiValued::Ranges;{
+sub register_implementation { 'Data::MultiValued::AttributeTrait::Ranges' }
+}
+
+1;
diff --git a/lib/Data/MultiValued/AttributeTrait/Tags.pm b/lib/Data/MultiValued/AttributeTrait/Tags.pm
new file mode 100644
index 0000000..7cffb33
--- /dev/null
+++ b/lib/Data/MultiValued/AttributeTrait/Tags.pm
@@ -0,0 +1,14 @@
+package Data::MultiValued::AttributeTrait::Tags;
+use Moose::Role;
+use Data::MultiValued::Tags;
+with 'Data::MultiValued::AttributeTrait';
+
+sub multivalue_storage_class { 'Data::MultiValued::Tags' };
+sub opts_to_pass_set { qw(tag) }
+sub opts_to_pass_get { qw(tag) }
+
+package Moose::Meta::Attribute::Custom::Trait::MultiValued::Tags;{
+sub register_implementation { 'Data::MultiValued::AttributeTrait::Tags' }
+}
+
+1;
diff --git a/lib/Data/MultiValued/AttributeTrait/TagsAndRanges.pm b/lib/Data/MultiValued/AttributeTrait/TagsAndRanges.pm
new file mode 100644
index 0000000..e0c56cd
--- /dev/null
+++ b/lib/Data/MultiValued/AttributeTrait/TagsAndRanges.pm
@@ -0,0 +1,14 @@
+package Data::MultiValued::AttributeTrait::TagsAndRanges;
+use Moose::Role;
+use Data::MultiValued::TagsAndRanges;
+with 'Data::MultiValued::AttributeTrait';
+
+sub multivalue_storage_class { 'Data::MultiValued::TagsAndRanges' };
+sub opts_to_pass_set { qw(from to tag) }
+sub opts_to_pass_get { qw(at tag) }
+
+package Moose::Meta::Attribute::Custom::Trait::MultiValued::TagsAndRanges;{
+sub register_implementation { 'Data::MultiValued::AttributeTrait::TagsAndRanges' }
+}
+
+1;
diff --git a/lib/Data/MultiValued/Exceptions.pm b/lib/Data/MultiValued/Exceptions.pm
new file mode 100644
index 0000000..8d444c0
--- /dev/null
+++ b/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 // '<undef>');
+ $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/lib/Data/MultiValued/RangeContainer.pm b/lib/Data/MultiValued/RangeContainer.pm
new file mode 100644
index 0000000..474626f
--- /dev/null
+++ b/lib/Data/MultiValued/RangeContainer.pm
@@ -0,0 +1,192 @@
+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;
diff --git a/lib/Data/MultiValued/Ranges.pm b/lib/Data/MultiValued/Ranges.pm
new file mode 100644
index 0000000..9c69626
--- /dev/null
+++ b/lib/Data/MultiValued/Ranges.pm
@@ -0,0 +1,68 @@
+package Data::MultiValued::Ranges;
+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::RangeContainer;
+
+# ABSTRACT: Handle values with tags and validity ranges
+
+has _storage => (
+ is => 'rw',
+ isa => class_type('Data::MultiValued::RangeContainer'),
+ init_arg => undef,
+ lazy_build => 1,
+);
+
+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(
+ \@_,
+ from => { isa => Num|Undef, optional => 1, },
+ to => { isa => Num|Undef, optional => 1, },
+ value => { isa => Any, },
+ );
+
+ $self->_storage->set_or_create(\%args)
+ ->{value} = $args{value};
+}
+
+sub get {
+ my ($self,%args) = validated_hash(
+ \@_,
+ at => { isa => Num|Undef, optional => 1, },
+ );
+
+ $self->_storage->get(\%args)
+ ->{value};
+}
+
+sub clear {
+ my ($self,%args) = validated_hash(
+ \@_,
+ from => { isa => Num|Undef, optional => 1, },
+ to => { isa => Num|Undef, optional => 1, },
+ );
+
+ $self->_storage->clear(\%args);
+}
+
+
+1;
diff --git a/lib/Data/MultiValued/TagContainer.pm b/lib/Data/MultiValued/TagContainer.pm
new file mode 100644
index 0000000..cdd0456
--- /dev/null
+++ b/lib/Data/MultiValued/TagContainer.pm
@@ -0,0 +1,99 @@
+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',
+ _delete_tag => 'delete',
+ },
+);
+
+has _default_tag => (
+ is => 'rw',
+ init_arg => undef,
+ predicate => '_has_default_tag',
+ clearer => '_clear_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 _clear_storage {
+ my ($self) = @_;
+
+ $self->_storage({});
+}
+
+sub clear {
+ my ($self,$args) = @_;
+
+ my $tag = $args->{tag};
+
+ if (!defined($tag)) {
+ $self->_clear_default_tag;
+ $self->_clear_storage;
+ }
+ elsif ($self->_has_tag($tag)) {
+ $self->_delete_tag($tag);
+ }
+ return;
+}
+
+sub _create_new_inferior {
+ my ($self) = @_;
+ return {};
+}
+
+1;
diff --git a/lib/Data/MultiValued/TagContainerForRanges.pm b/lib/Data/MultiValued/TagContainerForRanges.pm
new file mode 100644
index 0000000..d3cd4b9
--- /dev/null
+++ b/lib/Data/MultiValued/TagContainerForRanges.pm
@@ -0,0 +1,38 @@
+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();
+}
+
+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/lib/Data/MultiValued/Tags.pm b/lib/Data/MultiValued/Tags.pm
new file mode 100644
index 0000000..fbf7948
--- /dev/null
+++ b/lib/Data/MultiValued/Tags.pm
@@ -0,0 +1,65 @@
+package Data::MultiValued::Tags;
+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::TagContainer;
+
+# ABSTRACT: Handle values with tags and validity ranges
+
+has _storage => (
+ is => 'rw',
+ isa => class_type('Data::MultiValued::TagContainer'),
+ init_arg => undef,
+ lazy_build => 1,
+);
+
+sub _build__storage {
+ Data::MultiValued::TagContainer->new();
+}
+
+sub _rebless_storage {
+ my ($self) = @_;
+
+ bless $self->{_storage},'Data::MultiValued::TagContainer';
+}
+
+sub _as_hash {
+ my ($self) = @_;
+
+ my %ret = %{$self->_storage};
+ return {_storage=>\%ret};
+}
+
+sub set {
+ my ($self,%args) = validated_hash(
+ \@_,
+ tag => { isa => Str, optional => 1, },
+ value => { isa => Any, },
+ );
+
+ $self->_storage->get_or_create(\%args)
+ ->{value} = $args{value};
+}
+
+sub get {
+ my ($self,%args) = validated_hash(
+ \@_,
+ tag => { isa => Str, optional => 1, },
+ );
+
+ $self->_storage->get(\%args)
+ ->{value};
+}
+
+sub clear {
+ my ($self,%args) = validated_hash(
+ \@_,
+ tag => { isa => Str, optional => 1, },
+ );
+
+ $self->_storage->clear(\%args);
+}
+
+1;
diff --git a/lib/Data/MultiValued/TagsAndRanges.pm b/lib/Data/MultiValued/TagsAndRanges.pm
new file mode 100644
index 0000000..6208435
--- /dev/null
+++ b/lib/Data/MultiValued/TagsAndRanges.pm
@@ -0,0 +1,79 @@
+package Data::MultiValued::TagsAndRanges;
+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 _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(
+ \@_,
+ 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,%args) = validated_hash(
+ \@_,
+ from => { isa => Num|Undef, optional => 1, },
+ to => { isa => Num|Undef, optional => 1, },
+ tag => { isa => Str, optional => 1, },
+ );
+
+ if (exists $args{from} || exists $args{to}) {
+ $self->_storage->get(\%args)
+ ->clear(\%args);
+ }
+ else {
+ $self->_storage->clear(\%args);
+ }
+}
+
+1;
diff --git a/lib/Data/MultiValued/UglySerializationHelperRole.pm b/lib/Data/MultiValued/UglySerializationHelperRole.pm
new file mode 100644
index 0000000..e586dec
--- /dev/null
+++ b/lib/Data/MultiValued/UglySerializationHelperRole.pm
@@ -0,0 +1,35 @@
+package Data::MultiValued::UglySerializationHelperRole;
+use Moose::Role;
+
+sub new_in_place {
+ my ($class,$hash) = @_;
+
+ my $self = bless $hash,$class;
+
+ for my $attr ($class->meta->get_all_attributes) {
+ if ($attr->does('Data::MultiValued::AttributeTrait')) {
+ $attr->_rebless_slot($self);
+ }
+ }
+ return $self;
+}
+
+sub as_hash {
+ my ($self) = @_;
+
+ my %ret = %$self;
+ for my $attr ($self->meta->get_all_attributes) {
+ if ($attr->does('Data::MultiValued::AttributeTrait')) {
+ my $st = $attr->_as_hash($self);
+ if ($st) {
+ $ret{$attr->full_storage_slot} = $st;
+ }
+ else {
+ delete $ret{$attr->full_storage_slot};
+ }
+ }
+ }
+ return \%ret;
+}
+
+1;