2 package Class::MOP::Method::Accessor;
8 use Scalar::Util 'blessed', 'weaken';
10 our $VERSION = '0.82_01';
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 Carp::cluck('The initialize_body method has been made private.'
62 . " The public version is deprecated and will be removed in a future release.\n");
63 shift->_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 Carp::cluck('The generate_accessor_method method has been made private.'
84 . " The public version is deprecated and will be removed in a future release.\n");
85 shift->_generate_accessor_method;
88 sub _generate_accessor_method {
89 my $attr = (shift)->associated_attribute;
91 $attr->set_value($_[0], $_[1]) if scalar(@_) == 2;
92 $attr->get_value($_[0]);
96 sub generate_reader_method {
97 Carp::cluck('The generate_reader_method method has been made private.'
98 . " The public version is deprecated and will be removed in a future release.\n");
99 shift->_generate_reader_method;
102 sub _generate_reader_method {
103 my $attr = (shift)->associated_attribute;
105 confess "Cannot assign a value to a read-only accessor" if @_ > 1;
106 $attr->get_value($_[0]);
110 sub generate_writer_method {
111 Carp::cluck('The generate_writer_method method has been made private.'
112 . " The public version is deprecated and will be removed in a future release.\n");
113 shift->_generate_writer_method;
116 sub _generate_writer_method {
117 my $attr = (shift)->associated_attribute;
119 $attr->set_value($_[0], $_[1]);
123 sub generate_predicate_method {
124 Carp::cluck('The generate_predicate_method method has been made private.'
125 . " The public version is deprecated and will be removed in a future release.\n");
126 shift->_generate_predicate_method;
129 sub _generate_predicate_method {
130 my $attr = (shift)->associated_attribute;
132 $attr->has_value($_[0])
136 sub generate_clearer_method {
137 Carp::cluck('The generate_clearer_method method has been made private.'
138 . " The public version is deprecated and will be removed in a future release.\n");
139 shift->_generate_clearer_method;
142 sub _generate_clearer_method {
143 my $attr = (shift)->associated_attribute;
145 $attr->clear_value($_[0])
151 sub generate_accessor_method_inline {
152 Carp::cluck('The generate_accessor_method_inline method has been made private.'
153 . " The public version is deprecated and will be removed in a future release.\n");
154 shift->_generate_accessor_method_inline;
157 sub _generate_accessor_method_inline {
159 my $attr = $self->associated_attribute;
160 my $attr_name = $attr->name;
161 my $meta_instance = $attr->associated_class->instance_metaclass;
163 my $code = $self->_eval_closure(
166 . $meta_instance->inline_set_slot_value('$_[0]', $attr_name, '$_[1]')
167 . ' if scalar(@_) == 2; '
168 . $meta_instance->inline_get_slot_value('$_[0]', $attr_name)
171 confess "Could not generate inline accessor because : $@" if $@;
176 sub generate_reader_method_inline {
177 Carp::cluck('The generate_reader_method_inline method has been made private.'
178 . " The public version is deprecated and will be removed in a future release.\n");
179 shift->_generate_reader_method_inline;
182 sub _generate_reader_method_inline {
184 my $attr = $self->associated_attribute;
185 my $attr_name = $attr->name;
186 my $meta_instance = $attr->associated_class->instance_metaclass;
188 my $code = $self->_eval_closure(
191 . 'confess "Cannot assign a value to a read-only accessor" if @_ > 1;'
192 . $meta_instance->inline_get_slot_value('$_[0]', $attr_name)
195 confess "Could not generate inline reader because : $@" if $@;
200 sub generate_writer_method_inline {
201 Carp::cluck('The generate_writer_method_inline method has been made private.'
202 . " The public version is deprecated and will be removed in a future release.\n");
203 shift->_generate_writer_method_inline;
206 sub _generate_writer_method_inline {
208 my $attr = $self->associated_attribute;
209 my $attr_name = $attr->name;
210 my $meta_instance = $attr->associated_class->instance_metaclass;
212 my $code = $self->_eval_closure(
215 . $meta_instance->inline_set_slot_value('$_[0]', $attr_name, '$_[1]')
218 confess "Could not generate inline writer because : $@" if $@;
223 sub generate_predicate_method_inline {
224 Carp::cluck('The generate_predicate_method_inline method has been made private.'
225 . " The public version is deprecated and will be removed in a future release.\n");
226 shift->_generate_predicate_method_inline;
229 sub _generate_predicate_method_inline {
231 my $attr = $self->associated_attribute;
232 my $attr_name = $attr->name;
233 my $meta_instance = $attr->associated_class->instance_metaclass;
235 my $code = $self->_eval_closure(
238 . $meta_instance->inline_is_slot_initialized('$_[0]', $attr_name)
241 confess "Could not generate inline predicate because : $@" if $@;
246 sub generate_clearer_method_inline {
247 Carp::cluck('The generate_clearer_method_inline method has been made private.'
248 . " The public version is deprecated and will be removed in a future release.\n");
249 shift->_generate_clearer_method_inline;
252 sub _generate_clearer_method_inline {
254 my $attr = $self->associated_attribute;
255 my $attr_name = $attr->name;
256 my $meta_instance = $attr->associated_class->instance_metaclass;
258 my $code = $self->_eval_closure(
261 . $meta_instance->inline_deinitialize_slot('$_[0]', $attr_name)
264 confess "Could not generate inline clearer because : $@" if $@;
277 Class::MOP::Method::Accessor - Method Meta Object for accessors
281 use Class::MOP::Method::Accessor;
283 my $reader = Class::MOP::Method::Accessor->new(
284 attribute => $attribute,
286 accessor_type => 'reader',
289 $reader->body->execute($instance); # call the reader method
293 This is a subclass of <Class::MOP::Method> which is used by
294 C<Class::MOP::Attribute> to generate accessor code. It handles
295 generation of readers, writers, predicates and clearers. For each type
296 of method, it can either create a subroutine reference, or actually
297 inline code by generating a string and C<eval>'ing it.
303 =item B<< Class::MOP::Method::Accessor->new(%options) >>
305 This returns a new C<Class::MOP::Method::Accessor> based on the
306 C<%options> provided.
312 This is the C<Class::MOP::Attribute> for which accessors are being
313 generated. This option is required.
315 =item * accessor_type
317 This is a string which should be one of "reader", "writer",
318 "accessor", "predicate", or "clearer". This is the type of method
319 being generated. This option is required.
323 This indicates whether or not the accessor should be inlined. This
328 The method name (without a package name). This is required.
332 The package name for the method. This is required.
336 =item B<< $metamethod->accessor_type >>
338 Returns the accessor type which was passed to C<new>.
340 =item B<< $metamethod->is_inline >>
342 Returns a boolean indicating whether or not the accessor is inlined.
344 =item B<< $metamethod->associated_attribute >>
346 This returns the L<Class::MOP::Attribute> object which was passed to
349 =item B<< $metamethod->body >>
351 The method itself is I<generated> when the accessor object is
358 Stevan Little E<lt>stevan@iinteractive.comE<gt>
360 =head1 COPYRIGHT AND LICENSE
362 Copyright 2006-2009 by Infinity Interactive, Inc.
364 L<http://www.iinteractive.com>
366 This library is free software; you can redistribute it and/or modify
367 it under the same terms as Perl itself.