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'} }
61 warn 'The initialize_body method has been made private.'
62 . " The public version is deprecated and will be removed in a future release.\n";
63 goto &_initialize_body;
66 sub _initialize_body {
69 my $method_name = join "_" => (
73 ($self->is_inline ? 'inline' : ())
76 eval { $self->{'body'} = $self->$method_name() };
82 sub generate_accessor_method {
83 my $attr = (shift)->associated_attribute;
85 $attr->set_value($_[0], $_[1]) if scalar(@_) == 2;
86 $attr->get_value($_[0]);
90 sub generate_reader_method {
91 my $attr = (shift)->associated_attribute;
93 confess "Cannot assign a value to a read-only accessor" if @_ > 1;
94 $attr->get_value($_[0]);
98 sub generate_writer_method {
99 my $attr = (shift)->associated_attribute;
101 $attr->set_value($_[0], $_[1]);
105 sub generate_predicate_method {
106 my $attr = (shift)->associated_attribute;
108 $attr->has_value($_[0])
112 sub generate_clearer_method {
113 my $attr = (shift)->associated_attribute;
115 $attr->clear_value($_[0])
122 sub generate_accessor_method_inline {
124 my $attr = $self->associated_attribute;
125 my $attr_name = $attr->name;
126 my $meta_instance = $attr->associated_class->instance_metaclass;
128 my $code = $self->_eval_closure(
131 . $meta_instance->inline_set_slot_value('$_[0]', $attr_name, '$_[1]')
132 . ' if scalar(@_) == 2; '
133 . $meta_instance->inline_get_slot_value('$_[0]', $attr_name)
136 confess "Could not generate inline accessor because : $@" if $@;
141 sub generate_reader_method_inline {
143 my $attr = $self->associated_attribute;
144 my $attr_name = $attr->name;
145 my $meta_instance = $attr->associated_class->instance_metaclass;
147 my $code = $self->_eval_closure(
150 . 'confess "Cannot assign a value to a read-only accessor" if @_ > 1;'
151 . $meta_instance->inline_get_slot_value('$_[0]', $attr_name)
154 confess "Could not generate inline reader because : $@" if $@;
159 sub generate_writer_method_inline {
161 my $attr = $self->associated_attribute;
162 my $attr_name = $attr->name;
163 my $meta_instance = $attr->associated_class->instance_metaclass;
165 my $code = $self->_eval_closure(
168 . $meta_instance->inline_set_slot_value('$_[0]', $attr_name, '$_[1]')
171 confess "Could not generate inline writer because : $@" if $@;
177 sub generate_predicate_method_inline {
179 my $attr = $self->associated_attribute;
180 my $attr_name = $attr->name;
181 my $meta_instance = $attr->associated_class->instance_metaclass;
183 my $code = $self->_eval_closure(
186 . $meta_instance->inline_is_slot_initialized('$_[0]', $attr_name)
189 confess "Could not generate inline predicate because : $@" if $@;
194 sub generate_clearer_method_inline {
196 my $attr = $self->associated_attribute;
197 my $attr_name = $attr->name;
198 my $meta_instance = $attr->associated_class->instance_metaclass;
200 my $code = $self->_eval_closure(
203 . $meta_instance->inline_deinitialize_slot('$_[0]', $attr_name)
206 confess "Could not generate inline clearer because : $@" if $@;
219 Class::MOP::Method::Accessor - Method Meta Object for accessors
223 use Class::MOP::Method::Accessor;
225 my $reader = Class::MOP::Method::Accessor->new(
226 attribute => $attribute,
228 accessor_type => 'reader',
231 $reader->body->execute($instance); # call the reader method
235 This is a subclass of <Class::MOP::Method> which is used by
236 C<Class::MOP::Attribute> to generate accessor code. It handles
237 generation of readers, writers, predicates and clearers. For each type
238 of method, it can either create a subroutine reference, or actually
239 inline code by generating a string and C<eval>'ing it.
245 =item B<< Class::MOP::Method::Accessor->new(%options) >>
247 This returns a new C<Class::MOP::Method::Accessor> based on the
248 C<%options> provided.
254 This is the C<Class::MOP::Attribute> for which accessors are being
255 generated. This option is required.
257 =item * accessor_type
259 This is a string which should be one of "reader", "writer",
260 "accessor", "predicate", or "clearer". This is the type of method
261 being generated. This option is required.
265 This indicates whether or not the accessor should be inlined. This
270 The method name (without a package name). This is required.
274 The package name for the method. This is required.
278 =item B<< $metamethod->accessor_type >>
280 Returns the accessor type which was passed to C<new>.
282 =item B<< $metamethod->is_inline >>
284 Returns a boolean indicating whether or not the accessor is inlined.
286 =item B<< $metamethod->associated_attribute >>
288 This returns the L<Class::MOP::Attribute> object which was passed to
291 =item B<< $metamethod->body >>
293 The method itself is I<generated> when the accessor object is
300 Stevan Little E<lt>stevan@iinteractive.comE<gt>
302 =head1 COPYRIGHT AND LICENSE
304 Copyright 2006-2009 by Infinity Interactive, Inc.
306 L<http://www.iinteractive.com>
308 This library is free software; you can redistribute it and/or modify
309 it under the same terms as Perl itself.