2 package Class::MOP::Method::Accessor;
8 use Scalar::Util 'blessed', 'weaken';
10 our $VERSION = '0.02';
11 our $AUTHORITY = 'cpan:STEVAN';
13 use base 'Class::MOP::Method';
17 So, the idea here is that we have an accessor class
18 which takes a weak-link to the attribute and can
19 generate the actual code ref needed. This might allow
20 for more varied approaches.
22 And if the attribute type can also declare what
23 kind of accessor method metaclass it uses, then
24 this relationship can be handled by delegation.
32 (exists $options{attribute})
33 || confess "You must supply an attribute to construct with";
35 (exists $options{accessor_type})
36 || confess "You must supply an accessor_type to construct with";
38 (blessed($options{attribute}) && $options{attribute}->isa('Class::MOP::Attribute'))
39 || confess "You must supply an attribute which is a 'Class::MOP::Attribute' instance";
44 # specific to this subclass
45 attribute => $options{attribute},
46 as_inline => ($options{as_inline} || 0),
47 accessor_type => $options{accessor_type},
50 # we don't want this creating
51 # a cycle in the code, if not
53 weaken($self->{attribute});
55 $self->intialize_body;
62 sub associated_attribute { (shift)->{attribute} }
63 sub accessor_type { (shift)->{accessor_type} }
64 sub as_inline { (shift)->{as_inline} }
71 my $method_name = join "_" => (
75 ($self->as_inline ? 'inline' : ())
79 $self->{body} = $self->$method_name();
86 sub generate_accessor_method {
87 my $attr = (shift)->associated_attribute;
89 $attr->set_value($_[0], $_[1]) if scalar(@_) == 2;
90 $attr->get_value($_[0]);
94 sub generate_reader_method {
95 my $attr = (shift)->associated_attribute;
97 confess "Cannot assign a value to a read-only accessor" if @_ > 1;
98 $attr->get_value($_[0]);
102 sub generate_writer_method {
103 my $attr = (shift)->associated_attribute;
105 $attr->set_value($_[0], $_[1]);
109 sub generate_predicate_method {
110 my $attr = (shift)->associated_attribute;
111 my $attr_name = $attr->name;
113 defined Class::MOP::Class->initialize(Scalar::Util::blessed($_[0]))
115 ->get_slot_value($_[0], $attr_name) ? 1 : 0;
119 sub generate_clearer_method {
120 my $attr = (shift)->associated_attribute;
121 my $attr_name = $attr->name;
123 Class::MOP::Class->initialize(Scalar::Util::blessed($_[0]))
125 ->deinitialize_slot($_[0], $attr_name);
132 sub generate_accessor_method_inline {
133 my $attr = (shift)->associated_attribute;
134 my $attr_name = $attr->name;
135 my $meta_instance = $attr->associated_class->instance_metaclass;
137 my $code = eval 'sub {'
138 . $meta_instance->inline_set_slot_value('$_[0]', "'$attr_name'", '$_[1]') . ' if scalar(@_) == 2; '
139 . $meta_instance->inline_get_slot_value('$_[0]', "'$attr_name'")
141 confess "Could not generate inline accessor because : $@" if $@;
146 sub generate_reader_method_inline {
147 my $attr = (shift)->associated_attribute;
148 my $attr_name = $attr->name;
149 my $meta_instance = $attr->associated_class->instance_metaclass;
151 my $code = eval 'sub {'
152 . 'confess "Cannot assign a value to a read-only accessor" if @_ > 1;'
153 . $meta_instance->inline_get_slot_value('$_[0]', "'$attr_name'")
155 confess "Could not generate inline accessor because : $@" if $@;
160 sub generate_writer_method_inline {
161 my $attr = (shift)->associated_attribute;
162 my $attr_name = $attr->name;
163 my $meta_instance = $attr->associated_class->instance_metaclass;
165 my $code = eval 'sub {'
166 . $meta_instance->inline_set_slot_value('$_[0]', "'$attr_name'", '$_[1]')
168 confess "Could not generate inline accessor because : $@" if $@;
174 sub generate_predicate_method_inline {
175 my $attr = (shift)->associated_attribute;
176 my $attr_name = $attr->name;
177 my $meta_instance = $attr->associated_class->instance_metaclass;
179 my $code = eval 'sub {'
180 . 'defined ' . $meta_instance->inline_get_slot_value('$_[0]', "'$attr_name'") . ' ? 1 : 0'
182 confess "Could not generate inline predicate because : $@" if $@;
187 sub generate_clearer_method_inline {
188 my $attr = (shift)->associated_attribute;
189 my $attr_name = $attr->name;
190 my $meta_instance = $attr->associated_class->instance_metaclass;
192 my $code = eval 'sub {'
193 . $meta_instance->inline_deinitialize_slot('$_[0]', "'$attr_name'")
195 confess "Could not generate inline clearer because : $@" if $@;
208 Class::MOP::Method::Accessor - Method Meta Object for accessors
212 # ... more to come later maybe
222 =item B<intialize_body>
224 =item B<accessor_type>
228 =item B<associated_attribute>
230 =item B<generate_accessor_method>
232 =item B<generate_accessor_method_inline>
234 =item B<generate_clearer_method>
236 =item B<generate_clearer_method_inline>
238 =item B<generate_predicate_method>
240 =item B<generate_predicate_method_inline>
242 =item B<generate_reader_method>
244 =item B<generate_reader_method_inline>
246 =item B<generate_writer_method>
248 =item B<generate_writer_method_inline>
254 Stevan Little E<lt>stevan@iinteractive.comE<gt>
256 Yuval Kogman E<lt>nothingmuch@woobling.comE<gt>
258 =head1 COPYRIGHT AND LICENSE
260 Copyright 2006 by Infinity Interactive, Inc.
262 L<http://www.iinteractive.com>
264 This library is free software; you can redistribute it and/or modify
265 it under the same terms as Perl itself.