2 package Class::MOP::Attribute;
8 use Scalar::Util 'blessed', 'reftype', 'weaken';
10 our $VERSION = '0.02';
13 require Class::MOP::Class;
14 Class::MOP::Class->initialize($_[0])
17 # NOTE: (meta-circularity)
18 # This method will be replaces in the
19 # boostrap section of Class::MOP, by
20 # a new version which uses the
21 # &Class::MOP::Class::construct_instance
22 # method to build an attribute meta-object
23 # which itself is described with attribute
25 # - Ain't meta-circularity grand? :)
31 (defined $name && $name)
32 || confess "You must provide a name for the attribute";
33 (!exists $options{reader} && !exists $options{writer})
34 || confess "You cannot declare an accessor and reader and/or writer functions"
35 if exists $options{accessor};
39 accessor => $options{accessor},
40 reader => $options{reader},
41 writer => $options{writer},
42 predicate => $options{predicate},
43 init_arg => $options{init_arg},
44 default => $options{default},
45 # keep a weakened link to the
46 # class we are associated with
47 associated_class => undef,
51 sub name { $_[0]->{name} }
53 sub has_accessor { defined($_[0]->{accessor}) ? 1 : 0 }
54 sub has_reader { defined($_[0]->{reader}) ? 1 : 0 }
55 sub has_writer { defined($_[0]->{writer}) ? 1 : 0 }
56 sub has_predicate { defined($_[0]->{predicate}) ? 1 : 0 }
57 sub has_init_arg { defined($_[0]->{init_arg}) ? 1 : 0 }
58 sub has_default { defined($_[0]->{default}) ? 1 : 0 }
60 sub accessor { $_[0]->{accessor} }
61 sub reader { $_[0]->{reader} }
62 sub writer { $_[0]->{writer} }
63 sub predicate { $_[0]->{predicate} }
64 sub init_arg { $_[0]->{init_arg} }
68 if (reftype($self->{default}) && reftype($self->{default}) eq 'CODE') {
69 # if the default is a CODE ref, then
70 # we pass in the instance and default
71 # can return a value based on that
72 # instance. Somewhat crude, but works.
73 return $self->{default}->(shift);
80 sub associated_class { $_[0]->{associated_class} }
83 my ($self, $class) = @_;
84 (blessed($class) && $class->isa('Class::MOP::Class'))
85 || confess "You must pass a Class::MOP::Class instance (or a subclass)";
86 weaken($self->{associated_class} = $class);
89 sub detach_from_class {
91 $self->{associated_class} = undef;
94 ## Method generation helpers
96 sub generate_accessor_method {
97 my ($self, $attr_name) = @_;
99 \$_[0]->{'$attr_name'} = \$_[1] if scalar(\@_) == 2;
100 \$_[0]->{'$attr_name'};
104 sub generate_reader_method {
105 my ($self, $attr_name) = @_;
107 \$_[0]->{'$attr_name'};
111 sub generate_writer_method {
112 my ($self, $attr_name) = @_;
114 \$_[0]->{'$attr_name'} = \$_[1];
118 sub generate_predicate_method {
119 my ($self, $attr_name) = @_;
121 defined \$_[0]->{'$attr_name'} ? 1 : 0;
125 sub process_accessors {
126 my ($self, $type, $accessor) = @_;
127 if (reftype($accessor) && reftype($accessor) eq 'HASH') {
128 my ($name, $method) = each %{$accessor};
129 return ($name, Class::MOP::Attribute::Accessor->wrap($method));
132 my $generator = $self->can('generate_' . $type . '_method');
134 || confess "There is no method generator for the type='$type'";
135 if (my $method = $self->$generator($self->name)) {
136 return ($accessor => Class::MOP::Attribute::Accessor->wrap($method));
138 confess "Could not create the methods for " . $self->name . " because : $@";
142 sub install_accessors {
144 my $class = $self->associated_class;
147 $self->process_accessors('accessor' => $self->accessor())
148 ) if $self->has_accessor();
151 $self->process_accessors('reader' => $self->reader())
152 ) if $self->has_reader();
155 $self->process_accessors('writer' => $self->writer())
156 ) if $self->has_writer();
159 $self->process_accessors('predicate' => $self->predicate())
160 ) if $self->has_predicate();
165 my $_remove_accessor = sub {
166 my ($accessor, $class) = @_;
167 if (reftype($accessor) && reftype($accessor) eq 'HASH') {
168 ($accessor) = keys %{$accessor};
170 my $method = $class->get_method($accessor);
171 $class->remove_method($accessor)
172 if (blessed($method) && $method->isa('Class::MOP::Attribute::Accessor'));
175 sub remove_accessors {
177 $_remove_accessor->($self->accessor(), $self->associated_class()) if $self->has_accessor();
178 $_remove_accessor->($self->reader(), $self->associated_class()) if $self->has_reader();
179 $_remove_accessor->($self->writer(), $self->associated_class()) if $self->has_writer();
180 $_remove_accessor->($self->predicate(), $self->associated_class()) if $self->has_predicate();
186 package Class::MOP::Attribute::Accessor;
191 use Class::MOP::Method;
193 our $VERSION = '0.01';
195 our @ISA = ('Class::MOP::Method');
205 Class::MOP::Attribute - Attribute Meta Object
209 Class::MOP::Attribute->new('$foo' => (
210 accessor => 'foo', # dual purpose get/set accessor
211 predicate => 'has_foo' # predicate check for defined-ness
212 init_arg => '-foo', # class->new will look for a -foo key
213 default => 'BAR IS BAZ!' # if no -foo key is provided, use this
216 Class::MOP::Attribute->new('$.bar' => (
217 reader => 'bar', # getter
218 writer => 'set_bar', # setter
219 predicate => 'has_bar' # predicate check for defined-ness
220 init_arg => ':bar', # class->new will look for a :bar key
221 # no default value means it is undef
226 The Attribute Protocol is almost entirely an invention of this module,
227 and is completely optional to this MOP. This is because Perl 5 does not
228 have consistent notion of what is an attribute of a class. There are
229 so many ways in which this is done, and very few (if any) are
230 easily discoverable by this module.
232 So, all that said, this module attempts to inject some order into this
233 chaos, by introducing a consistent API which can be used to create
242 =item B<new ($name, ?%options)>
244 An attribute must (at the very least), have a C<$name>. All other
245 C<%options> are contained added as key-value pairs. Acceptable keys
252 This should be a string value representing the expected key in
253 an initialization hash. For instance, if we have an I<init_arg>
254 value of C<-foo>, then the following code will Just Work.
256 MyClass->meta->construct_instance(-foo => "Hello There");
260 The value of this key is the default value which
261 C<Class::MOP::Class::construct_instance> will initialize the
265 If the value is a simple scalar (string or number), then it can
266 be just passed as is. However, if you wish to initialize it with
267 a HASH or ARRAY ref, then you need to wrap that inside a CODE
270 Class::MOP::Attribute->new('@foo' => (
271 default => sub { [] },
276 Class::MOP::Attribute->new('%foo' => (
277 default => sub { {} },
280 If you wish to initialize an attribute with a CODE reference
281 itself, then you need to wrap that in a subroutine as well, like
284 Class::MOP::Attribute->new('&foo' => (
285 default => sub { sub { print "Hello World" } },
288 And lastly, if the value of your attribute is dependent upon
289 some other aspect of the instance structure, then you can take
290 advantage of the fact that when the I<default> value is a CODE
291 reference, it is passed the raw (unblessed) instance structure
292 as it's only argument. So you can do things like this:
294 Class::MOP::Attribute->new('$object_identity' => (
295 default => sub { Scalar::Util::refaddr($_[0]) },
298 This last feature is fairly limited as there is no gurantee of
299 the order of attribute initializations, so you cannot perform
300 any kind of dependent initializations. However, if this is
301 something you need, you could subclass B<Class::MOP::Class> and
302 this class to acheive it. However, this is currently left as
303 an exercise to the reader :).
307 The I<accessor>, I<reader>, I<writer> and I<predicate> keys can
308 contain either; the name of the method and an appropriate default
309 one will be generated for you, B<or> a HASH ref containing exactly one
310 key (which will be used as the name of the method) and one value,
311 which should contain a CODE reference which will be installed as
318 The I<accessor> is a standard perl-style read/write accessor. It will
319 return the value of the attribute, and if a value is passed as an argument,
320 it will assign that value to the attribute.
323 This method will properly handle the following code, by assigning an
324 C<undef> value to the attribute.
326 $object->set_something(undef);
330 This is a basic read-only accessor, it will just return the value of
335 This is a basic write accessor, it accepts a single argument, and
336 assigns that value to the attribute. This method does not intentially
337 return a value, however perl will return the result of the last
338 expression in the subroutine, which returns in this returning the
339 same value that it was passed.
342 This method will properly handle the following code, by assigning an
343 C<undef> value to the attribute.
345 $object->set_something();
349 This is a basic test to see if the value of the attribute is not
350 C<undef>. It will return true (C<1>) if the attribute's value is
351 defined, and false (C<0>) otherwise.
359 These are all basic read-only value accessors for the values
360 passed into C<new>. I think they are pretty much self-explanitory.
376 =item B<default (?$instance)>
378 As noted in the documentation for C<new> above, if the I<default>
379 value is a CODE reference, this accessor will pass a single additional
380 argument C<$instance> into it and return the value.
384 =head2 Informational predicates
386 These are all basic predicate methods for the values passed into C<new>.
390 =item B<has_accessor>
396 =item B<has_predicate>
398 =item B<has_init_arg>
404 =head2 Class association
408 =item B<associated_class>
410 =item B<attach_to_class ($class)>
412 =item B<detach_from_class>
416 =head2 Attribute Accessor generation
420 =item B<install_accessors>
422 This allows the attribute to generate and install code for it's own
423 I<accessor/reader/writer/predicate> methods. This is called by
424 C<Class::MOP::Class::add_attribute>.
426 This method will call C<process_accessors> for each of the possible
427 method types (accessor, reader, writer & predicate).
429 =item B<process_accessors ($type, $value)>
431 This takes a C<$type> (accessor, reader, writer or predicate), and
432 a C<$value> (the value passed into the constructor for each of the
433 different types). It will then either generate the method itself
434 (using the C<generate_*_method> methods listed below) or it will
435 use the custom method passed through the constructor.
439 =item B<generate_accessor_method ($attr_name)>
441 =item B<generate_predicate_method ($attr_name)>
443 =item B<generate_reader_method ($attr_name)>
445 =item B<generate_writer_method ($attr_name)>
449 =item B<remove_accessors>
451 This allows the attribute to remove the method for it's own
452 I<accessor/reader/writer/predicate>. This is called by
453 C<Class::MOP::Class::remove_attribute>.
463 This will return a B<Class::MOP::Class> instance which is related
466 It should also be noted that B<Class::MOP> will actually bootstrap
467 this module by installing a number of attribute meta-objects into
468 it's metaclass. This will allow this class to reap all the benifits
469 of the MOP when subclassing it.
475 Stevan Little E<lt>stevan@iinteractive.comE<gt>
477 =head1 COPYRIGHT AND LICENSE
479 Copyright 2006 by Infinity Interactive, Inc.
481 L<http://www.iinteractive.com>
483 This library is free software; you can redistribute it and/or modify
484 it under the same terms as Perl itself.