2 package Class::MOP::Method::Accessor;
8 use Scalar::Util 'blessed', 'weaken';
10 our $VERSION = '0.78';
11 $VERSION = eval $VERSION;
12 our $AUTHORITY = 'cpan:STEVAN';
14 use base 'Class::MOP::Method::Generated';
20 (exists $options{attribute})
21 || confess "You must supply an attribute to construct with";
23 (exists $options{accessor_type})
24 || confess "You must supply an accessor_type to construct with";
26 (blessed($options{attribute}) && $options{attribute}->isa('Class::MOP::Attribute'))
27 || confess "You must supply an attribute which is a 'Class::MOP::Attribute' instance";
29 ($options{package_name} && $options{name})
30 || confess "You must supply the package_name and name parameters $Class::MOP::Method::UPGRADE_ERROR_TEXT";
32 my $self = $class->_new(\%options);
34 # we don't want this creating
35 # a cycle in the code, if not
37 weaken($self->{'attribute'});
39 $self->initialize_body;
46 my $options = @_ == 1 ? $_[0] : {@_};
48 $options->{is_inline} ||= 0;
50 return bless $options, $class;
55 sub associated_attribute { (shift)->{'attribute'} }
56 sub accessor_type { (shift)->{'accessor_type'} }
63 my $method_name = join "_" => (
67 ($self->is_inline ? 'inline' : ())
70 eval { $self->{'body'} = $self->$method_name() };
76 sub generate_accessor_method {
77 my $attr = (shift)->associated_attribute;
79 $attr->set_value($_[0], $_[1]) if scalar(@_) == 2;
80 $attr->get_value($_[0]);
84 sub generate_reader_method {
85 my $attr = (shift)->associated_attribute;
87 confess "Cannot assign a value to a read-only accessor" if @_ > 1;
88 $attr->get_value($_[0]);
92 sub generate_writer_method {
93 my $attr = (shift)->associated_attribute;
95 $attr->set_value($_[0], $_[1]);
99 sub generate_predicate_method {
100 my $attr = (shift)->associated_attribute;
102 $attr->has_value($_[0])
106 sub generate_clearer_method {
107 my $attr = (shift)->associated_attribute;
109 $attr->clear_value($_[0])
116 sub generate_accessor_method_inline {
118 my $attr = $self->associated_attribute;
119 my $attr_name = $attr->name;
120 my $meta_instance = $attr->associated_class->instance_metaclass;
122 my $code = $self->_eval_closure(
125 . $meta_instance->inline_set_slot_value('$_[0]', $attr_name, '$_[1]')
126 . ' if scalar(@_) == 2; '
127 . $meta_instance->inline_get_slot_value('$_[0]', $attr_name)
130 confess "Could not generate inline accessor because : $@" if $@;
135 sub generate_reader_method_inline {
137 my $attr = $self->associated_attribute;
138 my $attr_name = $attr->name;
139 my $meta_instance = $attr->associated_class->instance_metaclass;
141 my $code = $self->_eval_closure(
144 . 'confess "Cannot assign a value to a read-only accessor" if @_ > 1;'
145 . $meta_instance->inline_get_slot_value('$_[0]', $attr_name)
148 confess "Could not generate inline reader because : $@" if $@;
153 sub generate_writer_method_inline {
155 my $attr = $self->associated_attribute;
156 my $attr_name = $attr->name;
157 my $meta_instance = $attr->associated_class->instance_metaclass;
159 my $code = $self->_eval_closure(
162 . $meta_instance->inline_set_slot_value('$_[0]', $attr_name, '$_[1]')
165 confess "Could not generate inline writer because : $@" if $@;
171 sub generate_predicate_method_inline {
173 my $attr = $self->associated_attribute;
174 my $attr_name = $attr->name;
175 my $meta_instance = $attr->associated_class->instance_metaclass;
177 my $code = $self->_eval_closure(
180 . $meta_instance->inline_is_slot_initialized('$_[0]', $attr_name)
183 confess "Could not generate inline predicate because : $@" if $@;
188 sub generate_clearer_method_inline {
190 my $attr = $self->associated_attribute;
191 my $attr_name = $attr->name;
192 my $meta_instance = $attr->associated_class->instance_metaclass;
194 my $code = $self->_eval_closure(
197 . $meta_instance->inline_deinitialize_slot('$_[0]', $attr_name)
200 confess "Could not generate inline clearer because : $@" if $@;
213 Class::MOP::Method::Accessor - Method Meta Object for accessors
217 use Class::MOP::Method::Accessor;
219 my $reader = Class::MOP::Method::Accessor->new(
220 attribute => $attribute,
222 accessor_type => 'reader',
225 $reader->body->execute($instance); # call the reader method
229 This is a subclass of <Class::MOP::Method> which is used by
230 C<Class::MOP::Attribute> to generate accessor code. It handles
231 generation of readers, writers, predicates and clearers. For each type
232 of method, it can either create a subroutine reference, or actually
233 inline code by generating a string and C<eval>'ing it.
239 =item B<< Class::MOP::Method::Accessor->new(%options) >>
241 This returns a new C<Class::MOP::Method::Accessor> based on the
242 C<%options> provided.
248 This is the C<Class::MOP::Attribute> for which accessors are being
249 generated. This option is required.
251 =item * accessor_type
253 This is a string which should be one of "reader", "writer",
254 "accessor", "predicate", or "clearer". This is the type of method
255 being generated. This option is required.
259 This indicates whether or not the accessor should be inlined. This
264 The method name (without a package name). This is required.
268 The package name for the method. This is required.
272 =item B<< $metamethod->accessor_type >>
274 Returns the accessor type which was passed to C<new>.
276 =item B<< $metamethod->is_inline >>
278 Returns a boolean indicating whether or not the accessor is inlined.
280 =item B<< $metamethod->associated_attribute >>
282 This returns the L<Class::MOP::Attribute> object which was passed to
285 =item B<< $metamethod->body >>
287 The method itself is I<generated> when the accessor object is
294 Stevan Little E<lt>stevan@iinteractive.comE<gt>
296 =head1 COPYRIGHT AND LICENSE
298 Copyright 2006-2009 by Infinity Interactive, Inc.
300 L<http://www.iinteractive.com>
302 This library is free software; you can redistribute it and/or modify
303 it under the same terms as Perl itself.