allow (and test) custom-named multi accessors

1 files changed, 21 insertions, 8 deletions

diff --git a/lib/Data/MultiValued/AttributeTrait.pm b/lib/Data/MultiValued/AttributeTrait.pm
index 91e1b13..cd81c33 100644
--- a/lib/Data/MultiValued/AttributeTrait.pm
+++ b/lib/Data/MultiValued/AttributeTrait.pm
@@ -9,7 +9,6 @@ has 'full_storage_slot' => (
     is => 'ro',
     isa => Str,
     lazy_build => 1,
-    init_arg => undef,
 );
 sub _build_full_storage_slot { shift->name . '__MULTIVALUED_STORAGE__' }
 
@@ -17,6 +16,16 @@ requires 'multivalue_storage_class';
 requires 'opts_to_pass_set';
 requires 'opts_to_pass_get';
 
+my @accs_to_multiply=qw(accessor reader writer predicate clearer);
+
+for my $acc (@accs_to_multiply) {
+    has "multi_$acc" => (
+        is => 'ro',
+        isa => Str,
+        predicate => "has_multi_$acc",
+    );
+}
+
 around slots => sub {
     my ($orig, $self) = @_;
     return ($self->$orig(), $self->full_storage_slot);
@@ -58,17 +67,21 @@ after install_accessors => sub {
 
     my $class  = $self->associated_class;
 
-    for my $meth (qw(accessor reader writer predicate clearer)) {
+    for my $meth (@accs_to_multiply) {
+        my $type = "multi_$meth";
         my $check = "has_$meth";
-        next unless $self->$check;
+        my $multi_check = "has_$type";
+        next unless $self->$check || $self->$multi_check;
 
-        my $type = "multi_$meth";
-        my $basename = $self->$meth;
+        my $name = $self->$type;
+        if (!$name) {
+            my $basename = $self->$meth;
 
-        die 'MultiValued attribute trait is not compatible with subref accessors'
-            if ref($basename);
+            die 'MultiValued attribute trait is not compatible with subref accessors'
+                if ref($basename);
 
-        my $name = "${basename}_multi";
+            $name = "${basename}_multi";
+        }
 
         $class->add_method(
             $self->_process_accessors($type => $name,0)