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