1 package MooseX::ClassAttribute::Role::Meta::Class;
6 use MooseX::ClassAttribute::Role::Meta::Attribute;
7 use Scalar::Util qw( blessed );
9 use namespace::autoclean;
12 with 'MooseX::ClassAttribute::Role::Meta::Mixin::HasClassAttributes';
14 has _class_attribute_values => (
19 'get_class_attribute_value' => 'get',
20 'set_class_attribute_value' => 'set',
21 'has_class_attribute_value' => 'exists',
22 'clear_class_attribute_value' => 'delete',
25 default => sub { $_[0]->_class_attribute_values_hashref() },
29 sub add_class_attribute {
33 = blessed $_[0] && $_[0]->isa('Class::MOP::Attribute')
35 : $self->_process_class_attribute(@_);
37 my $name = $attr->name();
39 $self->remove_class_attribute($name)
40 if $self->has_class_attribute($name);
42 $attr->attach_to_class($self);
44 $self->_add_class_attribute( $name => $attr );
48 eval { $attr->install_accessors() };
53 $self->remove_attribute($name);
60 # It'd be nice if I didn't have to replicate this for class
61 # attributes, since it's basically just a copy of
62 # Moose::Meta::Class->_process_attribute
63 sub _process_class_attribute {
68 @args = %{ $args[0] } if scalar @args == 1 && ref( $args[0] ) eq 'HASH';
70 if ( $name =~ /^\+(.*)/ ) {
71 return $self->_process_inherited_class_attribute( $1, @args );
74 return $self->_process_new_class_attribute( $name, @args );
78 sub _process_new_class_attribute {
84 push @{ $p{traits} }, 'MooseX::ClassAttribute::Role::Meta::Attribute';
87 $p{traits} = ['MooseX::ClassAttribute::Role::Meta::Attribute'];
90 return Moose::Meta::Attribute->interpolate_class_and_new( $name, %p );
93 sub _process_inherited_class_attribute {
98 my $inherited_attr = $self->find_class_attribute_by_name($name);
100 ( defined $inherited_attr )
102 "Could not find an attribute by the name of '$name' to inherit from";
104 return $inherited_attr->clone_and_inherit_options(%p);
107 sub remove_class_attribute {
111 ( defined $name && $name )
112 || confess 'You must provide an attribute name';
114 my $removed_attr = $self->get_class_attribute($name);
115 return unless $removed_attr;
117 $self->_remove_class_attribute($name);
119 $removed_attr->remove_accessors();
120 $removed_attr->detach_from_class();
122 return $removed_attr;
125 sub get_all_class_attributes {
130 my $meta = Class::MOP::class_of($_);
131 $meta && $meta->can('get_class_attribute_map')
132 ? %{ $meta->get_class_attribute_map() }
135 reverse $self->linearized_isa;
137 return values %attrs;
140 sub compute_all_applicable_class_attributes {
142 'The compute_all_applicable_class_attributes method has been deprecated.'
143 . " Use get_all_class_attributes instead.\n";
145 shift->compute_all_applicable_class_attributes(@_);
148 sub find_class_attribute_by_name {
152 foreach my $class ( $self->linearized_isa() ) {
153 my $meta = Class::MOP::class_of($class)
156 return $meta->get_class_attribute($name)
157 if $meta->can('has_class_attribute')
158 && $meta->has_class_attribute($name);
164 sub _class_attribute_values_hashref {
168 return \%{ $self->_class_attribute_var_name() };
171 sub _class_attribute_var_name {
174 return $self->name() . q'::__ClassAttributeValues';
177 sub inline_class_slot_access {
183 . $self->_class_attribute_var_name . '{"'
184 . quotemeta($name) . '"}';
187 sub inline_get_class_slot_value {
191 return $self->inline_class_slot_access($name);
194 sub inline_set_class_slot_value {
197 my $val_name = shift;
199 return $self->inline_class_slot_access($name) . ' = ' . $val_name;
202 sub inline_is_class_slot_initialized {
206 return 'exists ' . $self->inline_class_slot_access($name);
209 sub inline_deinitialize_class_slot {
213 return 'delete ' . $self->inline_class_slot_access($name);
216 sub inline_weaken_class_slot_value {
221 'Scalar::Util::weaken( '
222 . $self->inline_class_slot_access($name) . ')';
233 MooseX::ClassAttribute::Role::Meta::Class - A metaclass role for classes with class attributes
237 for my $attr ( HasClassAttributes->meta()->get_all_class_attributes() )
244 This role adds awareness of class attributes to a metaclass object. It
245 provides a set of introspection methods that largely parallel the
246 existing attribute methods, except they operate on class attributes.
250 Every method provided by this role has an analogous method in
251 C<Class::MOP::Class> or C<Moose::Meta::Class> for regular attributes.
253 =head2 $meta->has_class_attribute($name)
255 =head2 $meta->get_class_attribute($name)
257 =head2 $meta->get_class_attribute_list()
259 =head2 $meta->get_class_attribute_map()
261 These methods operate on the current metaclass only.
263 =head2 $meta->add_class_attribute(...)
265 This accepts the same options as the L<Moose::Meta::Attribute>
266 C<add_attribute()> method. However, if an attribute is specified as
267 "required" an error will be thrown.
269 =head2 $meta->remove_class_attribute($name)
271 If the named class attribute exists, it is removed from the class,
272 along with its accessor methods.
274 =head2 $meta->get_all_class_attributes()
276 This method returns a list of attribute objects for the class and all
279 =head2 $meta->find_class_attribute_by_name($name)
281 This method looks at the class and all its parent classes for the
282 named class attribute.
284 =head2 $meta->get_class_attribute_value($name)
286 =head2 $meta->set_class_attribute_value($name, $value)
288 =head2 $meta->set_class_attribute_value($name)
290 =head2 $meta->clear_class_attribute_value($name)
292 These methods operate on the storage for class attribute values, which
293 is attached to the metaclass object.
295 There's really no good reason for you to call these methods unless
296 you're doing some deep hacking. They are named as public methods
297 solely because they are used by other meta roles and classes in this
300 =head2 inline_class_slot_access($name)
302 =head2 inline_get_class_slot_value($name)
304 =head2 inline_set_class_slot_value($name, $val_name)
306 =head2 inline_is_class_slot_initialized($name)
308 =head2 inline_deinitialize_class_slot($name)
310 =head2 inline_weaken_class_slot_value($name)
312 These methods return code snippets for inlining.
314 There's really no good reason for you to call these methods unless
315 you're doing some deep hacking. They are named as public methods
316 solely because they are used by other meta roles and classes in this
321 Dave Rolsky, C<< <autarch@urth.org> >>
325 See L<MooseX::ClassAttribute> for details.
327 =head1 COPYRIGHT & LICENSE
329 Copyright 2007-2008 Dave Rolsky, All Rights Reserved.
331 This program is free software; you can redistribute it and/or modify
332 it under the same terms as Perl itself.