2 package Class::MOP::Method::Accessor;
8 use Scalar::Util 'blessed', 'weaken';
10 our $VERSION = '0.89';
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;
47 return Class::MOP::Class->initialize($class)->new_object(@_)
48 if $class ne __PACKAGE__;
50 my $params = @_ == 1 ? $_[0] : {@_};
53 # inherited from Class::MOP::Method
54 body => $params->{body},
55 associated_metaclass => $params->{associated_metaclass},
56 package_name => $params->{package_name},
57 name => $params->{name},
58 original_method => $params->{original_method},
60 # inherit from Class::MOP::Generated
61 is_inline => $params->{is_inline} || 0,
62 definition_context => $params->{definition_context},
64 # defined in this class
65 attribute => $params->{attribute},
66 accessor_type => $params->{accessor_type},
72 sub associated_attribute { (shift)->{'attribute'} }
73 sub accessor_type { (shift)->{'accessor_type'} }
78 Carp::cluck('The initialize_body method has been made private.'
79 . " The public version is deprecated and will be removed in a future release.\n");
80 shift->_initialize_body;
83 sub _initialize_body {
86 my $method_name = join "_" => (
90 ($self->is_inline ? 'inline' : ())
93 $self->{'body'} = $self->$method_name();
98 sub generate_accessor_method {
99 Carp::cluck('The generate_accessor_method method has been made private.'
100 . " The public version is deprecated and will be removed in a future release.\n");
101 shift->_generate_accessor_method;
104 sub _generate_accessor_method {
105 my $attr = (shift)->associated_attribute;
107 $attr->set_value($_[0], $_[1]) if scalar(@_) == 2;
108 $attr->get_value($_[0]);
112 sub generate_reader_method {
113 Carp::cluck('The generate_reader_method method has been made private.'
114 . " The public version is deprecated and will be removed in a future release.\n");
115 shift->_generate_reader_method;
118 sub _generate_reader_method {
119 my $attr = (shift)->associated_attribute;
121 confess "Cannot assign a value to a read-only accessor" if @_ > 1;
122 $attr->get_value($_[0]);
126 sub generate_writer_method {
127 Carp::cluck('The generate_writer_method method has been made private.'
128 . " The public version is deprecated and will be removed in a future release.\n");
129 shift->_generate_writer_method;
132 sub _generate_writer_method {
133 my $attr = (shift)->associated_attribute;
135 $attr->set_value($_[0], $_[1]);
139 sub generate_predicate_method {
140 Carp::cluck('The generate_predicate_method method has been made private.'
141 . " The public version is deprecated and will be removed in a future release.\n");
142 shift->_generate_predicate_method;
145 sub _generate_predicate_method {
146 my $attr = (shift)->associated_attribute;
148 $attr->has_value($_[0])
152 sub generate_clearer_method {
153 Carp::cluck('The generate_clearer_method method has been made private.'
154 . " The public version is deprecated and will be removed in a future release.\n");
155 shift->_generate_clearer_method;
158 sub _generate_clearer_method {
159 my $attr = (shift)->associated_attribute;
161 $attr->clear_value($_[0])
167 sub generate_accessor_method_inline {
168 Carp::cluck('The generate_accessor_method_inline method has been made private.'
169 . " The public version is deprecated and will be removed in a future release.\n");
170 shift->_generate_accessor_method_inline;
173 sub _generate_accessor_method_inline {
175 my $attr = $self->associated_attribute;
176 my $attr_name = $attr->name;
177 my $meta_instance = $attr->associated_class->instance_metaclass;
179 my ( $code, $e ) = $self->_eval_closure(
182 . $meta_instance->inline_set_slot_value('$_[0]', $attr_name, '$_[1]')
183 . ' if scalar(@_) == 2; '
184 . $meta_instance->inline_get_slot_value('$_[0]', $attr_name)
187 confess "Could not generate inline accessor because : $e" if $e;
192 sub generate_reader_method_inline {
193 Carp::cluck('The generate_reader_method_inline method has been made private.'
194 . " The public version is deprecated and will be removed in a future release.\n");
195 shift->_generate_reader_method_inline;
198 sub _generate_reader_method_inline {
200 my $attr = $self->associated_attribute;
201 my $attr_name = $attr->name;
202 my $meta_instance = $attr->associated_class->instance_metaclass;
204 my ( $code, $e ) = $self->_eval_closure(
207 . 'confess "Cannot assign a value to a read-only accessor" if @_ > 1;'
208 . $meta_instance->inline_get_slot_value('$_[0]', $attr_name)
211 confess "Could not generate inline reader because : $e" if $e;
216 sub generate_writer_method_inline {
217 Carp::cluck('The generate_writer_method_inline method has been made private.'
218 . " The public version is deprecated and will be removed in a future release.\n");
219 shift->_generate_writer_method_inline;
222 sub _generate_writer_method_inline {
224 my $attr = $self->associated_attribute;
225 my $attr_name = $attr->name;
226 my $meta_instance = $attr->associated_class->instance_metaclass;
228 my ( $code, $e ) = $self->_eval_closure(
231 . $meta_instance->inline_set_slot_value('$_[0]', $attr_name, '$_[1]')
234 confess "Could not generate inline writer because : $e" if $e;
239 sub generate_predicate_method_inline {
240 Carp::cluck('The generate_predicate_method_inline method has been made private.'
241 . " The public version is deprecated and will be removed in a future release.\n");
242 shift->_generate_predicate_method_inline;
245 sub _generate_predicate_method_inline {
247 my $attr = $self->associated_attribute;
248 my $attr_name = $attr->name;
249 my $meta_instance = $attr->associated_class->instance_metaclass;
251 my ( $code, $e ) = $self->_eval_closure(
254 . $meta_instance->inline_is_slot_initialized('$_[0]', $attr_name)
257 confess "Could not generate inline predicate because : $e" if $e;
262 sub generate_clearer_method_inline {
263 Carp::cluck('The generate_clearer_method_inline method has been made private.'
264 . " The public version is deprecated and will be removed in a future release.\n");
265 shift->_generate_clearer_method_inline;
268 sub _generate_clearer_method_inline {
270 my $attr = $self->associated_attribute;
271 my $attr_name = $attr->name;
272 my $meta_instance = $attr->associated_class->instance_metaclass;
274 my ( $code, $e ) = $self->_eval_closure(
277 . $meta_instance->inline_deinitialize_slot('$_[0]', $attr_name)
280 confess "Could not generate inline clearer because : $e" if $e;
293 Class::MOP::Method::Accessor - Method Meta Object for accessors
297 use Class::MOP::Method::Accessor;
299 my $reader = Class::MOP::Method::Accessor->new(
300 attribute => $attribute,
302 accessor_type => 'reader',
305 $reader->body->execute($instance); # call the reader method
309 This is a subclass of <Class::MOP::Method> which is used by
310 C<Class::MOP::Attribute> to generate accessor code. It handles
311 generation of readers, writers, predicates and clearers. For each type
312 of method, it can either create a subroutine reference, or actually
313 inline code by generating a string and C<eval>'ing it.
319 =item B<< Class::MOP::Method::Accessor->new(%options) >>
321 This returns a new C<Class::MOP::Method::Accessor> based on the
322 C<%options> provided.
328 This is the C<Class::MOP::Attribute> for which accessors are being
329 generated. This option is required.
331 =item * accessor_type
333 This is a string which should be one of "reader", "writer",
334 "accessor", "predicate", or "clearer". This is the type of method
335 being generated. This option is required.
339 This indicates whether or not the accessor should be inlined. This
344 The method name (without a package name). This is required.
348 The package name for the method. This is required.
352 =item B<< $metamethod->accessor_type >>
354 Returns the accessor type which was passed to C<new>.
356 =item B<< $metamethod->is_inline >>
358 Returns a boolean indicating whether or not the accessor is inlined.
360 =item B<< $metamethod->associated_attribute >>
362 This returns the L<Class::MOP::Attribute> object which was passed to
365 =item B<< $metamethod->body >>
367 The method itself is I<generated> when the accessor object is
374 Stevan Little E<lt>stevan@iinteractive.comE<gt>
376 =head1 COPYRIGHT AND LICENSE
378 Copyright 2006-2009 by Infinity Interactive, Inc.
380 L<http://www.iinteractive.com>
382 This library is free software; you can redistribute it and/or modify
383 it under the same terms as Perl itself.