summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGianni Ceccarelli <dakkar@thenautilus.net>2011-11-14 14:48:16 +0000
committerGianni Ceccarelli <dakkar@thenautilus.net>2011-11-14 17:00:15 +0000
commit65e5ad0900633186a52431a19839cbd14b2ec5aa (patch)
treed1b4c5bd9fd4b78c630e1b3bdab23b9e43207ed4
parentallow (and test) custom-named multi accessors (diff)
downloaddata-multivalued-65e5ad0900633186a52431a19839cbd14b2ec5aa.tar.gz
data-multivalued-65e5ad0900633186a52431a19839cbd14b2ec5aa.tar.bz2
data-multivalued-65e5ad0900633186a52431a19839cbd14b2ec5aa.zip
documentation
-rw-r--r--dist.ini2
-rw-r--r--lib/Data/MultiValued.pod70
-rw-r--r--lib/Data/MultiValued/AttributeTrait.pm261
-rw-r--r--lib/Data/MultiValued/AttributeTrait/Ranges.pm37
-rw-r--r--lib/Data/MultiValued/AttributeTrait/Tags.pm37
-rw-r--r--lib/Data/MultiValued/AttributeTrait/TagsAndRanges.pm37
-rw-r--r--lib/Data/MultiValued/RangeContainer.pm83
-rw-r--r--lib/Data/MultiValued/Ranges.pm142
-rw-r--r--lib/Data/MultiValued/TagContainer.pm66
-rw-r--r--lib/Data/MultiValued/TagContainerForRanges.pm39
-rw-r--r--lib/Data/MultiValued/Tags.pm103
-rw-r--r--lib/Data/MultiValued/TagsAndRanges.pm102
-rw-r--r--lib/Data/MultiValued/UglySerializationHelperRole.pm78
13 files changed, 1016 insertions, 41 deletions
diff --git a/dist.ini b/dist.ini
index a84f6f2..8ac2925 100644
--- a/dist.ini
+++ b/dist.ini
@@ -6,6 +6,8 @@ copyright_year = 2011
abstract = Handle values with tags and validity ranges
+main_module = lib/Data/MultiValued.pod
+
[GatherDir]
[PodWeaver]
diff --git a/lib/Data/MultiValued.pod b/lib/Data/MultiValued.pod
new file mode 100644
index 0000000..ebae360
--- /dev/null
+++ b/lib/Data/MultiValued.pod
@@ -0,0 +1,70 @@
+# PODNAME: Data::MultiValued
+# ABSTRACT: store tag- and range-dependant data in a scalar or Moose attribute
+
+=head1 SYNOPSIS
+
+ use Data::MultiValued::Tags;
+
+ my $obj = Data::MultiValued::Tags->new();
+ $obj->set({
+ tag => 'tag1',
+ value => 'a string',
+ });
+ say $obj->get({tag=>'tag1'}); # prints 'a string'
+ say $obj->get({tag=>'tag2'}); # dies
+
+Also:
+
+ package My::Class;
+ use Moose;
+ use Data::MultiValued::AttributeTrait::Tags;
+
+ has stuff => (
+ is => 'rw',
+ isa => 'Int',
+ traits => ['MultiValued::Tags'],
+ );
+
+ # later
+
+ my $obj = My::Class->new();
+ $obj->stuff_multi({tag=>'tag1'},123);
+ say $obj->stuff_multi({tag=>'tag1'}); # prints 123
+
+=head1 DESCRIPTION
+
+This set of classes allows you to store different values inside a
+single object, and access them by tag and / or by a numeric value.
+
+Yes, you could do the same with hashes and some clever use of
+arrays. Or you could use L<Array::IntSpan>. Or some other CPAN
+module. Why use these?
+
+=over 4
+
+=item *
+
+they are optimised for serialisation, see
+L<Data::MultiValued::UglySerializationHelperRole> and F<t/json.t>.
+
+=item *
+
+you get accessors generated for your Moose attributes just by setting
+a trait
+
+=item *
+
+tags and ranges interact in sensible ways, including clearing ranges
+
+=back
+
+=head1 Where to go from here
+
+Look at the tests for detailed examples of usage. Look at
+L<Data::MultiValued::Tags>, L<Data::MultiValued::Ranges> and
+L<Data::MultiValued::TagsAndRanges> for the containers
+themselves. Look at L<Data::MultiValued::AttributeTrait::Tags>,
+L<Data::MultiValued::AttributeTrait::Ranges> and
+L<Data::MultiValued::AttributeTrait::TagsAndRanges> for the Moose
+attribute traits.
+
diff --git a/lib/Data/MultiValued/AttributeTrait.pm b/lib/Data/MultiValued/AttributeTrait.pm
index cd81c33..589a1ae 100644
--- a/lib/Data/MultiValued/AttributeTrait.pm
+++ b/lib/Data/MultiValued/AttributeTrait.pm
@@ -5,6 +5,49 @@ use MooseX::Types::Moose qw(Str);
use Try::Tiny;
use namespace::autoclean;
+# ABSTRACT: "base role" for traits of multi-valued Moose attributes
+
+=head1 DESCRIPTION
+
+Don't use this role directly, use
+L<Data::MultiValued::AttributeTrait::Tags>,
+L<Data::MultiValued::AttributeTrait::Ranges> or
+L<Data::MultiValued::AttributeTrait::TagsAndRanges>.
+
+This role (together with L<Data::MultiValued::AttributeAccessors>)
+defines all the basic plumbing to glue C<Data::MultiValued::Tags> etc
+into Moose attributes.
+
+=head1 Implementation details
+
+The multi-value object is stored in the instance slot named by the
+L</full_storage_slot> attribute attribute. C<before> modifiers on
+getters load the appropriate value from the multi-value object into
+the regular instance slot, C<after> modifiers on setters store the
+value from the regular instance slot into the multi-value object.
+
+=head1 ATTRIBUTES
+
+These are the attributes that this trait adds to the attribute in
+your class. Example:
+
+ has stuff => (
+ is => 'rw',
+ isa => 'Int',
+ traits => ['MultiValued::Tags'],
+ predicate => 'has_stuff',
+ multi_accessor => 'stuff_tagged',
+ multi_predicate => 'has_stuff_tagged',
+ );
+
+=head2 C<full_storage_slot>
+
+The instance slot to use to store the C<Data::MultiValued::Tags> or
+similar object. Defaults to C<"${name}__MULTIVALUED_STORAGE__">, where
+C<$name> is the attribute name.
+
+=cut
+
has 'full_storage_slot' => (
is => 'ro',
isa => Str,
@@ -12,9 +55,30 @@ has 'full_storage_slot' => (
);
sub _build_full_storage_slot { shift->name . '__MULTIVALUED_STORAGE__' }
-requires 'multivalue_storage_class';
-requires 'opts_to_pass_set';
-requires 'opts_to_pass_get';
+=head2 C<multi_accessor>
+
+=head2 C<multi_reader>
+
+=head2 C<multi_writer>
+
+=head2 C<multi_predicate>
+
+=head2 C<multi_clearer>
+
+The names to use for the various additional accessors. See
+L<Class::MOP::Attribute> for details. These default to
+C<"multi_$name"> where C<$name> is the name of the corresponding
+non-multi accessor. So, for example,
+
+ has stuff => (
+ is => 'rw',
+ traits => ['MultiValued::Tags'],
+ );
+
+will create a C<stuff> read / write accessor and a C<stuff_multi> read
+/ write tagged accessor.
+
+=cut
my @accs_to_multiply=qw(accessor reader writer predicate clearer);
@@ -26,11 +90,57 @@ for my $acc (@accs_to_multiply) {
);
}
+=head1 REQUIREMENTS
+
+These methods must be provided by any class consuming this role. See
+L<Data::MultiValued::AttributeTrait::Tags> etc. for examples.
+
+=head2 C<multivalue_storage_class>
+
+The class to use to create the multi-value objects.
+
+=cut
+
+requires 'multivalue_storage_class';
+
+=head2 C<opts_to_pass_set>
+
+Which options to pass from the multi-value accessors to the C<set>
+method of the multi-value object.
+
+=cut
+
+requires 'opts_to_pass_set';
+
+=head2 C<opts_to_pass_get>
+
+Which options to pass from the multi-value accessors to the C<get>
+method of the multi-value object.
+
+=cut
+
+requires 'opts_to_pass_get';
+
+=head1 METHODS
+
+=head2 C<slots>
+
+Adds the L</full_storage_slot> to the list of used slots.
+
+=cut
+
around slots => sub {
my ($orig, $self) = @_;
return ($self->$orig(), $self->full_storage_slot);
};
+=head2 C<set_full_storage>
+
+Stores a new instance of L</multivalue_storage_class> into the
+L</full_storage_slot> of the instance.
+
+=cut
+
sub set_full_storage {
my ($self,$instance) = @_;
@@ -43,6 +153,12 @@ sub set_full_storage {
return $ret;
}
+=head2 C<get_full_storage>
+
+Retrieves the value of the L</full_storage_slot> of the instance.
+
+=cut
+
sub get_full_storage {
my ($self,$instance) = @_;
@@ -53,6 +169,14 @@ sub get_full_storage {
);
}
+=head2 C<full_storage>
+
+Returns an instance of L</multivalue_storage_class>, either by
+retrieving it from the instance, or by creating one (and setting it in
+the instance). Calls L</get_full_storage> and L</set_full_storage>.
+
+=cut
+
sub full_storage {
my ($self,$instance) = @_;
@@ -60,8 +184,29 @@ sub full_storage {
|| $self->set_full_storage($instance);
}
+=head2 C<accessor_metaclass>
+
+Makes sure that all accessors for this attribute are created via the
+L<Data::MultiValued::AttributeAccessors> method meta class.
+
+=cut
+
sub accessor_metaclass { 'Data::MultiValued::AttributeAccessors' }
+=head2 C<install_accessors>
+
+After the regular L<Moose::Meta::Attribute> method, installs the
+multi-value accessors.
+
+Each installed normal accessor gets a multi-value version
+
+You can add or rename the multi-value version by using the attributes
+described above
+
+If you are passing explicit subrefs for your accessors, things won't work.
+
+=cut
+
after install_accessors => sub {
my ($self) = @_;
@@ -101,6 +246,18 @@ sub _filter_opts {
return \%ret;
}
+=head2 C<load_multi_value>
+
+Retrieves a value from the multi-value object, and stores it in the
+regular slot in the instance. If the value is not found, clears the
+slot.
+
+This traps the L<Data::MultiValued::Exceptions::NotFound> exception
+that may be thrown by the multi-value object, but re-throws any other
+exception.
+
+=cut
+
sub load_multi_value {
my ($self,$instance,$opts) = @_;
@@ -125,6 +282,14 @@ sub load_multi_value {
}
}
+=head2 C<raw_clear_value>
+
+Clears the instance slot. Does the same as
+L<Moose::Meta::Attribute/clear_value>, but we need this method because
+the other one gets changed by this trait.
+
+=cut
+
sub raw_clear_value {
my ($self,$instance) = @_;
@@ -135,6 +300,13 @@ sub raw_clear_value {
);
}
+=head2 C<store_multi_value>
+
+Gets the value from the regular slot in the instance, and stores it
+into the multi-value object.
+
+=cut
+
sub store_multi_value {
my ($self,$instance,$opts) = @_;
@@ -147,12 +319,28 @@ sub store_multi_value {
our $dyn_opts = {};
+=head2 C<get_value>
+
+Before the normal method, calls L</load_multi_value>. Normally, no
+options will be passed to the multi-value object C<get> method.
+
+=cut
+
before get_value => sub {
my ($self,$instance) = @_;
$self->load_multi_value($instance,$dyn_opts);
};
+=head2 C<get_multi_value>
+
+Sets the options that L</load_multi_value> will use, then calls L</get_value>.
+
+The options are passed via an ugly C<local>ised package
+variable. There might be a better way.
+
+=cut
+
sub get_multi_value {
my ($self,$instance,$opts,$value) = @_;
@@ -161,12 +349,27 @@ sub get_multi_value {
return $self->get_value($instance,$value);
}
+=head2 C<set_initial_value>
+
+After the normal method, calls L</store_multi_value>.
+
+=cut
+
after set_initial_value => sub {
my ($self,$instance,$value) = @_;
$self->store_multi_value($instance,$dyn_opts);
};
+=head2 C<set_value>
+
+=head2 C<set_multi_value>
+
+Just like L</get_value> and L</get_multi_value>, but calling
+L</store_multi_value> after the regular C<set_value>
+
+=cut
+
after set_value => sub {
my ($self,$instance,$value) = @_;
@@ -181,6 +384,14 @@ sub set_multi_value {
return $self->set_value($instance,$value);
}
+=head2 C<has_value>
+
+=head2 C<has_multi_value>
+
+Just like L</get_value> and L</get_multi_value>.
+
+=cut
+
before has_value => sub {
my ($self,$instance) = @_;
@@ -195,6 +406,14 @@ sub has_multi_value {
return $self->has_value($instance);
}
+=head2 C<clear_value>
+
+=head2 C<clear_multi_value>
+
+Call the C<clear> method on the multi-value object.
+
+=cut
+
after clear_value => sub {
my ($self,$instance) = @_;
@@ -210,16 +429,40 @@ sub clear_multi_value {
return $self->clear_value($instance);
}
+=head2 C<get_multi_read_method>
+
+=head2 C<get_multi_write_method>
+
+Return the name of the reader or writer method, honoring
+L</multi_reader>, L</multi_writer> and L</multi_accessor>.
+
+=cut
+
sub get_multi_read_method {
my $self = shift;
- return $self->get_read_method . '_multi';
+ return $self->multi_reader || $self->multi_accessor
+ || $self->get_read_method . '_multi';
}
sub get_multi_write_method {
my $self = shift;
- return $self->get_write_method . '_multi';
+ return $self->multi_writer || $self->multi_accessor
+ || $self->get_write_method . '_multi';
}
+=head1 Serialisation helpers
+
+These are used through
+L<Data::MultiValued::UglySerializationHelperRole>.
+
+=head2 C<_rebless_slot>
+
+Blesses the value inside the L</full_storage_slot> of the instance
+into L</multivalue_storage_class>, then calls C<_rebless_storage> on
+it.
+
+=cut
+
sub _rebless_slot {
my ($self,$instance) = @_;
@@ -230,6 +473,14 @@ sub _rebless_slot {
$st->_rebless_storage;
}
+=head2 C<_as_hash>
+
+Returns the result of calling C<_as_hash> on the value inside the
+L</full_storage_slot> of the instance. Returns nothing if the slot
+does not have a value.
+
+=cut
+
sub _as_hash {
my ($self,$instance) = @_;
diff --git a/lib/Data/MultiValued/AttributeTrait/Ranges.pm b/lib/Data/MultiValued/AttributeTrait/Ranges.pm
index 8d93578..3d3b3f8 100644
--- a/lib/Data/MultiValued/AttributeTrait/Ranges.pm
+++ b/lib/Data/MultiValued/AttributeTrait/Ranges.pm
@@ -3,6 +3,43 @@ use Moose::Role;
use Data::MultiValued::Ranges;
with 'Data::MultiValued::AttributeTrait';
+# ABSTRACT: attribute traits for attributes holding ranged values
+
+=head1 SYNOPSIS
+
+ package My::Class;
+ use Moose;
+ use Data::MultiValued::AttributeTrait::Ranges;
+
+ has stuff => (
+ is => 'rw',
+ isa => 'Int',
+ traits => ['MultiValued::Ranges'],
+ predicate => 'has_stuff',
+ multi_accessor => 'stuff_tagged',
+ multi_predicate => 'has_stuff_tagged',
+ );
+
+=head1 DESCRIPTION
+
+This role consumes L<Data::MultiValued::AttributeTrait> and
+specialises it to use L<Data::MultiValued::Ranges> as multi-value
+storage:
+
+=head2 C<multivalue_storage_class>
+
+Returns C<'Data::MultiValued::Ranges'>.
+
+=head2 C<opts_to_pass_set>
+
+Returns C<('from', 'to')>.
+
+=head2 C<opts_to_pass_get>
+
+Returns C<('at')>.
+
+=cut
+
sub multivalue_storage_class { 'Data::MultiValued::Ranges' };
sub opts_to_pass_set { qw(from to) }
sub opts_to_pass_get { qw(at) }
diff --git a/lib/Data/MultiValued/AttributeTrait/Tags.pm b/lib/Data/MultiValued/AttributeTrait/Tags.pm
index 7cffb33..d671ed4 100644
--- a/lib/Data/MultiValued/AttributeTrait/Tags.pm
+++ b/lib/Data/MultiValued/AttributeTrait/Tags.pm
@@ -3,6 +3,43 @@ use Moose::Role;
use Data::MultiValued::Tags;
with 'Data::MultiValued::AttributeTrait';
+# ABSTRACT: attribute traits for attributes holding tagged values
+
+=head1 SYNOPSIS
+
+ package My::Class;
+ use Moose;
+ use Data::MultiValued::AttributeTrait::Tags;
+
+ has stuff => (
+ is => 'rw',
+ isa => 'Int',
+ traits => ['MultiValued::Tags'],
+ predicate => 'has_stuff',
+ multi_accessor => 'stuff_tagged',
+ multi_predicate => 'has_stuff_tagged',
+ );
+
+=head1 DESCRIPTION
+
+This role consumes L<Data::MultiValued::AttributeTrait> and
+specialises it to use L<Data::MultiValued::Tags> as multi-value
+storage:
+
+=head2 C<multivalue_storage_class>
+
+Returns C<'Data::MultiValued::Tags'>.
+
+=head2 C<opts_to_pass_set>
+
+Returns C<('tag')>.
+
+=head2 C<opts_to_pass_get>
+
+Returns C<('tag')>.
+
+=cut
+
sub multivalue_storage_class { 'Data::MultiValued::Tags' };
sub opts_to_pass_set { qw(tag) }
sub opts_to_pass_get { qw(tag) }
diff --git a/lib/Data/MultiValued/AttributeTrait/TagsAndRanges.pm b/lib/Data/MultiValued/AttributeTrait/TagsAndRanges.pm
index e0c56cd..0bb87ef 100644
--- a/lib/Data/MultiValued/AttributeTrait/TagsAndRanges.pm
+++ b/lib/Data/MultiValued/AttributeTrait/TagsAndRanges.pm
@@ -3,6 +3,43 @@ use Moose::Role;
use Data::MultiValued::TagsAndRanges;
with 'Data::MultiValued::AttributeTrait';
+# ABSTRACT: attribute traits for attributes holding tagged and ranged values
+
+=head1 SYNOPSIS
+
+ package My::Class;
+ use Moose;
+ use Data::MultiValued::AttributeTrait::TagsAndRanges;
+
+ has stuff => (
+ is => 'rw',
+ isa => 'Int',
+ traits => ['MultiValued::TagsAndRanges'],
+ predicate => 'has_stuff',
+ multi_accessor => 'stuff_tagged',
+ multi_predicate => 'has_stuff_tagged',
+ );
+
+=head1 DESCRIPTION
+
+This role consumes L<Data::MultiValued::AttributeTrait> and
+specialises it to use L<Data::MultiValued::TagsAndRanges> as multi-value
+storage:
+
+=head2 C<multivalue_storage_class>
+
+Returns C<'Data::MultiValued::TagsAndRanges'>.
+
+=head2 C<opts_to_pass_set>
+
+Returns C<('tag', 'from', 'to')>.
+
+=head2 C<opts_to_pass_get>
+
+Returns C<('tag', 'at')>.
+
+=cut
+
sub multivalue_storage_class { 'Data::MultiValued::TagsAndRanges' };
sub opts_to_pass_set { qw(from to tag) }
sub opts_to_pass_get { qw(at tag) }
diff --git a/lib/Data/MultiValued/RangeContainer.pm b/lib/Data/MultiValued/RangeContainer.pm
index e9b1b62..0bfe8cd 100644
--- a/lib/Data/MultiValued/RangeContainer.pm
+++ b/lib/Data/MultiValued/RangeContainer.pm
@@ -5,6 +5,27 @@ use MooseX::Types::Moose qw(Num Str Any Undef ArrayRef);
use MooseX::Types::Structured qw(Dict);
use Data::MultiValued::Exceptions;
+# ABSTRACT: container for ranged values
+
+=head1 DESCRIPTION
+
+Please don't use this module directly, use L<Data::MultiValued::Ranges>.
+
+This module implements the storage for ranged data. It's similar to
+L<Array::IntSpan>, but simpler (and slower).
+
+A range is defined by a pair of numbers, C<from> and C<to>, and it
+contains C<< Num $x : $min <= $x < $max >>. C<undef> is treated as
+"inf" (negative infinity if used as C<from> or C<at>, positive
+infinity if used as C<to>).
+
+The internal representation of a range is a hash with three keys,
+C<from> C<to> C<value>.
+
+=head1 METHODS
+
+=cut
+
has _storage => (
is => 'rw',
isa => ArrayRef[
@@ -18,6 +39,16 @@ has _storage => (
default => sub { [ ] },
);
+=head2 C<get>
+
+ my $value = $obj->get({ at => $point });
+
+Retrieves the range that includes the given point. Throws a
+L<Data::MultiValued::Exceptions::RangeNotFound> exception if no range
+includes the point.
+
+=cut
+
sub get {
my ($self,$args) = @_;
@@ -45,6 +76,8 @@ sub _cmp {
return $a <=> $b;
}
+# a binary search would be a good idea.
+
sub _get_slot_at {
my ($self,$at) = @_;
@@ -56,6 +89,10 @@ sub _get_slot_at {
return;
}
+# this is quite probably uselessly slow: we don't really need all of
+# @before and @after, we just need to know if they're not empty; also,
+# a binary search would be a good idea.
+
sub _partition_slots {
my ($self,$from,$to) = @_;
@@ -80,7 +117,18 @@ sub _partition_slots {
return \@before,\@overlap,\@after;
}
-sub set_or_create {
+=head2 C<get_or_create>
+
+ $obj->get_or_create({ from => $min, to => $max });
+
+Retrieves the range that has the given extremes. If no such range
+exists, creates a new range, splicing any existing overlapping range,
+and returns it. Throws L<Data::MultiValued::Exceptions::BadRange> if
+C<< $min > $max >>.
+
+=cut
+
+sub get_or_create {
my ($self,$args) = @_;
my $from = $args->{from};
@@ -103,6 +151,19 @@ sub set_or_create {
return $range;
}
+=head2 C<clear>
+
+ $obj->clear({ from => $min, to => $max });
+
+Removes the range that has the given extremes. If no such range
+exists, splices any existing overlapping range so that C<<
+$obj->get({at => $point }) >> for any C<< $min <= $point < $max >>
+will die.
+
+Throws L<Data::MultiValued::Exceptions::BadRange> if C<< $min > $max >>.
+
+=cut
+
sub clear {
my ($self,$args) = @_;
@@ -133,10 +194,16 @@ sub _clear_slot {
$self->_splice_slot($from,$to);
}
+# Most of the splicing mechanics is here. Given a range and something
+# to put in it, do "the right thing"
+
sub _splice_slot {
my ($self,$from,$to,$new) = @_;
- if (!@{$self->_storage}) { # empty
+ # if !$new, it's like C<splice> without a replacement list: we
+ # just delete the range
+
+ if (!@{$self->_storage}) { # empty, just store
push @{$self->_storage},$new if $new;
return $new;
}
@@ -144,27 +211,33 @@ sub _splice_slot {
my ($before,$overlap,$after) = $self->_partition_slots($from,$to);
if (!@$before && !@$overlap) {
+ # nothing before, nothing overlapping: put $new at the beginning
unshift @{$self->_storage},$new if $new;
return $new;
}
if (!@$after && !@$overlap) {
+ # nothing after, nothing overlapping: put $new at the end
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
+ # ok, we have to insert in the middle of things, and maybe we have
+ # to trim existing ranges
+
my $first_to_replace;
my $how_many = @$overlap;
my @replacement = $new ? ($new) : ();
if ($how_many > 0) { # we have to splice
+ # by costruction, the first and the last may have to be split, all
+ # others must be removed
$first_to_replace = $overlap->[0];
my $last_to_replace = $overlap->[-1];
my $first = $self->_storage->[$first_to_replace];
my $last = $self->_storage->[$last_to_replace];
+ # does the first overlapping range need trimming?
if (_cmp($first->{from},$from,0,0)<0
&& _cmp($first->{to},$from,1,0)>=0) {
unshift @replacement, {
@@ -173,6 +246,7 @@ sub _splice_slot {
value => $first->{value},
}
}
+ # does the last overlapping range need trimming?
if (_cmp($last->{from},$to,0,1)<=0
&& _cmp($last->{to},$to,1,1)>0) {
push @replacement, {
@@ -183,6 +257,7 @@ sub _splice_slot {
}
}
else {
+ # no overlaps, just insert between @before and @after
$first_to_replace = $before->[-1]+1;
}
diff --git a/lib/Data/MultiValued/Ranges.pm b/lib/Data/MultiValued/Ranges.pm
index 9c69626..7193df6 100644
--- a/lib/Data/MultiValued/Ranges.pm
+++ b/lib/Data/MultiValued/Ranges.pm
@@ -6,7 +6,24 @@ 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
+# ABSTRACT: Handle values with validity ranges
+
+=head1 SYNOPSIS
+
+ use Data::MultiValued::Ranges;
+
+ my $obj = Data::MultiValued::Ranges->new();
+ $obj->set({
+ from => 10,
+ to => 20,
+ value => 'foo',
+ });
+ say $obj->get({at => 15}); # prints 'foo'
+ say $obj->get({at => 35}); # dies
+
+=head1 METHODS
+
+=cut
has _storage => (
is => 'rw',
@@ -19,18 +36,39 @@ sub _build__storage {
Data::MultiValued::RangeContainer->new();
}
-sub _rebless_storage {
- my ($self) = @_;
+=head2 C<set>
- bless $self->{_storage},'Data::MultiValued::RangeContainer';
-}
+ $obj->set({ from => $min, to => $max, value => $the_value });
-sub _as_hash {
- my ($self) = @_;
+Stores the given value for the given range. Throws
+L<Data::MultiValued::Exceptions::BadRange> if C<< $min > $max >>.
- my %ret = %{$self->_storage};
- return {_storage=>\%ret};
-}
+The range is defined as C<< Num $x : $min <= $x < $max >>. A C<< from
+=> undef >> means "from -Inf", and a C<< to => undef >> means "to
++Inf". Not passing in C<from> or C<to> is equivalent to passing
+C<undef>.
+
+If the given range intersects existing ranges, these are spliced to
+avoid overlaps. In other words:
+
+ $obj->set({
+ from => 10,
+ to => 20,
+ value => 'foo',
+ });
+ $obj->set({
+ from => 15,
+ to => 25,
+ value => 'bar',
+ });
+ say $obj->get({at => 12}); # prints 'foo'
+ say $obj->get({at => 15}); # prints 'bar'
+ say $obj->get({at => 25}); # dies
+
+No cloning is done: if you pass in a reference, the reference is
+just stored.
+
+=cut
sub set {
my ($self,%args) = validated_hash(
@@ -40,10 +78,27 @@ sub set {
value => { isa => Any, },
);
- $self->_storage->set_or_create(\%args)
+ $self->_storage->get_or_create(\%args)
->{value} = $args{value};
}
+=head2 C<get>
+
+ my $value = $obj->get({ at => $point });
+
+Retrieves the value for the given point. Throws a
+L<Data::MultiValued::Exceptions::RangeNotFound> exception if no ranges
+exist in this object that include the point (remember that a range
+does not include its C<to> point).
+
+A C<< at => undef >> means "at -Inf". Not passing in C<at> is
+equivalent to passing C<undef>.
+
+No cloning is done: if a reference was stored, you get it back
+untouched.
+
+=cut
+
sub get {
my ($self,%args) = validated_hash(
\@_,
@@ -54,6 +109,34 @@ sub get {
->{value};
}
+=head2 C<clear>
+
+ $obj->clear({ from => $min, to => $max });
+
+Deletes all values for the given range. Throws
+L<Data::MultiValued::Exceptions::BadRange> if C<< $min > $max >>.
+
+A C<< from => undef >> means "from -Inf", and a C<< to => undef >>
+means "to +Inf". Not passing in C<from> or C<to> is equivalent to
+passing C<undef>. Thus, C<< $obj->clear() >> clears everything.
+
+If the given range intersects existing ranges, these are spliced. In
+other words:
+
+ $obj->set({
+ from => 10,
+ to => 20,
+ value => 'foo',
+ });
+ $obj->clear({
+ from => 15,
+ to => 25,
+ });
+ say $obj->get({at => 12}); # prints 'foo'
+ say $obj->get({at => 15}); # dies
+
+=cut
+
sub clear {
my ($self,%args) = validated_hash(
\@_,
@@ -64,5 +147,42 @@ sub clear {
$self->_storage->clear(\%args);
}
+=head1 Serialisation helpers
+
+These are used through
+L<Data::MultiValued::UglySerializationHelperRole>.
+
+=head2 C<_rebless_storage>
+
+Blesses the storage into L<Data::MultiValued::RangeContainer>.
+
+=cut
+
+sub _rebless_storage {
+ my ($self) = @_;
+
+ bless $self->{_storage},'Data::MultiValued::RangeContainer';
+}
+
+
+=head2 C<_as_hash>
+
+Returns the internal representation with no blessed hashes, with as
+few copies as possible.
+
+=cut
+
+sub _as_hash {
+ my ($self) = @_;
+
+ my %ret = %{$self->_storage};
+ return {_storage=>\%ret};
+}
+
+=head1 SEE ALSO
+
+L<Data::MultiValued::RangeContainer>, L<Data::MultiValued::Exceptions>
+
+=cut
1;
diff --git a/lib/Data/MultiValued/TagContainer.pm b/lib/Data/MultiValued/TagContainer.pm
index cdd0456..b7a9b13 100644
--- a/lib/Data/MultiValued/TagContainer.pm
+++ b/lib/Data/MultiValued/TagContainer.pm
@@ -4,6 +4,26 @@ use Moose::Util::TypeConstraints;
use MooseX::Types::Moose qw(HashRef);
use Data::MultiValued::Exceptions;
+# ABSTRACT: container for tagged values
+
+=head1 DESCRIPTION
+
+Please don't use this module directly, use L<Data::MultiValued::Tags>.
+
+This module implements the storage for tagged data. It's almost
+exactly a hash, the main difference being that C<undef> is a valid key
+and it's distinct from the empty string.
+
+Another difference is that you get an exception if you try to access a
+tag that's not there.
+
+Data is kept in "storage cells", as created by
+L</_create_new_inferior> (by default, a hashref).
+
+=head1 METHODS
+
+=cut
+
has _storage => (
is => 'rw',
isa => HashRef,
@@ -25,6 +45,19 @@ has _default_tag => (
clearer => '_clear_default_tag',
);
+=head2 C<get>
+
+ my $value = $obj->get({ tag => $the_tag });
+
+Retrieves the "storage cell" for the given tag. Throws a
+L<Data::MultiValued::Exceptions::TagNotFound> exception if the tag
+does not exists in this object.
+
+Not passing in a C<tag> is equivalent to passing in C<< tag => undef
+>>.
+
+=cut
+
sub get {
my ($self,$args) = @_;
@@ -48,6 +81,19 @@ sub get {
return $self->_get_tag($tag);
}
+=head2 C<get_or_create>
+
+ $obj->get_or_create({ tag => $the_tag });
+
+Retrieves the "storage cell" for the given tag. If the tag does not
+exist, creates a new cell (see L</_create_new_inferior>), sets it for
+the tag, and returns it.
+
+Not passing in a C<tag> is equivalent to passing in C<< tag => undef
+>>.
+
+=cut
+
sub get_or_create {
my ($self,$args) = @_;
@@ -76,6 +122,19 @@ sub _clear_storage {
$self->_storage({});
}
+=head2 C<clear>
+
+ $obj->clear({ tag => $the_tag });
+
+Deletes the given tag and all data associated with it. Does not throw
+exceptions: if the tag does not exist, nothing happens.
+
+Not passing in a C<tag>, or passing C<< tag => undef >>, clears
+everything. If you want to only clear the C<undef> tag, you may call
+C<_clear_default_tag> (which is considered a "protected" method).
+
+=cut
+
sub clear {
my ($self,$args) = @_;
@@ -91,6 +150,13 @@ sub clear {
return;
}
+=head2 C<_create_new_inferior>
+
+Returns a new "storage cell", by default an empty hashref. See
+L<Data::MultiValued::TagContainerForRanges> for an example of use.
+
+=cut
+
sub _create_new_inferior {
my ($self) = @_;
return {};
diff --git a/lib/Data/MultiValued/TagContainerForRanges.pm b/lib/Data/MultiValued/TagContainerForRanges.pm
index 604dcb7..826df9d 100644
--- a/lib/Data/MultiValued/TagContainerForRanges.pm
+++ b/lib/Data/MultiValued/TagContainerForRanges.pm
@@ -4,6 +4,21 @@ use MooseX::Types::Moose qw(HashRef);
use Moose::Util::TypeConstraints;
use Data::MultiValued::RangeContainer;
+# ABSTRACT: container for tagged values that are ranged containers
+
+=head1 DESCRIPTION
+
+Please don't use this module directly, use
+L<Data::MultiValued::TagsAndRanges>.
+
+This module is a subclass of L<Data::MultiValued::TagContainer>, which
+only allows instances of L<Data::MultiValued::RangeContainer> as
+"storage cells".
+
+=head1 METHODS
+
+=cut
+
extends 'Data::MultiValued::TagContainer';
has '+_storage' => (
@@ -14,10 +29,27 @@ has '+_default_tag' => (
isa => class_type('Data::MultiValued::RangeContainer'),
);
+=head2 C<_create_new_inferior>
+
+Returns a new L<Data::MultiValued::RangeContainer> instance.
+
+=cut
+
sub _create_new_inferior {
Data::MultiValued::RangeContainer->new();
}
+=head1 Serialisation helpers
+
+These are used through
+L<Data::MultiValued::UglySerializationHelperRole>.
+
+=head2 C<_rebless_storage>
+
+Blesses the "storage cells" into L<Data::MultiValued::RangeContainer>.
+
+=cut
+
sub _rebless_storage {
my ($self) = @_;
bless $_,'Data::MultiValued::RangeContainer'
@@ -26,6 +58,13 @@ sub _rebless_storage {
return;
}
+=head2 C<_as_hash>
+
+Returns the internal representation with no blessed hashes, with as
+few copies as possible.
+
+=cut
+
sub _as_hash {
my ($self) = @_;
my %st;
diff --git a/lib/Data/MultiValued/Tags.pm b/lib/Data/MultiValued/Tags.pm
index fbf7948..9c52510 100644
--- a/lib/Data/MultiValued/Tags.pm
+++ b/lib/Data/MultiValued/Tags.pm
@@ -6,7 +6,23 @@ 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
+# ABSTRACT: Handle values with tags
+
+=head1 SYNOPSIS
+
+ use Data::MultiValued::Tags;
+
+ my $obj = Data::MultiValued::Tags->new();
+ $obj->set({
+ tag => 'tag1',
+ value => 'a string',
+ });
+ say $obj->get({tag=>'tag1'}); # prints 'a string'
+ say $obj->get({tag=>'tag2'}); # dies
+
+=head1 METHODS
+
+=cut
has _storage => (
is => 'rw',
@@ -19,18 +35,20 @@ sub _build__storage {
Data::MultiValued::TagContainer->new();
}
-sub _rebless_storage {
- my ($self) = @_;
+=head2 C<set>
- bless $self->{_storage},'Data::MultiValued::TagContainer';
-}
+ $obj->set({ tag => $the_tag, value => $the_value });
-sub _as_hash {
- my ($self) = @_;
+Stores the given value for the given tag. Replaces existing
+values. Does not throw exceptions.
- my %ret = %{$self->_storage};
- return {_storage=>\%ret};
-}
+Not passing in a C<tag> is equivalent to passing in C<< tag => undef
+>>.
+
+No cloning is done: if you pass in a reference, the reference is
+just stored.
+
+=cut
sub set {
my ($self,%args) = validated_hash(
@@ -43,6 +61,22 @@ sub set {
->{value} = $args{value};
}
+=head2 C<get>
+
+ my $value = $obj->get({ tag => $the_tag });
+
+Retrieves the value for the given tag. Throws a
+L<Data::MultiValued::Exceptions::TagNotFound> exception if the tag
+does not exists in this object.
+
+Not passing in a C<tag> is equivalent to passing in C<< tag => undef
+>>.
+
+No cloning is done: if a reference was stored, you get it back
+untouched.
+
+=cut
+
sub get {
my ($self,%args) = validated_hash(
\@_,
@@ -53,6 +87,18 @@ sub get {
->{value};
}
+=head2 C<clear>
+
+ $obj->clear({ tag => $the_tag });
+
+Deletes the given tag and all data associated with it. Does not throw
+exceptions: if the tag does not exist, nothing happens.
+
+Not passing in a C<tag> clears everything. Yes, this means that there
+is no way to just clear the value for the C<undef> tag.
+
+=cut
+
sub clear {
my ($self,%args) = validated_hash(
\@_,
@@ -62,4 +108,41 @@ sub clear {
$self->_storage->clear(\%args);
}
+=head1 Serialisation helpers
+
+These are used through
+L<Data::MultiValued::UglySerializationHelperRole>.
+
+=head2 C<_rebless_storage>
+
+Blesses the storage into L<Data::MultiValued::TagContainer>.
+
+=cut
+
+sub _rebless_storage {
+ my ($self) = @_;
+
+ bless $self->{_storage},'Data::MultiValued::TagContainer';
+}
+
+=head2 C<_as_hash>
+
+Returns the internal representation with no blessed hashes, with as
+few copies as possible.
+
+=cut
+
+sub _as_hash {
+ my ($self) = @_;
+
+ my %ret = %{$self->_storage};
+ return {_storage=>\%ret};
+}
+
+=head1 SEE ALSO
+
+L<Data::MultiValued::TagContainer>, L<Data::MultiValued::Exceptions>
+
+=cut
+
1;
diff --git a/lib/Data/MultiValued/TagsAndRanges.pm b/lib/Data/MultiValued/TagsAndRanges.pm
index 6208435..204f858 100644
--- a/lib/Data/MultiValued/TagsAndRanges.pm
+++ b/lib/Data/MultiValued/TagsAndRanges.pm
@@ -8,6 +8,25 @@ use Data::MultiValued::TagContainerForRanges;
# ABSTRACT: Handle values with tags and validity ranges
+=head1 SYNOPSIS
+
+ use Data::MultiValued::TagsAndRanges;
+
+ my $obj = Data::MultiValued::TagsAndRanges->new();
+ $obj->set({
+ tag => 'tag1',
+ from => 10,
+ to => 20,
+ value => 'foo',
+ });
+ say $obj->get({tag => 'tag1', at => 15}); # prints 'foo'
+ say $obj->get({tag => 'tag1', at => 35}); # dies
+ say $obj->get({tag => 'tag2', at => 15}); # dies
+
+=head1 METHODS
+
+=cut
+
has _storage => (
is => 'rw',
isa => class_type('Data::MultiValued::TagContainerForRanges'),
@@ -19,19 +38,17 @@ sub _build__storage {
Data::MultiValued::TagContainerForRanges->new();
}
-sub _rebless_storage {
- my ($self) = @_;
+=head2 C<set>
- bless $self->{_storage},'Data::MultiValued::TagContainerForRanges';
- $self->_storage->_rebless_storage;
-}
+ $obj->set({ tag => $the_tag, from => $min, to => $max, value => $the_value });
-sub _as_hash {
- my ($self) = @_;
+Stores the given value for the given tag and range. Does not throw
+exceptions.
- my $ret = $self->_storage->_as_hash;
- return {_storage=>$ret};
-}
+See L<Data::MultiValued::Tags/set> and
+L<Data::MultiValued::Ranges/set> for more details.
+
+=cut
sub set {
my ($self,%args) = validated_hash(
@@ -43,10 +60,25 @@ sub set {
);
$self->_storage->get_or_create(\%args)
- ->set_or_create(\%args)
+ ->get_or_create(\%args)
->{value} = $args{value};
}
+=head2 C<get>
+
+ my $value = $obj->get({ tag => $the_tag, at => $point });
+
+Retrieves the value for the given tag and point. Throws a
+L<Data::MultiValued::Exceptions::RangeNotFound> exception if no ranges
+exist in this object that include the point, and
+L<Data::MultiValued::Exceptions::TagNotFound> exception if the tag
+does not exists in this object.
+
+See L<Data::MultiValued::Tags/get> and
+L<Data::MultiValued::Ranges/get> for more details.
+
+=cut
+
sub get {
my ($self,%args) = validated_hash(
\@_,
@@ -59,6 +91,20 @@ sub get {
->{value};
}
+=head2 C<clear>
+
+ $obj->clear({ tag => $the_tag, from => $min, to => $max });
+
+If a range is specified, deletes all values for the given range and
+tag. If no range is specified, delete all values for the given tag.
+
+Does not throw exceptions.
+
+See L<Data::MultiValued::Tags/clear> and
+L<Data::MultiValued::Ranges/clear> for more details.
+
+=cut
+
sub clear {
my ($self,%args) = validated_hash(
\@_,
@@ -76,4 +122,38 @@ sub clear {
}
}
+=head1 Serialisation helpers
+
+These are used through
+L<Data::MultiValued::UglySerializationHelperRole>.
+
+=head2 C<_rebless_storage>
+
+Blesses the storage into L<Data::MultiValued::TagContainerForRanges>,
+then calls C<_rebless_storage> on it.
+
+=cut
+
+sub _rebless_storage {
+ my ($self) = @_;
+
+ bless $self->{_storage},'Data::MultiValued::TagContainerForRanges';
+ $self->_storage->_rebless_storage;
+}
+
+=head2 C<_as_hash>
+
+Returns the internal representation with no blessed hashes, with as
+few copies as possible. Depends on
+L<Data::MultiValued::TagContainerForRanges/_as_hash>.
+
+=cut
+
+sub _as_hash {
+ my ($self) = @_;
+
+ my $ret = $self->_storage->_as_hash;
+ return {_storage=>$ret};
+}
+
1;
diff --git a/lib/Data/MultiValued/UglySerializationHelperRole.pm b/lib/Data/MultiValued/UglySerializationHelperRole.pm
index e586dec..0c06ac6 100644
--- a/lib/Data/MultiValued/UglySerializationHelperRole.pm
+++ b/lib/Data/MultiValued/UglySerializationHelperRole.pm
@@ -1,6 +1,61 @@
package Data::MultiValued::UglySerializationHelperRole;
use Moose::Role;
+# ABSTRACT: only use this if you know what you're doing
+
+=head1 SYNOPSIS
+
+ package My::Class;
+ use Moose;
+ use Data::MultiValued::AttributeTrait::Tags;
+
+ with 'Data::MultiValued::UglySerializationHelperRole';
+
+ has tt => (
+ is => 'rw',
+ isa => 'Int',
+ traits => ['MultiValued::Tags'],
+ default => 3,
+ predicate => 'has_tt',
+ clearer => 'clear_tt',
+ );
+
+Later:
+
+ my $json = JSON::XS->new->utf8;
+ my $obj = My::Class->new(rr=>'foo');
+
+ my $str = $json->encode($obj->as_hash);
+
+ my $obj2 = My::Class->new_in_place($json->decode($str));
+
+ # $obj and $obj2 have the same contents
+
+=head1 DESCRIPTION
+
+This is an ugly hack. It pokes inside the internals of your objects,
+and will break if you're not careful. It assumes that your instances
+are hashref-based. It mostly assumes that you're not storing blessed
+refs inside the multi-value attributes. It goes to these lengths to
+give a decent serialisation performance, without lots of unnecessary
+copies. Oh, and on de-serialise it will skip all type constraint
+checking and bypass the accessors, so it may well give you an unusable
+object.
+
+=head1 METHODS
+
+=head2 C<new_in_place>
+
+ my $obj = My::Class->new_in_place($hashref);
+
+Directly C<bless>es the hashref into the class, then calls
+C<_rebless_slot> on any multi-value attribute.
+
+This is very dangerous, don't try this at home without the supervision
+of an adult.
+
+=cut
+
sub new_in_place {
my ($class,$hash) = @_;
@@ -14,6 +69,19 @@ sub new_in_place {
return $self;
}
+=head2 C<as_hash>
+
+ my $hashref = $obj->as_hash;
+
+Performs a shallow copy of the object's hash, then replaces the values
+of all the multi-value slots with the results of calling C<_as_hash>
+on the corresponding multi-value attribute.
+
+This is very dangerous, don't try this at home without the supervision
+of an adult.
+
+=cut
+
sub as_hash {
my ($self) = @_;
@@ -32,4 +100,14 @@ sub as_hash {
return \%ret;
}
+=head1 FINAL WARNING
+
+ my $obj_clone = My::Class->new_in_place($obj->as_hash);
+
+This will create a shallow clone. Most internals will be
+shared. Things may break. Just don't do it, C<dclone> the hashref, or
+do something equivalent (as in the synopsis), instead.
+
+=cut
+
1;