diff options
Diffstat (limited to 'lib/Data/MultiValued')
| -rw-r--r-- | lib/Data/MultiValued/AttributeTrait.pm | 29 |
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) |