add all_tags etcv0.0.7_1-dzilla

9 files changed, 289 insertions, 6 deletions

diff --git a/Changes b/Changes
index 763f639..8a29223 100644
--- a/Changes
+++ b/Changes
@@ -1,6 +1,7 @@
 Revision history for Data::MultiValued
 
 {{$NEXT}}
+  - add all_tags, all_ranges, all_tags_and_ranges methods
 
 0.0.6_1   2012-01-30 14:09:43 Europe/London
 
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<all_ranges>
+
+  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<all_tags>
+
+  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<all_tags>
+
+  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<all_tags_and_ranges>
+
+  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<undef>), 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<undef> 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}) {
diff --git a/t/moose-ranges.t b/t/moose-ranges.t
index 404e649..35ff83d 100644
--- a/t/moose-ranges.t
+++ b/t/moose-ranges.t
@@ -34,6 +34,15 @@ subtest 'default' => sub {
     ok($obj->has_stuff,'has stuff');
 
     is($obj->stuff,3,'default');
+
+    cmp_deeply(
+        [$obj->meta->get_attribute('stuff')->all_ranges($obj)],
+        [[undef,undef]],
+        'stuff all_ranges');
+    cmp_deeply(
+        [$obj->meta->get_attribute('other')->all_ranges($obj)],
+        [],
+        'other all_ranges');
 };
 
 subtest 'constructor param' => sub {
@@ -44,6 +53,15 @@ subtest 'constructor param' => sub {
 
     is($obj->stuff,12,'param');
     is($obj->other,'bar','param');
+
+    cmp_deeply(
+        [$obj->meta->get_attribute('stuff')->all_ranges($obj)],
+        [[undef,undef]],
+        'stuff all_ranges');
+    cmp_deeply(
+        [$obj->meta->get_attribute('other')->all_ranges($obj)],
+        [[undef,undef]],
+        'other all_ranges');
 };
 
 subtest 'with ranges' => sub {
@@ -62,6 +80,15 @@ subtest 'with ranges' => sub {
     is($obj->stuff,3,'default');
     is($obj->stuff_multi($opts),7,'stuff ranged');
     is($obj->other_multi($opts),'foo','other ranged');
+
+    cmp_deeply(
+        [$obj->meta->get_attribute('stuff')->all_ranges($obj)],
+        [[undef,10],[10,20],[20,undef]],
+        'stuff all_ranges');
+    cmp_deeply(
+        [$obj->meta->get_attribute('other')->all_ranges($obj)],
+        [[10,20]],
+        'other all_ranges');
 };
 
 done_testing();
diff --git a/t/moose-tagged.t b/t/moose-tagged.t
index 1273bed..8e7dd97 100644
--- a/t/moose-tagged.t
+++ b/t/moose-tagged.t
@@ -39,6 +39,15 @@ subtest 'default' => sub {
     ok($obj->has_stuff,'has stuff');
 
     is($obj->stuff,3,'default');
+
+    cmp_deeply(
+        [$obj->meta->get_attribute('stuff')->all_tags($obj)],
+        [undef],
+        'stuff all_tags');
+    cmp_deeply(
+        [$obj->meta->get_attribute('other')->all_tags($obj)],
+        [],
+        'other all_tags');
 };
 
 subtest 'constructor param' => sub {
@@ -49,6 +58,15 @@ subtest 'constructor param' => sub {
 
     is($obj->stuff,12,'param');
     is($obj->other,'bar','param');
+
+    cmp_deeply(
+        [$obj->meta->get_attribute('stuff')->all_tags($obj)],
+        [undef],
+        'stuff all_tags');
+    cmp_deeply(
+        [$obj->meta->get_attribute('other')->all_tags($obj)],
+        [undef],
+        'other all_tags');
 };
 
 subtest 'with tags' => sub {
@@ -67,6 +85,22 @@ subtest 'with tags' => sub {
     is($obj->stuff,3,'default');
     is($obj->stuff_tagged($opts),7,'stuff tagged');
     is($obj->other_multi($opts),'foo','other tagged');
+
+    cmp_deeply(
+        [$obj->meta->get_attribute('stuff')->all_tags($obj)],
+        bag(undef,'one'),
+       'stuff all_tags');
+    cmp_deeply(
+        [$obj->meta->get_attribute('other')->all_tags($obj)],
+        bag('one'),
+       'other all_tags');
+
+    my @tags = $obj->meta->get_attribute('stuff')->all_tags($obj);
+    my $pred=$obj->meta->get_attribute('stuff')->multi_predicate;
+    for my $tag (@tags) {
+        ok($obj->$pred({tag=>$tag}),"stuff has tag @{[ $tag || 'undef' ]}");
+    }
+
 };
 
 done_testing();
diff --git a/t/moose-tags-ranges.t b/t/moose-tags-ranges.t
new file mode 100644
index 0000000..bb8fb06
--- /dev/null
+++ b/t/moose-tags-ranges.t
@@ -0,0 +1,136 @@
+#!perl
+use strict;
+use warnings;
+
+package Foo;{
+use Moose;
+use Data::MultiValued::AttributeTrait::TagsAndRanges;
+
+has stuff => (
+    is => 'rw',
+    isa => 'Int',
+    traits => ['MultiValued::TagsAndRanges'],
+    default => 3,
+    predicate => 'has_stuff',
+    clearer => 'clear_stuff',
+);
+
+has other => (
+    is => 'rw',
+    isa => 'Str',
+    traits => ['MultiValued::TagsAndRanges'],
+    predicate => 'has_other',
+    clearer => 'clear_other',
+);
+}
+package main;
+use Test::Most 'die';
+use Data::Printer;
+
+subtest 'default' => sub {
+    my $obj = Foo->new();
+
+    ok(!$obj->has_other,'not has other');
+    ok($obj->has_stuff,'has stuff');
+
+    is($obj->stuff,3,'default');
+
+    cmp_deeply(
+        [$obj->meta->get_attribute('stuff')->all_tags_and_ranges($obj)],
+        [[undef, [[undef,undef]]]],
+        'stuff all_ranges');
+    cmp_deeply(
+        [$obj->meta->get_attribute('other')->all_tags_and_ranges($obj)],
+        [],
+        'other all_ranges');
+};
+
+subtest 'constructor param' => sub {
+    my $obj = Foo->new({stuff=>12,other=>'bar'});
+
+    ok($obj->has_other,'has other');
+    ok($obj->has_stuff,'has stuff');
+
+    is($obj->stuff,12,'param');
+    is($obj->other,'bar','param');
+
+    cmp_deeply(
+        [$obj->meta->get_attribute('stuff')->all_tags_and_ranges($obj)],
+        [[undef, [[undef,undef]]]],
+        'stuff all_ranges');
+    cmp_deeply(
+        [$obj->meta->get_attribute('other')->all_tags_and_ranges($obj)],
+        [[undef, [[undef,undef]]]],
+        'other all_ranges');
+};
+
+subtest 'with ranges' => sub {
+    my $obj = Foo->new();
+
+    my $opts = {from=>10,to=>20,at=>15};
+
+    ok($obj->has_stuff,'has stuff');
+    ok($obj->has_stuff_multi($opts),'has stuff ranged (forever)');
+    ok(!$obj->has_other,'not has other');
+    ok(!$obj->has_other_multi($opts),'not has other ranged');
+
+    $obj->stuff_multi($opts,7);
+    $obj->other_multi($opts,'foo');
+
+    is($obj->stuff,3,'default');
+    is($obj->stuff_multi($opts),7,'stuff ranged');
+    is($obj->other_multi($opts),'foo','other ranged');
+
+    cmp_deeply(
+        [$obj->meta->get_attribute('stuff')->all_tags($obj)],
+        [undef],
+        'stuff all_tags');
+
+    cmp_deeply(
+        [$obj->meta->get_attribute('stuff')->all_tags_and_ranges($obj)],
+        [[undef, [[undef,10],[10,20],[20,undef]]]],
+        'stuff all_tags_and_ranges');
+
+    cmp_deeply(
+        [$obj->meta->get_attribute('other')->all_tags_and_ranges($obj)],
+        [[undef, [[10,20]]]],
+        'other all_tags_and_ranges');
+};
+
+subtest 'with tags and ranges' => sub {
+    my $obj = Foo->new();
+
+    my $opts = {from=>10,to=>20,at=>15,tag=>'x'};
+
+    ok($obj->has_stuff,'has stuff');
+    ok(!$obj->has_stuff_multi($opts),'has stuff ranged (forever)');
+    ok(!$obj->has_other,'not has other');
+    ok(!$obj->has_other_multi($opts),'not has other ranged');
+
+    $obj->stuff_multi($opts,7);
+    $obj->other_multi($opts,'foo');
+
+    is($obj->stuff,3,'default');
+    is($obj->stuff_multi($opts),7,'stuff ranged');
+    is($obj->other_multi($opts),'foo','other ranged');
+
+    cmp_deeply(
+        [$obj->meta->get_attribute('stuff')->all_tags($obj)],
+        bag(undef,'x'),
+        'stuff all_tags');
+
+    cmp_deeply(
+        [$obj->meta->get_attribute('stuff')->all_tags_and_ranges($obj)],
+        bag(
+            ['x', [[10,20]]],
+            [undef,[[undef,undef]]],
+        ),
+        'stuff all_tags_and_ranges');
+
+    cmp_deeply(
+        [$obj->meta->get_attribute('other')->all_tags_and_ranges($obj)],
+        [['x', [[10,20]]]],
+        'other all_tags_and_ranges');
+};
+
+done_testing();