refactoring the traits

2 files changed, 12 insertions, 213 deletions

diff --git a/Data-MultiValued/lib/Data/MultiValued/AttributeTrait/Tagged.pm b/Data-MultiValued/lib/Data/MultiValued/AttributeTrait/Tagged.pm
deleted file mode 100644
index 2a45506..0000000
--- a/Data-MultiValued/lib/Data/MultiValued/AttributeTrait/Tagged.pm
+++ /dev/null
@@ -1,213 +0,0 @@
-package Data::MultiValued::AttributeTrait::Tagged;
-use Moose::Role;
-use Data::MultiValued::Tags;
-use Data::MultiValued::AttributeAccessors;
-use MooseX::Types::Moose qw(Str HashRef);
-use Try::Tiny;
-use namespace::autoclean;
-
-has 'full_storage_slot' => (
-    is => 'ro',
-    isa => Str,
-    lazy_build => 1,
-    init_arg => undef,
-);
-sub _build_full_storage_slot { shift->name . '__MULTIVALUED_STORAGE__' }
-
-around slots => sub {
-    my ($orig, $self) = @_;
-    return ($self->$orig(), $self->full_storage_slot);
-};
-
-sub set_full_storage {
-    my ($self,$instance) = @_;
-
-    my $ret = Data::MultiValued::Tags->new();
-    $self->associated_class->get_meta_instance->set_slot_value(
-        $instance,
-        $self->full_storage_slot,
-        $ret,
-    );
-    return $ret;
-}
-
-sub get_full_storage {
-    my ($self,$instance) = @_;
-
-    return $self->associated_class->get_meta_instance
-        ->get_slot_value(
-            $instance,
-            $self->full_storage_slot,
-        );
-}
-
-sub full_storage {
-    my ($self,$instance) = @_;
-
-    return $self->get_full_storage($instance)
-        || $self->set_full_storage($instance);
-}
-
-sub accessor_metaclass { 'Data::MultiValued::AttributeAccessors' }
-
-after install_accessors => sub {
-    my ($self) = @_;
-
-    my $class  = $self->associated_class;
-
-    for my $meth (qw(accessor reader writer predicate clearer)) {
-        my $check = "has_$meth";
-        next unless $self->$check;
-
-        my $type = "tagged_$meth";
-        my $basename = $self->$meth;
-
-        die 'MultiValued attribute trait is not compatible with subref accessors'
-            if ref($basename);
-
-        my $name = "${basename}_tagged";
-
-        $class->add_method(
-            $self->_process_accessors($type => $name,0)
-        );
-    }
-};
-
-sub load_tagged_value {
-    my ($self,$instance,$opts) = @_;
-
-    my $value;my $found=1;
-    try {
-        $value = $self->full_storage($instance)->get($opts);
-    }
-    catch {
-        unless (ref($_) && $_->isa('Data::MultiValued::Exceptions::NotFound')) {
-            die $_;
-        }
-        $found = 0;
-    };
-
-    if ($found) {
-        $self->set_raw_value($instance,$value);
-    }
-    else {
-        $self->raw_clear_value($instance);
-    }
-}
-
-sub raw_clear_value {
-    my ($self,$instance) = @_;
-
-    $self->associated_class->get_meta_instance
-        ->deinitialize_slot(
-            $instance,
-            $self->name,
-        );
-}
-
-sub store_tagged_value {
-    my ($self,$instance,$opts) = @_;
-
-    my $value = $self->get_raw_value($instance);
-    $self->full_storage($instance)->set({%$opts,value=>$value});
-}
-
-our $dyn_opts = {};
-
-before get_value => sub {
-    my ($self,$instance) = @_;
-
-    $self->load_tagged_value($instance,$dyn_opts);
-};
-
-sub get_tagged_value {
-    my ($self,$instance,$opts,$value) = @_;
-
-    local $dyn_opts = $opts;
-
-    return $self->get_value($instance,$value);
-}
-
-after set_initial_value => sub {
-    my ($self,$instance,$value) = @_;
-
-    $self->store_tagged_value($instance,$dyn_opts);
-};
-
-after set_value => sub {
-    my ($self,$instance,$value) = @_;
-
-    $self->store_tagged_value($instance,$dyn_opts);
-};
-
-sub set_tagged_value {
-    my ($self,$instance,$opts,$value) = @_;
-
-    local $dyn_opts = $opts;
-
-    return $self->set_value($instance,$value);
-}
-
-before has_value => sub {
-    my ($self,$instance) = @_;
-
-    $self->load_tagged_value($instance,$dyn_opts);
-};
-
-sub has_tagged_value {
-    my ($self,$instance,$opts) = @_;
-
-    local $dyn_opts = $opts;
-
-    return $self->has_value($instance);
-}
-
-after clear_value => sub {
-    my ($self,$instance) = @_;
-
-    # XXX NIY
-    $self->full_storage($instance)->clear($dyn_opts);
-};
-
-sub clear_tagged_value {
-    my ($self,$instance,$opts) = @_;
-
-    local $dyn_opts = $opts;
-
-    return $self->clear_value($instance);
-}
-
-sub get_tagged_read_method  { 
-    my $self   = shift;
-    return $self->get_read_method . '_tagged';
-}
-
-sub get_tagged_write_method  { 
-    my $self   = shift;
-    return $self->get_write_method . '_tagged';
-}
-
-sub _rebless_slot {
-    my ($self,$instance) = @_;
-
-    my $st = $self->get_full_storage($instance);
-    return unless $st;
-
-    bless $st, 'Data::MultiValued::Tags';
-    $st->_rebless_storage;
-}
-
-sub _as_hash {
-    my ($self,$instance) = @_;
-
-    my $st = $self->get_full_storage($instance);
-    return unless $st;
-
-    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;