lib/Moose/Meta/Method/Accessor.pm

   1
   2 package Moose::Meta::Method::Accessor;
   3
   4 use strict;
   5 use warnings;
   6
   7 use Try::Tiny;
   8
   9 use base 'Moose::Meta::Method',
  10          'Class::MOP::Method::Accessor';
  11
  12 # multiple inheritance is terrible
  13 sub new {
  14     goto &Class::MOP::Method::Accessor::new;
  15 }
  16
  17 sub _new {
  18     goto &Class::MOP::Method::Accessor::_new;
  19 }
  20
  21 sub _error_thrower {
  22     my $self = shift;
  23     return $self->associated_attribute
  24         if ref($self) && defined($self->associated_attribute);
  25     return $self->SUPER::_error_thrower;
  26 }
  27
  28 sub _compile_code {
  29     my $self = shift;
  30     my @args = @_;
  31     try {
  32         $self->SUPER::_compile_code(@args);
  33     }
  34     catch {
  35         $self->throw_error(
  36             'Could not create writer for '
  37           . "'" . $self->associated_attribute->name . "' "
  38           . 'because ' . $_,
  39             error => $_,
  40         );
  41     };
  42 }
  43
  44 sub _eval_environment {
  45     my $self = shift;
  46     return $self->associated_attribute->_eval_environment;
  47 }
  48
  49 sub _instance_is_inlinable {
  50     my $self = shift;
  51     return $self->associated_attribute->associated_class->instance_metaclass->is_inlinable;
  52 }
  53
  54 sub _generate_reader_method {
  55     my $self = shift;
  56     $self->_instance_is_inlinable ? $self->_generate_reader_method_inline(@_)
  57                                   : $self->SUPER::_generate_reader_method(@_);
  58 }
  59
  60 sub _generate_writer_method {
  61     my $self = shift;
  62     $self->_instance_is_inlinable ? $self->_generate_writer_method_inline(@_)
  63                                   : $self->SUPER::_generate_writer_method(@_);
  64 }
  65
  66 sub _generate_accessor_method {
  67     my $self = shift;
  68     $self->_instance_is_inlinable ? $self->_generate_accessor_method_inline(@_)
  69                                   : $self->SUPER::_generate_accessor_method(@_);
  70 }
  71
  72 sub _generate_predicate_method {
  73     my $self = shift;
  74     $self->_instance_is_inlinable ? $self->_generate_predicate_method_inline(@_)
  75                                   : $self->SUPER::_generate_predicate_method(@_);
  76 }
  77
  78 sub _generate_clearer_method {
  79     my $self = shift;
  80     $self->_instance_is_inlinable ? $self->_generate_clearer_method_inline(@_)
  81                                   : $self->SUPER::_generate_clearer_method(@_);
  82 }
  83
  84 sub _writer_value_needs_copy {
  85     shift->associated_attribute->_writer_value_needs_copy(@_);
  86 }
  87
  88 sub _inline_tc_code {
  89     shift->associated_attribute->_inline_tc_code(@_);
  90 }
  91
  92 sub _inline_check_coercion {
  93     shift->associated_attribute->_inline_check_coercion(@_);
  94 }
  95
  96 sub _inline_check_constraint {
  97     shift->associated_attribute->_inline_check_constraint(@_);
  98 }
  99
 100 sub _inline_check_lazy {
 101     shift->associated_attribute->_inline_check_lazy(@_);
 102 }
 103
 104 sub _inline_store_value {
 105     shift->associated_attribute->_inline_instance_set(@_) . ';';
 106 }
 107
 108 sub _inline_get_old_value_for_trigger {
 109     shift->associated_attribute->_inline_get_old_value_for_trigger(@_);
 110 }
 111
 112 sub _inline_trigger {
 113     shift->associated_attribute->_inline_trigger(@_);
 114 }
 115
 116 sub _get_value {
 117     shift->associated_attribute->_inline_instance_get(@_);
 118 }
 119
 120 sub _has_value {
 121     shift->associated_attribute->_inline_instance_has(@_);
 122 }
 123
 124 1;
 125
 126 # ABSTRACT: A Moose Method metaclass for accessors
 127
 128 __END__
 129
 130 =pod
 131
 132 =head1 DESCRIPTION
 133
 134 This class is a subclass of L<Class::MOP::Method::Accessor> that
 135 provides additional Moose-specific functionality, all of which is
 136 private.
 137
 138 To understand this class, you should read the the
 139 L<Class::MOP::Method::Accessor> documentation.
 140
 141 =head1 BUGS
 142
 143 See L<Moose/BUGS> for details on reporting bugs.
 144
 145 =cut