summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGianni Ceccarelli <dakkar@thenautilus.net>2011-11-10 11:33:52 +0000
committerGianni Ceccarelli <dakkar@thenautilus.net>2011-11-10 11:33:52 +0000
commitfbad620423ae33a33b12a0276b4da41bd40f59d7 (patch)
treed80454569a430efad469c8ec1d7805a325274cc3
parent"fast" hash/bless for serialization (diff)
downloaddata-multivalued-fbad620423ae33a33b12a0276b4da41bd40f59d7.tar.gz
data-multivalued-fbad620423ae33a33b12a0276b4da41bd40f59d7.tar.bz2
data-multivalued-fbad620423ae33a33b12a0276b4da41bd40f59d7.zip
refactoring the traits
-rw-r--r--Data-MultiValued/lib/Data/MultiValued/AttributeAccessors.pm34
-rw-r--r--Data-MultiValued/lib/Data/MultiValued/AttributeTrait.pm (renamed from Data-MultiValued/lib/Data/MultiValued/AttributeTrait/Tagged.pm)47
-rw-r--r--Data-MultiValued/lib/Data/MultiValued/AttributeTrait/Tags.pm12
-rw-r--r--Data-MultiValued/t/json.t14
-rw-r--r--Data-MultiValued/t/moose-tagged.t18
5 files changed, 67 insertions, 58 deletions
diff --git a/Data-MultiValued/lib/Data/MultiValued/AttributeAccessors.pm b/Data-MultiValued/lib/Data/MultiValued/AttributeAccessors.pm
index e6fec67..cac3538 100644
--- a/Data-MultiValued/lib/Data/MultiValued/AttributeAccessors.pm
+++ b/Data-MultiValued/lib/Data/MultiValued/AttributeAccessors.pm
@@ -12,9 +12,9 @@ sub _generate_accessor_method {
return sub {
if (@_ >= 2) {
- $attr->set_tagged_value($_[0], {}, $_[1]);
+ $attr->set_multi_value($_[0], {}, $_[1]);
}
- $attr->get_tagged_value($_[0], {});
+ $attr->get_multi_value($_[0], {});
}
}
@@ -25,7 +25,7 @@ sub _generate_reader_method {
return sub {
confess "Cannot assign a value to a read-only accessor"
if @_ > 1;
- $attr->get_tagged_value($_[0], {});
+ $attr->get_multi_value($_[0], {});
};
}
@@ -34,7 +34,7 @@ sub _generate_writer_method {
my $attr = $self->associated_attribute;
return sub {
- $attr->set_tagged_value($_[0], {}, $_[1]);
+ $attr->set_multi_value($_[0], {}, $_[1]);
};
}
@@ -43,7 +43,7 @@ sub _generate_predicate_method {
my $attr = $self->associated_attribute;
return sub {
- $attr->has_tagged_value($_[0], {})
+ $attr->has_multi_value($_[0], {})
};
}
@@ -52,57 +52,57 @@ sub _generate_clearer_method {
my $attr = $self->associated_attribute;
return sub {
- $attr->clear_tagged_value($_[0], {})
+ $attr->clear_multi_value($_[0], {})
};
}
-sub _generate_tagged_accessor_method {
+sub _generate_multi_accessor_method {
my $self = shift;
my $attr = $self->associated_attribute;
return sub {
if (@_ >= 3) {
- $attr->set_tagged_value($_[0], $_[1], $_[2]);
+ $attr->set_multi_value($_[0], $_[1], $_[2]);
}
- $attr->get_tagged_value($_[0],$_[1]);
+ $attr->get_multi_value($_[0],$_[1]);
}
}
-sub _generate_tagged_reader_method {
+sub _generate_multi_reader_method {
my $self = shift;
my $attr = $self->associated_attribute;
return sub {
confess "Cannot assign a value to a read-only accessor"
if @_ > 2;
- $attr->get_tagged_value($_[0],$_[1]);
+ $attr->get_multi_value($_[0],$_[1]);
};
}
-sub _generate_tagged_writer_method {
+sub _generate_multi_writer_method {
my $self = shift;
my $attr = $self->associated_attribute;
return sub {
- $attr->set_tagged_value($_[0], $_[1], $_[2]);
+ $attr->set_multi_value($_[0], $_[1], $_[2]);
};
}
-sub _generate_tagged_predicate_method {
+sub _generate_multi_predicate_method {
my $self = shift;
my $attr = $self->associated_attribute;
return sub {
- $attr->has_tagged_value($_[0],$_[1])
+ $attr->has_multi_value($_[0],$_[1])
};
}
-sub _generate_tagged_clearer_method {
+sub _generate_multi_clearer_method {
my $self = shift;
my $attr = $self->associated_attribute;
return sub {
- $attr->clear_tagged_value($_[0],$_[1])
+ $attr->clear_multi_value($_[0],$_[1])
};
}
diff --git a/Data-MultiValued/lib/Data/MultiValued/AttributeTrait/Tagged.pm b/Data-MultiValued/lib/Data/MultiValued/AttributeTrait.pm
index 2a45506..263ce55 100644
--- a/Data-MultiValued/lib/Data/MultiValued/AttributeTrait/Tagged.pm
+++ b/Data-MultiValued/lib/Data/MultiValued/AttributeTrait.pm
@@ -1,8 +1,7 @@
-package Data::MultiValued::AttributeTrait::Tagged;
+package Data::MultiValued::AttributeTrait;
use Moose::Role;
-use Data::MultiValued::Tags;
use Data::MultiValued::AttributeAccessors;
-use MooseX::Types::Moose qw(Str HashRef);
+use MooseX::Types::Moose qw(Str);
use Try::Tiny;
use namespace::autoclean;
@@ -14,6 +13,8 @@ has 'full_storage_slot' => (
);
sub _build_full_storage_slot { shift->name . '__MULTIVALUED_STORAGE__' }
+requires 'multivalue_storage_class';
+
around slots => sub {
my ($orig, $self) = @_;
return ($self->$orig(), $self->full_storage_slot);
@@ -22,7 +23,7 @@ around slots => sub {
sub set_full_storage {
my ($self,$instance) = @_;
- my $ret = Data::MultiValued::Tags->new();
+ my $ret = $self->multivalue_storage_class->new();
$self->associated_class->get_meta_instance->set_slot_value(
$instance,
$self->full_storage_slot,
@@ -59,13 +60,13 @@ after install_accessors => sub {
my $check = "has_$meth";
next unless $self->$check;
- my $type = "tagged_$meth";
+ my $type = "multi_$meth";
my $basename = $self->$meth;
die 'MultiValued attribute trait is not compatible with subref accessors'
if ref($basename);
- my $name = "${basename}_tagged";
+ my $name = "${basename}_multi";
$class->add_method(
$self->_process_accessors($type => $name,0)
@@ -73,7 +74,7 @@ after install_accessors => sub {
}
};
-sub load_tagged_value {
+sub load_multi_value {
my ($self,$instance,$opts) = @_;
my $value;my $found=1;
@@ -105,7 +106,7 @@ sub raw_clear_value {
);
}
-sub store_tagged_value {
+sub store_multi_value {
my ($self,$instance,$opts) = @_;
my $value = $self->get_raw_value($instance);
@@ -117,10 +118,10 @@ our $dyn_opts = {};
before get_value => sub {
my ($self,$instance) = @_;
- $self->load_tagged_value($instance,$dyn_opts);
+ $self->load_multi_value($instance,$dyn_opts);
};
-sub get_tagged_value {
+sub get_multi_value {
my ($self,$instance,$opts,$value) = @_;
local $dyn_opts = $opts;
@@ -131,16 +132,16 @@ sub get_tagged_value {
after set_initial_value => sub {
my ($self,$instance,$value) = @_;
- $self->store_tagged_value($instance,$dyn_opts);
+ $self->store_multi_value($instance,$dyn_opts);
};
after set_value => sub {
my ($self,$instance,$value) = @_;
- $self->store_tagged_value($instance,$dyn_opts);
+ $self->store_multi_value($instance,$dyn_opts);
};
-sub set_tagged_value {
+sub set_multi_value {
my ($self,$instance,$opts,$value) = @_;
local $dyn_opts = $opts;
@@ -151,10 +152,10 @@ sub set_tagged_value {
before has_value => sub {
my ($self,$instance) = @_;
- $self->load_tagged_value($instance,$dyn_opts);
+ $self->load_multi_value($instance,$dyn_opts);
};
-sub has_tagged_value {
+sub has_multi_value {
my ($self,$instance,$opts) = @_;
local $dyn_opts = $opts;
@@ -169,7 +170,7 @@ after clear_value => sub {
$self->full_storage($instance)->clear($dyn_opts);
};
-sub clear_tagged_value {
+sub clear_multi_value {
my ($self,$instance,$opts) = @_;
local $dyn_opts = $opts;
@@ -177,14 +178,14 @@ sub clear_tagged_value {
return $self->clear_value($instance);
}
-sub get_tagged_read_method {
+sub get_multi_read_method {
my $self = shift;
- return $self->get_read_method . '_tagged';
+ return $self->get_read_method . '_multi';
}
-sub get_tagged_write_method {
+sub get_multi_write_method {
my $self = shift;
- return $self->get_write_method . '_tagged';
+ return $self->get_write_method . '_multi';
}
sub _rebless_slot {
@@ -193,7 +194,7 @@ sub _rebless_slot {
my $st = $self->get_full_storage($instance);
return unless $st;
- bless $st, 'Data::MultiValued::Tags';
+ bless $st, $self->multivalue_storage_class;
$st->_rebless_storage;
}
@@ -206,8 +207,4 @@ sub _as_hash {
return $st->_as_hash;
}
-package Moose::Meta::Attribute::Custom::Trait::MultiValued::Tagged;{
-sub register_implementation { 'Data::MultiValued::AttributeTrait::Tagged' }
-}
-
1;
diff --git a/Data-MultiValued/lib/Data/MultiValued/AttributeTrait/Tags.pm b/Data-MultiValued/lib/Data/MultiValued/AttributeTrait/Tags.pm
new file mode 100644
index 0000000..fff5776
--- /dev/null
+++ b/Data-MultiValued/lib/Data/MultiValued/AttributeTrait/Tags.pm
@@ -0,0 +1,12 @@
+package Data::MultiValued::AttributeTrait::Tags;
+use Moose::Role;
+use Data::MultiValued::Tags;
+with 'Data::MultiValued::AttributeTrait';
+
+sub multivalue_storage_class { 'Data::MultiValued::Tags' };
+
+package Moose::Meta::Attribute::Custom::Trait::MultiValued::Tags;{
+sub register_implementation { 'Data::MultiValued::AttributeTrait::Tags' }
+}
+
+1;
diff --git a/Data-MultiValued/t/json.t b/Data-MultiValued/t/json.t
index 09664bf..ca7986b 100644
--- a/Data-MultiValued/t/json.t
+++ b/Data-MultiValued/t/json.t
@@ -3,13 +3,13 @@ use strict;
use warnings;
package Foo;{
use Moose;
-use Data::MultiValued::AttributeTrait::Tagged;
+use Data::MultiValued::AttributeTrait::Tags;
use Data::Printer;
has stuff => (
is => 'rw',
isa => 'Int',
- traits => ['MultiValued::Tagged'],
+ traits => ['MultiValued::Tags'],
default => 3,
predicate => 'has_stuff',
clearer => 'clear_stuff',
@@ -18,7 +18,7 @@ has stuff => (
has other => (
is => 'rw',
isa => 'Str',
- traits => ['MultiValued::Tagged'],
+ traits => ['MultiValued::Tags'],
predicate => 'has_other',
clearer => 'clear_other',
);
@@ -31,7 +31,7 @@ sub new_in_place {
p $self;
for my $attr ($class->meta->get_all_attributes) {
- if ($attr->does('MultiValued::Tagged')) {
+ if ($attr->does('MultiValued::Tags')) {
$attr->_rebless_slot($self);
}
}
@@ -43,7 +43,7 @@ sub as_hash {
my %ret = %$self;
for my $attr ($self->meta->get_all_attributes) {
- if ($attr->does('MultiValued::Tagged')) {
+ if ($attr->does('MultiValued::Tags')) {
my $st = $attr->_as_hash($self);
if ($st) {
$ret{$attr->full_storage_slot} = $st;
@@ -66,7 +66,7 @@ my $opts={tag=>'something'};
my $json = JSON::XS->new->utf8;
my $obj = Foo->new(other=>'foo');
-$obj->stuff_tagged($opts,1234);
+$obj->stuff_multi($opts,1234);
my $hash = $obj->as_hash;
note p $hash;
my $str = $json->encode($hash);
@@ -78,7 +78,7 @@ note p $obj;
note p $obj2;
is($obj2->stuff,$obj->stuff,'stuff');
-is($obj2->stuff_tagged($opts),$obj->stuff_tagged($opts),'stuff tagged');
+is($obj2->stuff_multi($opts),$obj->stuff_multi($opts),'stuff tagged');
is($obj2->other,$obj->other,'other');
done_testing;
diff --git a/Data-MultiValued/t/moose-tagged.t b/Data-MultiValued/t/moose-tagged.t
index 86fb8b9..6e1ac7a 100644
--- a/Data-MultiValued/t/moose-tagged.t
+++ b/Data-MultiValued/t/moose-tagged.t
@@ -4,12 +4,12 @@ use warnings;
package Foo;{
use Moose;
-use Data::MultiValued::AttributeTrait::Tagged;
+use Data::MultiValued::AttributeTrait::Tags;
has stuff => (
is => 'rw',
isa => 'Int',
- traits => ['MultiValued::Tagged'],
+ traits => ['MultiValued::Tags'],
default => 3,
predicate => 'has_stuff',
clearer => 'clear_stuff',
@@ -18,7 +18,7 @@ has stuff => (
has other => (
is => 'rw',
isa => 'Str',
- traits => ['MultiValued::Tagged'],
+ traits => ['MultiValued::Tags'],
predicate => 'has_other',
clearer => 'clear_other',
);
@@ -52,16 +52,16 @@ subtest 'with tags' => sub {
my $opts = {tag=>'one'};
ok($obj->has_stuff,'has stuff');
- ok(!$obj->has_stuff_tagged($opts),'not has stuff tagged');
+ ok(!$obj->has_stuff_multi($opts),'not has stuff tagged');
ok(!$obj->has_other,'not has other');
- ok(!$obj->has_other_tagged($opts),'not has other tagged');
+ ok(!$obj->has_other_multi($opts),'not has other tagged');
- $obj->stuff_tagged($opts,7);
- $obj->other_tagged($opts,'foo');
+ $obj->stuff_multi($opts,7);
+ $obj->other_multi($opts,'foo');
is($obj->stuff,3,'default');
- is($obj->stuff_tagged($opts),7,'stuff tagged');
- is($obj->other_tagged($opts),'foo','other tagged');
+ is($obj->stuff_multi($opts),7,'stuff tagged');
+ is($obj->other_multi($opts),'foo','other tagged');
};
done_testing();