From f3843b86e5173a11c084287c00edf0fa1f9fb817 Mon Sep 17 00:00:00 2001 From: Gianni Ceccarelli Date: Tue, 11 Dec 2012 17:08:10 +0000 Subject: add all_tags etc --- lib/Data/MultiValued/AttributeTrait/Ranges.pm | 18 +++++++++ lib/Data/MultiValued/AttributeTrait/Tags.pm | 20 +++++++++ .../MultiValued/AttributeTrait/TagsAndRanges.pm | 47 ++++++++++++++++++++++ lib/Data/MultiValued/Tags.pm | 6 +-- lib/Data/MultiValued/TagsAndRanges.pm | 6 +-- 5 files changed, 91 insertions(+), 6 deletions(-) (limited to 'lib') diff --git a/lib/Data/MultiValued/AttributeTrait/Ranges.pm b/lib/Data/MultiValued/AttributeTrait/Ranges.pm index 2b9a0ff..a629f11 100644 --- a/lib/Data/MultiValued/AttributeTrait/Ranges.pm +++ b/lib/Data/MultiValued/AttributeTrait/Ranges.pm @@ -39,12 +39,30 @@ Returns C<('from', 'to')>. Returns C<('at')>. +=head2 C + + my @ranges = $obj->meta->get_attribute('my_attr')->all_ranges($obj); + +Returns a list of 2-element arrayrefs, each arrayref describing the +extremes of a range. Something like: + + [ [undef,10], [10,20], [20,undef] ] + =cut sub multivalue_storage_class { 'Data::MultiValued::Ranges' }; sub opts_to_pass_set { qw(from to) } sub opts_to_pass_get { qw(at) } +sub all_ranges { + my ($self,$instance) = @_; + + my $storage = $self->get_full_storage($instance); + return unless $storage; + + return $storage->_storage->all_ranges; +} + package Moose::Meta::Attribute::Custom::Trait::MultiValued::Ranges;{ sub register_implementation { 'Data::MultiValued::AttributeTrait::Ranges' } } diff --git a/lib/Data/MultiValued/AttributeTrait/Tags.pm b/lib/Data/MultiValued/AttributeTrait/Tags.pm index 2ea848e..7803c24 100644 --- a/lib/Data/MultiValued/AttributeTrait/Tags.pm +++ b/lib/Data/MultiValued/AttributeTrait/Tags.pm @@ -39,12 +39,32 @@ Returns C<('tag')>. Returns C<('tag')>. +=head2 C + + my @tags = $obj->meta->get_attribute('my_attr')->all_tags($obj); + +Returns a list of all values for which C<< +$obj->has_my_attr_multi({tag=>$tag}) >> would return true. + =cut sub multivalue_storage_class { 'Data::MultiValued::Tags' }; sub opts_to_pass_set { qw(tag) } sub opts_to_pass_get { qw(tag) } +sub all_tags { + my ($self,$instance) = @_; + + my $storage = $self->get_full_storage($instance); + return () unless $storage; + + my @tags = $storage->_storage->all_tags; + if ($storage->_storage->_has_default_tag) { + push @tags,undef; + } + return @tags; +} + package Moose::Meta::Attribute::Custom::Trait::MultiValued::Tags;{ sub register_implementation { 'Data::MultiValued::AttributeTrait::Tags' } } diff --git a/lib/Data/MultiValued/AttributeTrait/TagsAndRanges.pm b/lib/Data/MultiValued/AttributeTrait/TagsAndRanges.pm index 36b7cf9..10a1a94 100644 --- a/lib/Data/MultiValued/AttributeTrait/TagsAndRanges.pm +++ b/lib/Data/MultiValued/AttributeTrait/TagsAndRanges.pm @@ -39,12 +39,59 @@ Returns C<('tag', 'from', 'to')>. Returns C<('tag', 'at')>. +=head2 C + + my @tags = $obj->meta->get_attribute('my_attr')->all_tags($obj); + +Returns a list of all values for which C<< +$obj->has_my_attr_multi({tag=>$tag}) >> would return true. + +=head2 C + + my @tags_and_ranges = $obj->meta->get_attribute('my_attr') + ->all_tags_and_ranges($obj); + +Returns a list of 2-element arrayrefs. The first element of each +arrayref is a tag (possibly C), the second element is an +arrayref of 2-element arrayrefs, each arrayref describing the extremes +of a range. Something like: + + [ + [ 'x', [ [undef,10], [10,20], [20,undef] ] ], + [ undef, [ [undef,undef] ] ], + ], + =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) } +require Data::MultiValued::AttributeTrait::Tags; + +sub all_tags { + my ($self,$instance) = @_; + return $self->Data::MultiValued::AttributeTrait::Tags::all_tags($instance); +} + +sub all_tags_and_ranges { + my ($self,$instance) = @_; + + my $storage = $self->get_full_storage($instance); + return unless $storage; + + my @tags = $self->all_tags($instance); + + my @tags_and_ranges; + for my $tag (@tags) { + my @these_ranges = $storage->_storage + ->get({tag=>$tag})->all_ranges; + push @tags_and_ranges,[$tag, \@these_ranges]; + } + + return @tags_and_ranges; +} + package Moose::Meta::Attribute::Custom::Trait::MultiValued::TagsAndRanges;{ sub register_implementation { 'Data::MultiValued::AttributeTrait::TagsAndRanges' } } diff --git a/lib/Data/MultiValued/Tags.pm b/lib/Data/MultiValued/Tags.pm index 063a778..2e8f38e 100644 --- a/lib/Data/MultiValued/Tags.pm +++ b/lib/Data/MultiValued/Tags.pm @@ -51,7 +51,7 @@ just stored. sub set { my ($self,%args) = validated_hash( \@_, - tag => { isa => 'Str', optional => 1, }, + tag => { isa => 'Maybe[Str]', optional => 1, }, value => { isa => 'Any', }, ); @@ -78,7 +78,7 @@ untouched. sub get { my ($self,%args) = validated_hash( \@_, - tag => { isa => 'Str', optional => 1, }, + tag => { isa => 'Maybe[Str]', optional => 1, }, ); $self->_storage->get(\%args) @@ -100,7 +100,7 @@ is no way to just clear the value for the C tag. sub clear { my ($self,%args) = validated_hash( \@_, - tag => { isa => 'Str', optional => 1, }, + tag => { isa => 'Maybe[Str]', optional => 1, }, ); $self->_storage->clear(\%args); diff --git a/lib/Data/MultiValued/TagsAndRanges.pm b/lib/Data/MultiValued/TagsAndRanges.pm index 43bff6b..b0fc694 100644 --- a/lib/Data/MultiValued/TagsAndRanges.pm +++ b/lib/Data/MultiValued/TagsAndRanges.pm @@ -53,7 +53,7 @@ sub set { \@_, from => { isa => 'Num|Undef', optional => 1, }, to => { isa => 'Num|Undef', optional => 1, }, - tag => { isa => 'Str', optional => 1, }, + tag => { isa => 'Maybe[Str]', optional => 1, }, value => { isa => 'Any', }, ); @@ -82,7 +82,7 @@ sub get { my ($self,%args) = validated_hash( \@_, at => { isa => 'Num|Undef', optional => 1, }, - tag => { isa => 'Str', optional => 1, }, + tag => { isa => 'Maybe[Str]', optional => 1, }, ); $self->_storage->get(\%args) @@ -109,7 +109,7 @@ sub clear { \@_, from => { isa => 'Num|Undef', optional => 1, }, to => { isa => 'Num|Undef', optional => 1, }, - tag => { isa => 'Str', optional => 1, }, + tag => { isa => 'Maybe[Str]', optional => 1, }, ); if (exists $args{from} || exists $args{to}) { -- cgit v1.2.3