2 package Class::MOP::Attribute;
8 use Scalar::Util 'blessed';
10 use Class::MOP::Class;
11 use Class::MOP::Method;
13 our $VERSION = '0.01';
15 sub meta { Class::MOP::Class->initialize($_[0]) }
22 (defined $name && $name ne '')
23 || confess "You must provide a name for the attribute";
24 (!exists $options{reader} && !exists $options{writer})
25 || confess "You cannot declare an accessor and reader and/or writer functions"
26 if exists $options{accessor};
30 accessor => $options{accessor},
31 reader => $options{reader},
32 writer => $options{writer},
33 init_arg => $options{init_arg},
34 default => $options{default}
38 sub name { (shift)->{name} }
40 sub has_accessor { (shift)->{accessor} ? 1 : 0 }
41 sub accessor { (shift)->{accessor} }
43 sub has_reader { (shift)->{reader} ? 1 : 0 }
44 sub reader { (shift)->{reader} }
46 sub has_writer { (shift)->{writer} ? 1 : 0 }
47 sub writer { (shift)->{writer} }
49 sub has_init_arg { (shift)->{init_arg} ? 1 : 0 }
50 sub init_arg { (shift)->{init_arg} }
52 sub has_default { (shift)->{default} ? 1 : 0 }
53 sub default { (shift)->{default} }
55 sub install_accessors {
56 my ($self, $class) = @_;
57 (blessed($class) && $class->isa('Class::MOP::Class'))
58 || confess "You must pass a Class::MOP::Class instance (or a subclass)";
60 if ($self->has_accessor()) {
61 $class->add_method($self->accessor() => Class::MOP::Attribute::Accessor->wrap(sub {
62 $_[0]->{$self->name} = $_[1] if scalar(@_) == 2;
67 if ($self->has_reader()) {
68 $class->add_method($self->reader() => Class::MOP::Attribute::Accessor->wrap(sub {
72 if ($self->has_writer()) {
73 $class->add_method($self->writer() => Class::MOP::Attribute::Accessor->wrap(sub {
74 $_[0]->{$self->name} = $_[1];
81 sub remove_accessors {
82 my ($self, $class) = @_;
83 (blessed($class) && $class->isa('Class::MOP::Class'))
84 || confess "You must pass a Class::MOP::Class instance (or a subclass)";
86 if ($self->has_accessor()) {
87 my $method = $class->get_method($self->accessor);
88 $class->remove_method($self->accessor)
89 if (blessed($method) && $method->isa('Class::MOP::Attribute::Accessor'));
92 if ($self->has_reader()) {
93 my $method = $class->get_method($self->reader);
94 $class->remove_method($self->reader)
95 if (blessed($method) && $method->isa('Class::MOP::Attribute::Accessor'));
97 if ($self->has_writer()) {
98 my $method = $class->get_method($self->writer);
99 $class->remove_method($self->writer)
100 if (blessed($method) && $method->isa('Class::MOP::Attribute::Accessor'));
105 package Class::MOP::Attribute::Accessor;
110 our $VERSION = '0.01';
112 our @ISA = ('Class::MOP::Method');
122 Class::MOP::Attribute - Attribute Meta Object
126 Class::MOP::Attribute->new('$foo' => (
127 accessor => 'foo', # dual purpose get/set accessor
128 init_arg => '-foo', # class->new will look for a -foo key
129 default => 'BAR IS BAZ!' # if no -foo key is provided, use this
132 Class::MOP::Attribute->new('$.bar' => (
133 reader => 'bar', # getter
134 writer => 'set_bar', # setter
135 init_arg => '-bar', # class->new will look for a -bar key
136 # no default value means it is undef
141 The Attribute Protocol is almost entirely an invention of this module. This is
142 because Perl 5 does not have consistent notion of what is an attribute
143 of a class. There are so many ways in which this is done, and very few
144 (if any) are discoverable by this module.
146 So, all that said, this module attempts to inject some order into this
147 chaos, by introducing a more consistent approach.
155 =item B<new ($name, %accessor_description, $class_initialization_arg, $default_value)>
177 =head2 Informational predicates
181 =item B<has_accessor>
183 Returns true if this attribute uses a get/set accessor, and false
188 Returns true if this attribute has a reader, and false otherwise
192 Returns true if this attribute has a writer, and false otherwise
194 =item B<has_init_arg>
196 Returns true if this attribute has a class intialization argument, and
201 Returns true if this attribute has a default value, and false
206 =head2 Attribute Accessor generation
210 =item B<install_accessors ($class)>
212 This allows the attribute to generate and install code for it's own
213 accessor methods. This is called by C<Class::MOP::Class::add_attribute>.
215 =item B<remove_accessors ($class)>
217 This allows the attribute to remove the method for it's own
218 accessor. This is called by C<Class::MOP::Class::remove_attribute>.
232 Stevan Little E<gt>stevan@iinteractive.comE<lt>
234 =head1 COPYRIGHT AND LICENSE
236 Copyright 2006 by Infinity Interactive, Inc.
238 L<http://www.iinteractive.com>
240 This library is free software; you can redistribute it and/or modify
241 it under the same terms as Perl itself.