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 {
94 my $attr = (shift)->associated_attribute;
96 $attr->set_value($_[0], $_[1]) if scalar(@_) == 2;
97 $attr->get_value($_[0]);
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]);
110 sub _generate_writer_method {
111 my $attr = (shift)->associated_attribute;
113 $attr->set_value($_[0], $_[1]);
117 sub _generate_predicate_method {
118 my $attr = (shift)->associated_attribute;
120 $attr->has_value($_[0])
124 sub _generate_clearer_method {
125 my $attr = (shift)->associated_attribute;
127 $attr->clear_value($_[0])
133 sub _generate_accessor_method_inline {
135 my $attr = $self->associated_attribute;
138 $self->_compile_code([
140 $attr->inline_set('$_[0]', '$_[1]'),
141 'if scalar(@_) == 2;',
142 $attr->inline_get('$_[0]') . ';',
147 confess "Could not generate inline accessor because : $_";
153 sub _generate_reader_method_inline {
155 my $attr = $self->associated_attribute;
158 $self->_compile_code([
160 'confess "Cannot assign a value to a read-only accessor"',
162 $attr->inline_get('$_[0]') . ';',
167 confess "Could not generate inline reader because : $_";
173 sub _generate_writer_method_inline {
175 my $attr = $self->associated_attribute;
178 $self->_compile_code([
180 $attr->inline_set('$_[0]', '$_[1]') . ';',
185 confess "Could not generate inline writer because : $_";
191 sub _generate_predicate_method_inline {
193 my $attr = $self->associated_attribute;
196 $self->_compile_code([
198 $attr->inline_has('$_[0]') . ';',
203 confess "Could not generate inline predicate because : $_";
209 sub _generate_clearer_method_inline {
211 my $attr = $self->associated_attribute;
214 $self->_compile_code([
216 $attr->inline_clear('$_[0]') . ';',
221 confess "Could not generate inline clearer because : $_";
235 Class::MOP::Method::Accessor - Method Meta Object for accessors
239 use Class::MOP::Method::Accessor;
241 my $reader = Class::MOP::Method::Accessor->new(
242 attribute => $attribute,
244 accessor_type => 'reader',
247 $reader->body->execute($instance); # call the reader method
251 This is a subclass of C<Class::MOP::Method> which is used by
252 C<Class::MOP::Attribute> to generate accessor code. It handles
253 generation of readers, writers, predicates and clearers. For each type
254 of method, it can either create a subroutine reference, or actually
255 inline code by generating a string and C<eval>'ing it.
261 =item B<< Class::MOP::Method::Accessor->new(%options) >>
263 This returns a new C<Class::MOP::Method::Accessor> based on the
264 C<%options> provided.
270 This is the C<Class::MOP::Attribute> for which accessors are being
271 generated. This option is required.
273 =item * accessor_type
275 This is a string which should be one of "reader", "writer",
276 "accessor", "predicate", or "clearer". This is the type of method
277 being generated. This option is required.
281 This indicates whether or not the accessor should be inlined. This
286 The method name (without a package name). This is required.
290 The package name for the method. This is required.
294 =item B<< $metamethod->accessor_type >>
296 Returns the accessor type which was passed to C<new>.
298 =item B<< $metamethod->is_inline >>
300 Returns a boolean indicating whether or not the accessor is inlined.
302 =item B<< $metamethod->associated_attribute >>
304 This returns the L<Class::MOP::Attribute> object which was passed to
307 =item B<< $metamethod->body >>
309 The method itself is I<generated> when the accessor object is
316 Stevan Little E<lt>stevan@iinteractive.comE<gt>
318 =head1 COPYRIGHT AND LICENSE
320 Copyright 2006-2010 by Infinity Interactive, Inc.
322 L<http://www.iinteractive.com>
324 This library is free software; you can redistribute it and/or modify
325 it under the same terms as Perl itself.