2 package Class::MOP::Method::Accessor;
8 use Scalar::Util 'blessed', 'weaken';
11 our $VERSION = '1.11';
12 $VERSION = eval $VERSION;
13 our $AUTHORITY = 'cpan:STEVAN';
15 use base 'Class::MOP::Method::Generated';
21 (exists $options{attribute})
22 || confess "You must supply an attribute to construct with";
24 (exists $options{accessor_type})
25 || confess "You must supply an accessor_type to construct with";
27 (blessed($options{attribute}) && $options{attribute}->isa('Class::MOP::Attribute'))
28 || confess "You must supply an attribute which is a 'Class::MOP::Attribute' instance";
30 ($options{package_name} && $options{name})
31 || confess "You must supply the package_name and name parameters $Class::MOP::Method::UPGRADE_ERROR_TEXT";
33 my $self = $class->_new(\%options);
35 # we don't want this creating
36 # a cycle in the code, if not
38 weaken($self->{'attribute'});
40 $self->_initialize_body;
48 return Class::MOP::Class->initialize($class)->new_object(@_)
49 if $class ne __PACKAGE__;
51 my $params = @_ == 1 ? $_[0] : {@_};
54 # inherited from Class::MOP::Method
55 body => $params->{body},
56 associated_metaclass => $params->{associated_metaclass},
57 package_name => $params->{package_name},
58 name => $params->{name},
59 original_method => $params->{original_method},
61 # inherit from Class::MOP::Generated
62 is_inline => $params->{is_inline} || 0,
63 definition_context => $params->{definition_context},
65 # defined in this class
66 attribute => $params->{attribute},
67 accessor_type => $params->{accessor_type},
73 sub associated_attribute { (shift)->{'attribute'} }
74 sub accessor_type { (shift)->{'accessor_type'} }
78 sub _initialize_body {
81 my $method_name = join "_" => (
85 ($self->is_inline ? 'inline' : ())
88 $self->{'body'} = $self->$method_name();
93 sub _generate_accessor_method {
95 my $attr = $self->associated_attribute;
99 $attr->set_value($_[0], $_[1]);
101 $attr->get_value($_[0]);
105 sub _generate_accessor_method_inline {
107 my $attr = $self->associated_attribute;
110 $self->_compile_code([
113 $attr->_inline_set_value('$_[0]', '$_[1]'),
115 $attr->_inline_get_value('$_[0]'),
120 confess "Could not generate inline accessor because : $_";
124 sub _generate_reader_method {
126 my $attr = $self->associated_attribute;
129 confess "Cannot assign a value to a read-only accessor"
131 $attr->get_value($_[0]);
135 sub _generate_reader_method_inline {
137 my $attr = $self->associated_attribute;
140 $self->_compile_code([
143 # XXX: this is a hack, but our error stuff is terrible
144 $self->_inline_throw_error(
145 '"Cannot assign a value to a read-only accessor"',
149 $attr->_inline_get_value('$_[0]'),
154 confess "Could not generate inline reader because : $_";
158 sub _inline_throw_error {
160 return 'confess ' . $_[0];
163 sub _generate_writer_method {
165 my $attr = $self->associated_attribute;
168 $attr->set_value($_[0], $_[1]);
172 sub _generate_writer_method_inline {
174 my $attr = $self->associated_attribute;
177 $self->_compile_code([
179 $attr->_inline_set_value('$_[0]', '$_[1]'),
184 confess "Could not generate inline writer because : $_";
188 sub _generate_predicate_method {
190 my $attr = $self->associated_attribute;
193 $attr->has_value($_[0])
197 sub _generate_predicate_method_inline {
199 my $attr = $self->associated_attribute;
202 $self->_compile_code([
204 $attr->_inline_has_value('$_[0]'),
209 confess "Could not generate inline predicate because : $_";
213 sub _generate_clearer_method {
215 my $attr = $self->associated_attribute;
218 $attr->clear_value($_[0])
222 sub _generate_clearer_method_inline {
224 my $attr = $self->associated_attribute;
227 $self->_compile_code([
229 $attr->_inline_clear_value('$_[0]'),
234 confess "Could not generate inline clearer because : $_";
246 Class::MOP::Method::Accessor - Method Meta Object for accessors
250 use Class::MOP::Method::Accessor;
252 my $reader = Class::MOP::Method::Accessor->new(
253 attribute => $attribute,
255 accessor_type => 'reader',
258 $reader->body->execute($instance); # call the reader method
262 This is a subclass of C<Class::MOP::Method> which is used by
263 C<Class::MOP::Attribute> to generate accessor code. It handles
264 generation of readers, writers, predicates and clearers. For each type
265 of method, it can either create a subroutine reference, or actually
266 inline code by generating a string and C<eval>'ing it.
272 =item B<< Class::MOP::Method::Accessor->new(%options) >>
274 This returns a new C<Class::MOP::Method::Accessor> based on the
275 C<%options> provided.
281 This is the C<Class::MOP::Attribute> for which accessors are being
282 generated. This option is required.
284 =item * accessor_type
286 This is a string which should be one of "reader", "writer",
287 "accessor", "predicate", or "clearer". This is the type of method
288 being generated. This option is required.
292 This indicates whether or not the accessor should be inlined. This
297 The method name (without a package name). This is required.
301 The package name for the method. This is required.
305 =item B<< $metamethod->accessor_type >>
307 Returns the accessor type which was passed to C<new>.
309 =item B<< $metamethod->is_inline >>
311 Returns a boolean indicating whether or not the accessor is inlined.
313 =item B<< $metamethod->associated_attribute >>
315 This returns the L<Class::MOP::Attribute> object which was passed to
318 =item B<< $metamethod->body >>
320 The method itself is I<generated> when the accessor object is
327 Stevan Little E<lt>stevan@iinteractive.comE<gt>
329 =head1 COPYRIGHT AND LICENSE
331 Copyright 2006-2010 by Infinity Interactive, Inc.
333 L<http://www.iinteractive.com>
335 This library is free software; you can redistribute it and/or modify
336 it under the same terms as Perl itself.