summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGianni Ceccarelli <dakkar@thenautilus.net>2011-11-10 11:42:31 +0000
committerGianni Ceccarelli <dakkar@thenautilus.net>2011-11-10 11:42:31 +0000
commita93d238ea41f767a40fc0177b0f46ea5f1d5200e (patch)
tree6abf62a77a6af15b7425ff0659c67fdeba96ca44
parentsilence a test (diff)
downloaddata-multivalued-a93d238ea41f767a40fc0177b0f46ea5f1d5200e.tar.gz
data-multivalued-a93d238ea41f767a40fc0177b0f46ea5f1d5200e.tar.bz2
data-multivalued-a93d238ea41f767a40fc0177b0f46ea5f1d5200e.zip
all traits, and some tests
-rw-r--r--Data-MultiValued/lib/Data/MultiValued/AttributeTrait.pm10
-rw-r--r--Data-MultiValued/lib/Data/MultiValued/AttributeTrait/Ranges.pm14
-rw-r--r--Data-MultiValued/lib/Data/MultiValued/AttributeTrait/Tags.pm2
-rw-r--r--Data-MultiValued/lib/Data/MultiValued/AttributeTrait/TagsAndRanges.pm14
-rw-r--r--Data-MultiValued/t/moose-ranges.t67
5 files changed, 105 insertions, 2 deletions
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();