2 package Class::MOP::Method::Accessor;
8 use Scalar::Util 'blessed', 'weaken';
11 use base 'Class::MOP::Method::Generated';
17 (exists $options{attribute})
18 || confess "You must supply an attribute to construct with";
20 (exists $options{accessor_type})
21 || confess "You must supply an accessor_type to construct with";
23 (blessed($options{attribute}) && $options{attribute}->isa('Class::MOP::Attribute'))
24 || confess "You must supply an attribute which is a 'Class::MOP::Attribute' instance";
26 ($options{package_name} && $options{name})
27 || confess "You must supply the package_name and name parameters $Class::MOP::Method::UPGRADE_ERROR_TEXT";
29 my $self = $class->_new(\%options);
31 # we don't want this creating
32 # a cycle in the code, if not
34 weaken($self->{'attribute'});
36 $self->_initialize_body;
44 return Class::MOP::Class->initialize($class)->new_object(@_)
45 if $class ne __PACKAGE__;
47 my $params = @_ == 1 ? $_[0] : {@_};
50 # inherited from Class::MOP::Method
51 body => $params->{body},
52 associated_metaclass => $params->{associated_metaclass},
53 package_name => $params->{package_name},
54 name => $params->{name},
55 original_method => $params->{original_method},
57 # inherit from Class::MOP::Generated
58 is_inline => $params->{is_inline} || 0,
59 definition_context => $params->{definition_context},
61 # defined in this class
62 attribute => $params->{attribute},
63 accessor_type => $params->{accessor_type},
69 sub associated_attribute { (shift)->{'attribute'} }
70 sub accessor_type { (shift)->{'accessor_type'} }
74 sub _initialize_body {
77 my $method_name = join "_" => (
83 $self->{'body'} = $self->$method_name();
89 return $self->associated_attribute
91 && $self->associated_attribute
92 && $self->associated_attribute->can('throw_error');
94 return $self->SUPER::_error_thrower;
101 $self->SUPER::_compile_code(@args);
105 'Could not create writer for '
106 . "'" . $self->associated_attribute->name . "' "
113 sub _eval_environment {
115 return $self->associated_attribute->_eval_environment
116 if $self->associated_attribute->can('_eval_environment');
119 sub _instance_is_inlinable {
121 return $self->associated_attribute->associated_class->instance_metaclass->is_inlinable;
124 sub _generate_reader_method {
126 $self->_instance_is_inlinable ? $self->_generate_reader_method_inline(@_)
127 : $self->_generate_reader_method_non_inline(@_);
130 sub _generate_writer_method {
132 $self->_instance_is_inlinable ? $self->_generate_writer_method_inline(@_)
133 : $self->_generate_writer_method_non_inline(@_);
136 sub _generate_accessor_method {
138 $self->_instance_is_inlinable ? $self->_generate_accessor_method_inline(@_)
139 : $self->_generate_accessor_method_non_inline(@_);
142 sub _generate_predicate_method {
144 $self->_instance_is_inlinable ? $self->_generate_predicate_method_inline(@_)
145 : $self->_generate_predicate_method_non_inline(@_);
148 sub _generate_clearer_method {
150 $self->_instance_is_inlinable ? $self->_generate_clearer_method_inline(@_)
151 : $self->_generate_clearer_method_non_inline(@_);
154 sub _generate_accessor_method_non_inline {
156 my $attr = $self->associated_attribute;
160 $attr->set_value($_[0], $_[1]);
162 $attr->get_value($_[0]);
166 sub _generate_accessor_method_inline {
168 my $attr = $self->associated_attribute;
171 $self->_compile_code([
174 $attr->_inline_set_value('$_[0]', '$_[1]'),
176 $attr->_inline_get_value('$_[0]'),
181 confess "Could not generate inline accessor because : $_";
185 sub _generate_reader_method_non_inline {
187 my $attr = $self->associated_attribute;
190 confess "Cannot assign a value to a read-only accessor"
192 $attr->get_value($_[0]);
196 sub _generate_reader_method_inline {
198 my $attr = $self->associated_attribute;
201 $self->_compile_code([
204 # XXX: this is a hack, but our error stuff is terrible
205 $self->_inline_throw_error(
206 '"Cannot assign a value to a read-only accessor"',
210 $attr->_inline_get_value('$_[0]'),
215 confess "Could not generate inline reader because : $_";
219 sub _generate_writer_method_non_inline {
221 my $attr = $self->associated_attribute;
224 $attr->set_value($_[0], $_[1]);
228 sub _generate_writer_method_inline {
230 my $attr = $self->associated_attribute;
233 $self->_compile_code([
235 $attr->_inline_set_value('$_[0]', '$_[1]'),
240 confess "Could not generate inline writer because : $_";
244 sub _generate_predicate_method_non_inline {
246 my $attr = $self->associated_attribute;
249 $attr->has_value($_[0])
253 sub _generate_predicate_method_inline {
255 my $attr = $self->associated_attribute;
258 $self->_compile_code([
260 $attr->_inline_has_value('$_[0]'),
265 confess "Could not generate inline predicate because : $_";
269 sub _generate_clearer_method_non_inline {
271 my $attr = $self->associated_attribute;
274 $attr->clear_value($_[0])
278 sub _generate_clearer_method_inline {
280 my $attr = $self->associated_attribute;
283 $self->_compile_code([
285 $attr->_inline_clear_value('$_[0]'),
290 confess "Could not generate inline clearer because : $_";
294 sub _writer_value_needs_copy {
295 shift->associated_attribute->_writer_value_needs_copy(@_);
298 sub _inline_tc_code {
299 shift->associated_attribute->_inline_tc_code(@_);
302 sub _inline_check_coercion {
303 shift->associated_attribute->_inline_check_coercion(@_);
306 sub _inline_check_constraint {
307 shift->associated_attribute->_inline_check_constraint(@_);
310 sub _inline_check_lazy {
311 shift->associated_attribute->_inline_check_lazy(@_);
314 sub _inline_store_value {
315 shift->associated_attribute->_inline_instance_set(@_) . ';';
318 sub _inline_get_old_value_for_trigger {
319 shift->associated_attribute->_inline_get_old_value_for_trigger(@_);
322 sub _inline_trigger {
323 shift->associated_attribute->_inline_trigger(@_);
327 shift->associated_attribute->_inline_instance_get(@_);
331 shift->associated_attribute->_inline_instance_has(@_);
336 # ABSTRACT: Method Meta Object for accessors
344 use Class::MOP::Method::Accessor;
346 my $reader = Class::MOP::Method::Accessor->new(
347 attribute => $attribute,
349 accessor_type => 'reader',
352 $reader->body->execute($instance); # call the reader method
356 This is a subclass of C<Class::MOP::Method> which is used by
357 C<Class::MOP::Attribute> to generate accessor code. It handles
358 generation of readers, writers, predicates and clearers. For each type
359 of method, it can either create a subroutine reference, or actually
360 inline code by generating a string and C<eval>'ing it.
366 =item B<< Class::MOP::Method::Accessor->new(%options) >>
368 This returns a new C<Class::MOP::Method::Accessor> based on the
369 C<%options> provided.
375 This is the C<Class::MOP::Attribute> for which accessors are being
376 generated. This option is required.
378 =item * accessor_type
380 This is a string which should be one of "reader", "writer",
381 "accessor", "predicate", or "clearer". This is the type of method
382 being generated. This option is required.
386 This indicates whether or not the accessor should be inlined. This
391 The method name (without a package name). This is required.
395 The package name for the method. This is required.
399 =item B<< $metamethod->accessor_type >>
401 Returns the accessor type which was passed to C<new>.
403 =item B<< $metamethod->is_inline >>
405 Returns a boolean indicating whether or not the accessor is inlined.
407 =item B<< $metamethod->associated_attribute >>
409 This returns the L<Class::MOP::Attribute> object which was passed to
412 =item B<< $metamethod->body >>
414 The method itself is I<generated> when the accessor object is