Whenever we inline a type constraint, we need to include its inline environment.
[gitmo/Moose.git] / 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         '$attr'                => \$attr,
43         '$meta'                => \$self,
44         '$type_constraint_obj' => \$type_constraint_obj,
45         '$type_constraint'     => \(
46               $type_constraint_obj
47             ? $type_constraint_obj->_compiled_type_constraint
48             : undef
49         ),
50         (
51             $type_constraint_obj
52             ? %{ $type_constraint_obj->inline_environment }
53             : ()
54         ),
55     };
56 }
57
58 sub _instance_is_inlinable {
59     my $self = shift;
60     return $self->associated_attribute->associated_class->instance_metaclass->is_inlinable;
61 }
62
63 sub _generate_reader_method {
64     my $self = shift;
65     $self->_instance_is_inlinable ? $self->_generate_reader_method_inline(@_)
66                                   : $self->SUPER::_generate_reader_method(@_);
67 }
68
69 sub _generate_writer_method {
70     my $self = shift;
71     $self->_instance_is_inlinable ? $self->_generate_writer_method_inline(@_)
72                                   : $self->SUPER::_generate_writer_method(@_);
73 }
74
75 sub _generate_accessor_method {
76     my $self = shift;
77     $self->_instance_is_inlinable ? $self->_generate_accessor_method_inline(@_)
78                                   : $self->SUPER::_generate_accessor_method(@_);
79 }
80
81 sub _generate_predicate_method {
82     my $self = shift;
83     $self->_instance_is_inlinable ? $self->_generate_predicate_method_inline(@_)
84                                   : $self->SUPER::_generate_predicate_method(@_);
85 }
86
87 sub _generate_clearer_method {
88     my $self = shift;
89     $self->_instance_is_inlinable ? $self->_generate_clearer_method_inline(@_)
90                                   : $self->SUPER::_generate_clearer_method(@_);
91 }
92
93 sub _writer_value_needs_copy {
94     shift->associated_attribute->_writer_value_needs_copy(@_);
95 }
96
97 sub _inline_tc_code {
98     shift->associated_attribute->_inline_tc_code(@_);
99 }
100
101 sub _inline_check_constraint {
102     shift->associated_attribute->_inline_check_constraint(@_);
103 }
104
105 sub _inline_check_lazy {
106     shift->associated_attribute->_inline_check_lazy(@_);
107 }
108
109 sub _inline_store_value {
110     shift->associated_attribute->_inline_instance_set(@_) . ';';
111 }
112
113 sub _inline_get_old_value_for_trigger {
114     shift->associated_attribute->_inline_get_old_value_for_trigger(@_);
115 }
116
117 sub _inline_trigger {
118     shift->associated_attribute->_inline_trigger(@_);
119 }
120
121 sub _get_value {
122     shift->associated_attribute->_inline_instance_get(@_);
123 }
124
125 sub _has_value {
126     shift->associated_attribute->_inline_instance_has(@_);
127 }
128
129 1;
130
131 # ABSTRACT: A Moose Method metaclass for accessors
132
133 __END__
134
135 =pod
136
137 =head1 DESCRIPTION
138
139 This class is a subclass of L<Class::MOP::Method::Accessor> that
140 provides additional Moose-specific functionality, all of which is
141 private.
142
143 To understand this class, you should read the the
144 L<Class::MOP::Method::Accessor> documentation.
145
146 =head1 BUGS
147
148 See L<Moose/BUGS> for details on reporting bugs.
149
150 =cut