From 65e5ad0900633186a52431a19839cbd14b2ec5aa Mon Sep 17 00:00:00 2001 From: Gianni Ceccarelli Date: Mon, 14 Nov 2011 14:48:16 +0000 Subject: documentation --- dist.ini | 2 + lib/Data/MultiValued.pod | 70 ++++++ lib/Data/MultiValued/AttributeTrait.pm | 261 ++++++++++++++++++++- lib/Data/MultiValued/AttributeTrait/Ranges.pm | 37 +++ lib/Data/MultiValued/AttributeTrait/Tags.pm | 37 +++ .../MultiValued/AttributeTrait/TagsAndRanges.pm | 37 +++ lib/Data/MultiValued/RangeContainer.pm | 83 ++++++- lib/Data/MultiValued/Ranges.pm | 142 ++++++++++- lib/Data/MultiValued/TagContainer.pm | 66 ++++++ lib/Data/MultiValued/TagContainerForRanges.pm | 39 +++ lib/Data/MultiValued/Tags.pm | 103 +++++++- lib/Data/MultiValued/TagsAndRanges.pm | 102 +++++++- .../MultiValued/UglySerializationHelperRole.pm | 78 ++++++ 13 files changed, 1016 insertions(+), 41 deletions(-) create mode 100644 lib/Data/MultiValued.pod 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. Or some other CPAN +module. Why use these? + +=over 4 + +=item * + +they are optimised for serialisation, see +L and F. + +=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, L and +L for the containers +themselves. Look at L, +L and +L 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, +L or +L. + +This role (together with L) +defines all the basic plumbing to glue C etc +into Moose attributes. + +=head1 Implementation details + +The multi-value object is stored in the instance slot named by the +L attribute attribute. C modifiers on +getters load the appropriate value from the multi-value object into +the regular instance slot, C 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 + +The instance slot to use to store the C 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 + +=head2 C + +=head2 C + +=head2 C + +=head2 C + +The names to use for the various additional accessors. See +L 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 read / write accessor and a C 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 etc. for examples. + +=head2 C + +The class to use to create the multi-value objects. + +=cut + +requires 'multivalue_storage_class'; + +=head2 C + +Which options to pass from the multi-value accessors to the C +method of the multi-value object. + +=cut + +requires 'opts_to_pass_set'; + +=head2 C + +Which options to pass from the multi-value accessors to the C +method of the multi-value object. + +=cut + +requires 'opts_to_pass_get'; + +=head1 METHODS + +=head2 C + +Adds the L to the list of used slots. + +=cut + around slots => sub { my ($orig, $self) = @_; return ($self->$orig(), $self->full_storage_slot); }; +=head2 C + +Stores a new instance of L into the +L of the instance. + +=cut + sub set_full_storage { my ($self,$instance) = @_; @@ -43,6 +153,12 @@ sub set_full_storage { return $ret; } +=head2 C + +Retrieves the value of the L of the instance. + +=cut + sub get_full_storage { my ($self,$instance) = @_; @@ -53,6 +169,14 @@ sub get_full_storage { ); } +=head2 C + +Returns an instance of L, either by +retrieving it from the instance, or by creating one (and setting it in +the instance). Calls L and L. + +=cut + sub full_storage { my ($self,$instance) = @_; @@ -60,8 +184,29 @@ sub full_storage { || $self->set_full_storage($instance); } +=head2 C + +Makes sure that all accessors for this attribute are created via the +L method meta class. + +=cut + sub accessor_metaclass { 'Data::MultiValued::AttributeAccessors' } +=head2 C + +After the regular L 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 + +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 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 + +Clears the instance slot. Does the same as +L, 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 + +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 + +Before the normal method, calls L. Normally, no +options will be passed to the multi-value object C method. + +=cut + before get_value => sub { my ($self,$instance) = @_; $self->load_multi_value($instance,$dyn_opts); }; +=head2 C + +Sets the options that L will use, then calls L. + +The options are passed via an ugly Cised 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 + +After the normal method, calls L. + +=cut + after set_initial_value => sub { my ($self,$instance,$value) = @_; $self->store_multi_value($instance,$dyn_opts); }; +=head2 C + +=head2 C + +Just like L and L, but calling +L after the regular C + +=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 + +=head2 C + +Just like L and L. + +=cut + before has_value => sub { my ($self,$instance) = @_; @@ -195,6 +406,14 @@ sub has_multi_value { return $self->has_value($instance); } +=head2 C + +=head2 C + +Call the C 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 + +=head2 C + +Return the name of the reader or writer method, honoring +L, L and L. + +=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. + +=head2 C<_rebless_slot> + +Blesses the value inside the L of the instance +into L, 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 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 and +specialises it to use L as multi-value +storage: + +=head2 C + +Returns C<'Data::MultiValued::Ranges'>. + +=head2 C + +Returns C<('from', 'to')>. + +=head2 C + +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 and +specialises it to use L as multi-value +storage: + +=head2 C + +Returns C<'Data::MultiValued::Tags'>. + +=head2 C + +Returns C<('tag')>. + +=head2 C + +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 and +specialises it to use L as multi-value +storage: + +=head2 C + +Returns C<'Data::MultiValued::TagsAndRanges'>. + +=head2 C + +Returns C<('tag', 'from', 'to')>. + +=head2 C + +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. + +This module implements the storage for ranged data. It's similar to +L, but simpler (and slower). + +A range is defined by a pair of numbers, C and C, and it +contains C<< Num $x : $min <= $x < $max >>. C is treated as +"inf" (negative infinity if used as C or C, positive +infinity if used as C). + +The internal representation of a range is a hash with three keys, +C C C. + +=head1 METHODS + +=cut + has _storage => ( is => 'rw', isa => ArrayRef[ @@ -18,6 +39,16 @@ has _storage => ( default => sub { [ ] }, ); +=head2 C + + my $value = $obj->get({ at => $point }); + +Retrieves the range that includes the given point. Throws a +L 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 + + $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 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 + + $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 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 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 - 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 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 or C is equivalent to passing +C. + +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 + + my $value = $obj->get({ at => $point }); + +Retrieves the value for the given point. Throws a +L exception if no ranges +exist in this object that include the point (remember that a range +does not include its C point). + +A C<< at => undef >> means "at -Inf". Not passing in C is +equivalent to passing C. + +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 + + $obj->clear({ from => $min, to => $max }); + +Deletes all values for the given range. Throws +L if C<< $min > $max >>. + +A C<< from => undef >> means "from -Inf", and a C<< to => undef >> +means "to +Inf". Not passing in C or C is equivalent to +passing C. 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. + +=head2 C<_rebless_storage> + +Blesses the storage into L. + +=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, L + +=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. + +This module implements the storage for tagged data. It's almost +exactly a hash, the main difference being that C 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 (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 + + my $value = $obj->get({ tag => $the_tag }); + +Retrieves the "storage cell" for the given tag. Throws a +L exception if the tag +does not exists in this object. + +Not passing in a C 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 + + $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), sets it for +the tag, and returns it. + +Not passing in a C 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 + + $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, or passing C<< tag => undef >>, clears +everything. If you want to only clear the C 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 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. + +This module is a subclass of L, which +only allows instances of L 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 instance. + +=cut + sub _create_new_inferior { Data::MultiValued::RangeContainer->new(); } +=head1 Serialisation helpers + +These are used through +L. + +=head2 C<_rebless_storage> + +Blesses the "storage cells" into L. + +=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 - 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 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 + + my $value = $obj->get({ tag => $the_tag }); + +Retrieves the value for the given tag. Throws a +L exception if the tag +does not exists in this object. + +Not passing in a C 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 + + $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 clears everything. Yes, this means that there +is no way to just clear the value for the C 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. + +=head2 C<_rebless_storage> + +Blesses the storage into L. + +=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, L + +=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 - 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 and +L 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 + + my $value = $obj->get({ tag => $the_tag, at => $point }); + +Retrieves the value for the given tag and point. Throws a +L exception if no ranges +exist in this object that include the point, and +L exception if the tag +does not exists in this object. + +See L and +L for more details. + +=cut + sub get { my ($self,%args) = validated_hash( \@_, @@ -59,6 +91,20 @@ sub get { ->{value}; } +=head2 C + + $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 and +L 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. + +=head2 C<_rebless_storage> + +Blesses the storage into L, +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. + +=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 + + my $obj = My::Class->new_in_place($hashref); + +Directly Ces 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 + + 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 the hashref, or +do something equivalent (as in the synopsis), instead. + +=cut + 1; -- cgit v1.2.3