2 package Class::MOP::Method::Accessor;
8 use Scalar::Util 'blessed', 'weaken';
10 our $VERSION = '0.86';
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 $self->{'body'} = $self->$method_name();
81 sub generate_accessor_method {
82 Carp::cluck('The generate_accessor_method method has been made private.'
83 . " The public version is deprecated and will be removed in a future release.\n");
84 shift->_generate_accessor_method;
87 sub _generate_accessor_method {
88 my $attr = (shift)->associated_attribute;
90 $attr->set_value($_[0], $_[1]) if scalar(@_) == 2;
91 $attr->get_value($_[0]);
95 sub generate_reader_method {
96 Carp::cluck('The generate_reader_method method has been made private.'
97 . " The public version is deprecated and will be removed in a future release.\n");
98 shift->_generate_reader_method;
101 sub _generate_reader_method {
102 my $attr = (shift)->associated_attribute;
104 confess "Cannot assign a value to a read-only accessor" if @_ > 1;
105 $attr->get_value($_[0]);
109 sub generate_writer_method {
110 Carp::cluck('The generate_writer_method method has been made private.'
111 . " The public version is deprecated and will be removed in a future release.\n");
112 shift->_generate_writer_method;
115 sub _generate_writer_method {
116 my $attr = (shift)->associated_attribute;
118 $attr->set_value($_[0], $_[1]);
122 sub generate_predicate_method {
123 Carp::cluck('The generate_predicate_method method has been made private.'
124 . " The public version is deprecated and will be removed in a future release.\n");
125 shift->_generate_predicate_method;
128 sub _generate_predicate_method {
129 my $attr = (shift)->associated_attribute;
131 $attr->has_value($_[0])
135 sub generate_clearer_method {
136 Carp::cluck('The generate_clearer_method method has been made private.'
137 . " The public version is deprecated and will be removed in a future release.\n");
138 shift->_generate_clearer_method;
141 sub _generate_clearer_method {
142 my $attr = (shift)->associated_attribute;
144 $attr->clear_value($_[0])
150 sub generate_accessor_method_inline {
151 Carp::cluck('The generate_accessor_method_inline method has been made private.'
152 . " The public version is deprecated and will be removed in a future release.\n");
153 shift->_generate_accessor_method_inline;
156 sub _generate_accessor_method_inline {
158 my $attr = $self->associated_attribute;
159 my $attr_name = $attr->name;
160 my $meta_instance = $attr->associated_class->instance_metaclass;
162 my $code = $self->_eval_closure(
165 . $meta_instance->inline_set_slot_value('$_[0]', $attr_name, '$_[1]')
166 . ' if scalar(@_) == 2; '
167 . $meta_instance->inline_get_slot_value('$_[0]', $attr_name)
170 confess "Could not generate inline accessor because : $@" if $@;
175 sub generate_reader_method_inline {
176 Carp::cluck('The generate_reader_method_inline method has been made private.'
177 . " The public version is deprecated and will be removed in a future release.\n");
178 shift->_generate_reader_method_inline;
181 sub _generate_reader_method_inline {
183 my $attr = $self->associated_attribute;
184 my $attr_name = $attr->name;
185 my $meta_instance = $attr->associated_class->instance_metaclass;
187 my $code = $self->_eval_closure(
190 . 'confess "Cannot assign a value to a read-only accessor" if @_ > 1;'
191 . $meta_instance->inline_get_slot_value('$_[0]', $attr_name)
194 confess "Could not generate inline reader because : $@" if $@;
199 sub generate_writer_method_inline {
200 Carp::cluck('The generate_writer_method_inline method has been made private.'
201 . " The public version is deprecated and will be removed in a future release.\n");
202 shift->_generate_writer_method_inline;
205 sub _generate_writer_method_inline {
207 my $attr = $self->associated_attribute;
208 my $attr_name = $attr->name;
209 my $meta_instance = $attr->associated_class->instance_metaclass;
211 my $code = $self->_eval_closure(
214 . $meta_instance->inline_set_slot_value('$_[0]', $attr_name, '$_[1]')
217 confess "Could not generate inline writer because : $@" if $@;
222 sub generate_predicate_method_inline {
223 Carp::cluck('The generate_predicate_method_inline method has been made private.'
224 . " The public version is deprecated and will be removed in a future release.\n");
225 shift->_generate_predicate_method_inline;
228 sub _generate_predicate_method_inline {
230 my $attr = $self->associated_attribute;
231 my $attr_name = $attr->name;
232 my $meta_instance = $attr->associated_class->instance_metaclass;
234 my $code = $self->_eval_closure(
237 . $meta_instance->inline_is_slot_initialized('$_[0]', $attr_name)
240 confess "Could not generate inline predicate because : $@" if $@;
245 sub generate_clearer_method_inline {
246 Carp::cluck('The generate_clearer_method_inline method has been made private.'
247 . " The public version is deprecated and will be removed in a future release.\n");
248 shift->_generate_clearer_method_inline;
251 sub _generate_clearer_method_inline {
253 my $attr = $self->associated_attribute;
254 my $attr_name = $attr->name;
255 my $meta_instance = $attr->associated_class->instance_metaclass;
257 my $code = $self->_eval_closure(
260 . $meta_instance->inline_deinitialize_slot('$_[0]', $attr_name)
263 confess "Could not generate inline clearer because : $@" if $@;
276 Class::MOP::Method::Accessor - Method Meta Object for accessors
280 use Class::MOP::Method::Accessor;
282 my $reader = Class::MOP::Method::Accessor->new(
283 attribute => $attribute,
285 accessor_type => 'reader',
288 $reader->body->execute($instance); # call the reader method
292 This is a subclass of <Class::MOP::Method> which is used by
293 C<Class::MOP::Attribute> to generate accessor code. It handles
294 generation of readers, writers, predicates and clearers. For each type
295 of method, it can either create a subroutine reference, or actually
296 inline code by generating a string and C<eval>'ing it.
302 =item B<< Class::MOP::Method::Accessor->new(%options) >>
304 This returns a new C<Class::MOP::Method::Accessor> based on the
305 C<%options> provided.
311 This is the C<Class::MOP::Attribute> for which accessors are being
312 generated. This option is required.
314 =item * accessor_type
316 This is a string which should be one of "reader", "writer",
317 "accessor", "predicate", or "clearer". This is the type of method
318 being generated. This option is required.
322 This indicates whether or not the accessor should be inlined. This
327 The method name (without a package name). This is required.
331 The package name for the method. This is required.
335 =item B<< $metamethod->accessor_type >>
337 Returns the accessor type which was passed to C<new>.
339 =item B<< $metamethod->is_inline >>
341 Returns a boolean indicating whether or not the accessor is inlined.
343 =item B<< $metamethod->associated_attribute >>
345 This returns the L<Class::MOP::Attribute> object which was passed to
348 =item B<< $metamethod->body >>
350 The method itself is I<generated> when the accessor object is
357 Stevan Little E<lt>stevan@iinteractive.comE<gt>
359 =head1 COPYRIGHT AND LICENSE
361 Copyright 2006-2009 by Infinity Interactive, Inc.
363 L<http://www.iinteractive.com>
365 This library is free software; you can redistribute it and/or modify
366 it under the same terms as Perl itself.