diff options
author | Gianni Ceccarelli <dakkar@thenautilus.net> | 2011-11-10 15:10:26 +0000 |
---|---|---|
committer | Gianni Ceccarelli <dakkar@thenautilus.net> | 2011-11-10 15:10:26 +0000 |
commit | dc07be4ac45756a0e664ee29e888f86b7609784a (patch) | |
tree | dca7e4467f73625604886e8910a609ccc978b0ce /Data-MultiValued/lib/Data/MultiValued/AttributeTrait.pm | |
parent | 'clear' almost completely implemneted (diff) | |
download | data-multivalued-dc07be4ac45756a0e664ee29e888f86b7609784a.tar.gz data-multivalued-dc07be4ac45756a0e664ee29e888f86b7609784a.tar.bz2 data-multivalued-dc07be4ac45756a0e664ee29e888f86b7609784a.zip |
move up a level
Diffstat (limited to 'Data-MultiValued/lib/Data/MultiValued/AttributeTrait.pm')
-rw-r--r-- | Data-MultiValued/lib/Data/MultiValued/AttributeTrait.pm | 229 |
1 files changed, 0 insertions, 229 deletions
diff --git a/Data-MultiValued/lib/Data/MultiValued/AttributeTrait.pm b/Data-MultiValued/lib/Data/MultiValued/AttributeTrait.pm deleted file mode 100644 index 91e1b13..0000000 --- a/Data-MultiValued/lib/Data/MultiValued/AttributeTrait.pm +++ /dev/null @@ -1,229 +0,0 @@ -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; |