From a93d238ea41f767a40fc0177b0f46ea5f1d5200e Mon Sep 17 00:00:00 2001
From: Gianni Ceccarelli <dakkar@thenautilus.net>
Date: Thu, 10 Nov 2011 11:42:31 +0000
Subject: all traits, and some tests

---
 .../lib/Data/MultiValued/AttributeTrait.pm         | 10 +++-
 .../lib/Data/MultiValued/AttributeTrait/Ranges.pm  | 14 +++++
 .../lib/Data/MultiValued/AttributeTrait/Tags.pm    |  2 +
 .../MultiValued/AttributeTrait/TagsAndRanges.pm    | 14 +++++
 Data-MultiValued/t/moose-ranges.t                  | 67 ++++++++++++++++++++++
 5 files changed, 105 insertions(+), 2 deletions(-)
 create mode 100644 Data-MultiValued/lib/Data/MultiValued/AttributeTrait/Ranges.pm
 create mode 100644 Data-MultiValued/lib/Data/MultiValued/AttributeTrait/TagsAndRanges.pm
 create mode 100644 Data-MultiValued/t/moose-ranges.t

diff --git a/Data-MultiValued/lib/Data/MultiValued/AttributeTrait.pm b/Data-MultiValued/lib/Data/MultiValued/AttributeTrait.pm
index 263ce55..32b40bb 100644
--- a/Data-MultiValued/lib/Data/MultiValued/AttributeTrait.pm
+++ b/Data-MultiValued/lib/Data/MultiValued/AttributeTrait.pm
@@ -14,6 +14,8 @@ 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';
 
 around slots => sub {
     my ($orig, $self) = @_;
@@ -77,9 +79,11 @@ after install_accessors => sub {
 sub load_multi_value {
     my ($self,$instance,$opts) = @_;
 
+    my %opts_passed = map { $_ => $opts->{$_} } $self->opts_to_pass_get;
+
     my $value;my $found=1;
     try {
-        $value = $self->full_storage($instance)->get($opts);
+        $value = $self->full_storage($instance)->get(\%opts_passed);
     }
     catch {
         unless (ref($_) && $_->isa('Data::MultiValued::Exceptions::NotFound')) {
@@ -109,8 +113,10 @@ sub raw_clear_value {
 sub store_multi_value {
     my ($self,$instance,$opts) = @_;
 
+    my %opts_passed = map { $_ => $opts->{$_} } $self->opts_to_pass_set;
+
     my $value = $self->get_raw_value($instance);
-    $self->full_storage($instance)->set({%$opts,value=>$value});
+    $self->full_storage($instance)->set({%opts_passed,value=>$value});
 }
 
 our $dyn_opts = {};
diff --git a/Data-MultiValued/lib/Data/MultiValued/AttributeTrait/Ranges.pm b/Data-MultiValued/lib/Data/MultiValued/AttributeTrait/Ranges.pm
new file mode 100644
index 0000000..8d93578
--- /dev/null
+++ b/Data-MultiValued/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/Data-MultiValued/lib/Data/MultiValued/AttributeTrait/Tags.pm b/Data-MultiValued/lib/Data/MultiValued/AttributeTrait/Tags.pm
index fff5776..7cffb33 100644
--- a/Data-MultiValued/lib/Data/MultiValued/AttributeTrait/Tags.pm
+++ b/Data-MultiValued/lib/Data/MultiValued/AttributeTrait/Tags.pm
@@ -4,6 +4,8 @@ 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' }
diff --git a/Data-MultiValued/lib/Data/MultiValued/AttributeTrait/TagsAndRanges.pm b/Data-MultiValued/lib/Data/MultiValued/AttributeTrait/TagsAndRanges.pm
new file mode 100644
index 0000000..e0c56cd
--- /dev/null
+++ b/Data-MultiValued/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/Data-MultiValued/t/moose-ranges.t b/Data-MultiValued/t/moose-ranges.t
new file mode 100644
index 0000000..404e649
--- /dev/null
+++ b/Data-MultiValued/t/moose-ranges.t
@@ -0,0 +1,67 @@
+#!perl
+use strict;
+use warnings;
+
+package Foo;{
+use Moose;
+use Data::MultiValued::AttributeTrait::Ranges;
+
+has stuff => (
+    is => 'rw',
+    isa => 'Int',
+    traits => ['MultiValued::Ranges'],
+    default => 3,
+    predicate => 'has_stuff',
+    clearer => 'clear_stuff',
+);
+
+has other => (
+    is => 'rw',
+    isa => 'Str',
+    traits => ['MultiValued::Ranges'],
+    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');
+};
+
+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');
+};
+
+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');
+};
+
+done_testing();
-- 
cgit v1.2.3