2 package Class::MOP::Method::Accessor;
8 use Scalar::Util 'blessed', 'weaken';
11 use base 'Class::MOP::Method::Generated';
17 (exists $options{attribute})
18 || confess "You must supply an attribute to construct with";
20 (exists $options{accessor_type})
21 || confess "You must supply an accessor_type to construct with";
23 (blessed($options{attribute}) && $options{attribute}->isa('Class::MOP::Attribute'))
24 || confess "You must supply an attribute which is a 'Class::MOP::Attribute' instance";
26 ($options{package_name} && $options{name})
27 || confess "You must supply the package_name and name parameters $Class::MOP::Method::UPGRADE_ERROR_TEXT";
29 my $self = $class->_new(\%options);
31 # we don't want this creating
32 # a cycle in the code, if not
34 weaken($self->{'attribute'});
36 $self->_initialize_body;
44 return Class::MOP::Class->initialize($class)->new_object(@_)
45 if $class ne __PACKAGE__;
47 my $params = @_ == 1 ? $_[0] : {@_};
50 # inherited from Class::MOP::Method
51 body => $params->{body},
52 associated_metaclass => $params->{associated_metaclass},
53 package_name => $params->{package_name},
54 name => $params->{name},
55 original_method => $params->{original_method},
57 # inherit from Class::MOP::Generated
58 is_inline => $params->{is_inline} || 0,
59 definition_context => $params->{definition_context},
61 # defined in this class
62 attribute => $params->{attribute},
63 accessor_type => $params->{accessor_type},
69 sub associated_attribute { (shift)->{'attribute'} }
70 sub accessor_type { (shift)->{'accessor_type'} }
74 sub _initialize_body {
77 my $method_name = join "_" => (
81 ($self->is_inline ? 'inline' : ())
84 $self->{'body'} = $self->$method_name();
89 sub _generate_accessor_method {
91 my $attr = $self->associated_attribute;
95 $attr->set_value($_[0], $_[1]);
97 $attr->get_value($_[0]);
101 sub _generate_accessor_method_inline {
103 my $attr = $self->associated_attribute;
105 my $RuNNeR; return bless sub { if (!defined($RuNNeR)) { $RuNNeR = try {
106 $self->_compile_code([
109 $attr->_inline_set_value('$_[0]', '$_[1]'),
111 $attr->_inline_get_value('$_[0]'),
116 confess "Could not generate inline accessor because : $_";
118 return $RuNNeR if !defined($_[0]) && ref($_[1]) && ref($_[1]) eq 'RuNNeR'}; goto $RuNNeR},'RuNNeR';
121 sub _generate_reader_method {
123 my $attr = $self->associated_attribute;
126 confess "Cannot assign a value to a read-only accessor"
128 $attr->get_value($_[0]);
132 sub _generate_reader_method_inline {
134 my $attr = $self->associated_attribute;
136 my $RuNNeR; return bless sub { if (!defined($RuNNeR)) { $RuNNeR = try {
137 $self->_compile_code([
140 # XXX: this is a hack, but our error stuff is terrible
141 $self->_inline_throw_error(
142 '"Cannot assign a value to a read-only accessor"',
146 $attr->_inline_get_value('$_[0]'),
151 confess "Could not generate inline reader because : $_";
153 return $RuNNeR if !defined($_[0]) && ref($_[1]) && ref($_[1]) eq 'RuNNeR'}; goto $RuNNeR},'RuNNeR';
156 sub _inline_throw_error {
158 return 'Carp::confess ' . $_[0];
161 sub _generate_writer_method {
163 my $attr = $self->associated_attribute;
166 $attr->set_value($_[0], $_[1]);
170 sub _generate_writer_method_inline {
172 my $attr = $self->associated_attribute;
174 my $RuNNeR; return bless sub { if (!defined($RuNNeR)) { $RuNNeR = try {
175 $self->_compile_code([
177 $attr->_inline_set_value('$_[0]', '$_[1]'),
182 confess "Could not generate inline writer because : $_";
184 return $RuNNeR if !defined($_[0]) && ref($_[1]) && ref($_[1]) eq 'RuNNeR'}; goto $RuNNeR},'RuNNeR';
187 sub _generate_predicate_method {
189 my $attr = $self->associated_attribute;
192 $attr->has_value($_[0])
196 sub _generate_predicate_method_inline {
198 my $attr = $self->associated_attribute;
200 my $RuNNeR; return bless sub { if (!defined($RuNNeR)) { $RuNNeR = try {
201 $self->_compile_code([
203 $attr->_inline_has_value('$_[0]'),
208 confess "Could not generate inline predicate because : $_";
210 return $RuNNeR if !defined($_[0]) && ref($_[1]) && ref($_[1]) eq 'RuNNeR'}; goto $RuNNeR},'RuNNeR';
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;
226 my $RuNNeR; return bless sub { if (!defined($RuNNeR)) { $RuNNeR = try {
227 $self->_compile_code([
229 $attr->_inline_clear_value('$_[0]'),
234 confess "Could not generate inline clearer because : $_";
236 return $RuNNeR if !defined($_[0]) && ref($_[1]) && ref($_[1]) eq 'RuNNeR'}; goto $RuNNeR},'RuNNeR';
241 # ABSTRACT: Method Meta Object for accessors
249 use Class::MOP::Method::Accessor;
251 my $reader = Class::MOP::Method::Accessor->new(
252 attribute => $attribute,
254 accessor_type => 'reader',
257 $reader->body->execute($instance); # call the reader method
261 This is a subclass of C<Class::MOP::Method> which is used by
262 C<Class::MOP::Attribute> to generate accessor code. It handles
263 generation of readers, writers, predicates and clearers. For each type
264 of method, it can either create a subroutine reference, or actually
265 inline code by generating a string and C<eval>'ing it.
271 =item B<< Class::MOP::Method::Accessor->new(%options) >>
273 This returns a new C<Class::MOP::Method::Accessor> based on the
274 C<%options> provided.
280 This is the C<Class::MOP::Attribute> for which accessors are being
281 generated. This option is required.
283 =item * accessor_type
285 This is a string which should be one of "reader", "writer",
286 "accessor", "predicate", or "clearer". This is the type of method
287 being generated. This option is required.
291 This indicates whether or not the accessor should be inlined. This
296 The method name (without a package name). This is required.
300 The package name for the method. This is required.
304 =item B<< $metamethod->accessor_type >>
306 Returns the accessor type which was passed to C<new>.
308 =item B<< $metamethod->is_inline >>
310 Returns a boolean indicating whether or not the accessor is inlined.
312 =item B<< $metamethod->associated_attribute >>
314 This returns the L<Class::MOP::Attribute> object which was passed to
317 =item B<< $metamethod->body >>
319 The method itself is I<generated> when the accessor object is