diff options
Diffstat (limited to 'lib/Data/MultiValued/AttributeTrait.pm')
| -rw-r--r-- | lib/Data/MultiValued/AttributeTrait.pm | 229 |
1 files changed, 229 insertions, 0 deletions
diff --git a/lib/Data/MultiValued/AttributeTrait.pm b/lib/Data/MultiValued/AttributeTrait.pm new file mode 100644 index 0000000..91e1b13 --- /dev/null +++ b/lib/Data/MultiValued/AttributeTrait.pm @@ -0,0 +1,229 @@ +package Data::MultiValued::AttributeTrait; +use Moose::Role; +use Data::MultiValued::AttributeAccessors; +use MooseX::Types::Moose qw(Str); +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__' } + +requires 'multivalue_storage_class'; +requires 'opts_to_pass_set'; +requires 'opts_to_pass_get'; + +around slots => sub { + my ($orig, $self) = @_; + return ($self->$orig(), $self->full_storage_slot); +}; + +sub set_full_storage { + my ($self,$instance) = @_; + + my $ret = $self->multivalue_storage_class->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 = "multi_$meth"; + my $basename = $self->$meth; + + die 'MultiValued attribute trait is not compatible with subref accessors' + if ref($basename); + + my $name = "${basename}_multi"; + + $class->add_method( + $self->_process_accessors($type => $name,0) + ); + } +}; + +sub _filter_opts { + my ($hr,@fields) = @_; + + my %ret; + for my $f (@fields) { + if (exists $hr->{$f}) { + $ret{$f}=$hr->{$f}; + } + } + return \%ret; +} + +sub load_multi_value { + my ($self,$instance,$opts) = @_; + + my $opts_passed = _filter_opts($opts, $self->opts_to_pass_get); + + my $value;my $found=1; + try { + $value = $self->full_storage($instance)->get($opts_passed); + } + 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_multi_value { + my ($self,$instance,$opts) = @_; + + my $opts_passed = _filter_opts($opts, $self->opts_to_pass_set); + + $opts_passed->{value} = $self->get_raw_value($instance); + + $self->full_storage($instance)->set($opts_passed); +} + +our $dyn_opts = {}; + +before get_value => sub { + my ($self,$instance) = @_; + + $self->load_multi_value($instance,$dyn_opts); +}; + +sub get_multi_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_multi_value($instance,$dyn_opts); +}; + +after set_value => sub { + my ($self,$instance,$value) = @_; + + $self->store_multi_value($instance,$dyn_opts); +}; + +sub set_multi_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_multi_value($instance,$dyn_opts); +}; + +sub has_multi_value { + my ($self,$instance,$opts) = @_; + + local $dyn_opts = $opts; + + return $self->has_value($instance); +} + +after clear_value => sub { + my ($self,$instance) = @_; + + $self->full_storage($instance)->clear($dyn_opts); + return; +}; + +sub clear_multi_value { + my ($self,$instance,$opts) = @_; + + local $dyn_opts = $opts; + + return $self->clear_value($instance); +} + +sub get_multi_read_method { + my $self = shift; + return $self->get_read_method . '_multi'; +} + +sub get_multi_write_method { + my $self = shift; + return $self->get_write_method . '_multi'; +} + +sub _rebless_slot { + my ($self,$instance) = @_; + + my $st = $self->get_full_storage($instance); + return unless $st; + + bless $st, $self->multivalue_storage_class; + $st->_rebless_storage; +} + +sub _as_hash { + my ($self,$instance) = @_; + + my $st = $self->get_full_storage($instance); + return unless $st; + + return $st->_as_hash; +} + +1; |