1 package MooseX::ClassAttribute::Role::Meta::Class;
6 use MooseX::AttributeHelpers;
7 use Scalar::Util qw( blessed );
12 has class_attribute_map =>
13 ( metaclass => 'Collection::Hash',
15 isa => 'HashRef[Moose::Meta::Attribute]',
16 provides => { set => '_add_class_attribute',
17 exists => 'has_class_attribute',
18 get => 'get_class_attribute',
19 delete => '_remove_class_attribute',
20 keys => 'get_class_attribute_list',
22 default => sub { {} },
23 reader => 'get_class_attribute_map',
26 has _class_attribute_values =>
27 ( metaclass => 'Collection::Hash',
30 provides => { get => 'get_class_attribute_value',
31 set => 'set_class_attribute_value',
32 exists => 'has_class_attribute_value',
33 delete => 'clear_class_attribute_value',
36 default => sub { $_[0]->_class_attribute_values_hashref() },
40 sub add_class_attribute
45 blessed $_[0] && $_[0]->isa('Class::MOP::Attribute')
47 : $self->_process_class_attribute(@_);
49 my $name = $attr->name();
51 $self->remove_class_attribute($name)
52 if $self->has_class_attribute($name);
54 $attr->attach_to_class($self);
56 $self->_add_class_attribute( $name => $attr );
58 my $e = do { local $@; eval { $attr->install_accessors() }; $@ };
62 $self->remove_attribute($name);
69 # It'd be nice if I didn't have to replicate this for class
70 # attributes, since it's basically just a copy of
71 # Moose::Meta::Class->_process_attribute
72 sub _process_class_attribute
78 @args = %{$args[0]} if scalar @args == 1 && ref($args[0]) eq 'HASH';
80 if ($name =~ /^\+(.*)/)
82 return $self->_process_inherited_class_attribute( $1, @args );
86 return $self->_process_new_class_attribute( $name, @args );
90 sub _process_new_class_attribute
98 push @{ $p{traits} },'MooseX::ClassAttribute::Role::Meta::Attribute'
102 $p{traits} = [ 'MooseX::ClassAttribute::Role::Meta::Attribute' ];
105 return Moose::Meta::Attribute->interpolate_class_and_new( $name, %p );
108 sub _process_inherited_class_attribute
114 my $inherited_attr = $self->find_class_attribute_by_name($name);
116 (defined $inherited_attr)
117 || confess "Could not find an attribute by the name of '$name' to inherit from";
119 return $inherited_attr->clone_and_inherit_options(%p);
122 sub remove_class_attribute
127 (defined $name && $name)
128 || confess 'You must provide an attribute name';
130 my $removed_attr = $self->get_class_attribute($name);
131 return unless $removed_attr;
133 $self->_remove_class_attribute($name);
135 $removed_attr->remove_accessors();
136 $removed_attr->detach_from_class();
138 return $removed_attr;
141 sub get_all_class_attributes
143 shift->compute_all_applicable_class_attributes(@_);
146 sub compute_all_applicable_class_attributes
151 map { my $meta = Class::MOP::Class->initialize($_);
152 $meta->can('get_class_attribute_map')
153 ? %{ $meta->get_class_attribute_map() }
156 reverse $self->linearized_isa;
158 return values %attrs;
161 sub find_class_attribute_by_name
166 foreach my $class ( $self->linearized_isa() )
168 my $meta = Class::MOP::Class->initialize($class);
170 return $meta->get_class_attribute($name)
171 if $meta->can('has_class_attribute') && $meta->has_class_attribute($name);
177 sub _class_attribute_values_hashref
182 return \%{ $self->_class_attribute_var_name() };
185 sub _class_attribute_var_name
189 return $self->name() . q'::__ClassAttributeValues';
192 sub inline_class_slot_access
197 return '$' . $self->_class_attribute_var_name . '{' . $name . '}';
200 sub inline_get_class_slot_value
205 return $self->inline_class_slot_access($name);
208 sub inline_set_class_slot_value
212 my $val_name = shift;
214 return $self->inline_class_slot_access($name) . ' = ' . $val_name;
217 sub inline_is_class_slot_initialized
222 return 'exists ' . $self->inline_class_slot_access($name);
225 sub inline_deinitialize_class_slot
230 return 'delete ' . $self->inline_class_slot_access($name);
233 sub inline_weaken_class_slot_value
238 return 'Scalar::Util::weaken( ' . $self->inline_class_slot_access($name) . ')';
251 MooseX::ClassAttribute::Role::Meta::Class - A metaclass role for classes with class attributes
255 for my $attr ( HasClassAttributes->meta()->get_all_class_attributes() )
262 This role adds awareness of class attributes to a metaclass object. It
263 provides a set of introspection methods that largely parallel the
264 existing attribute methods, except they operate on class attributes.
268 Every method provided by this role has an analogous method in
269 C<Class::MOP::Class> or C<Moose::Meta::Class> for regular attributes.
271 =head2 $meta->has_class_attribute($name)
273 =head2 $meta->get_class_attribute($name)
275 =head2 $meta->get_class_attribute_list()
277 =head2 $meta->get_class_attribute_map()
279 These methods operate on the current metaclass only.
281 =head2 $meta->add_class_attribute(...)
283 This accepts the same options as the L<Moose::Meta::Attribute>
284 C<add_attribute()> method. However, if an attribute is specified as
285 "required" an error will be thrown.
287 =head2 $meta->remove_class_attribute($name)
289 If the named class attribute exists, it is removed from the class,
290 along with its accessor methods.
292 =head2 $meta->get_all_class_attributes()
294 =head2 $meta->compute_all_applicable_class_attributes()
296 These methods return a list of attribute objects for the class and all
299 =head2 $meta->find_class_attribute_by_name($name)
301 This method looks at the class and all its parent classes for the
302 named class attribute.
304 =head2 $meta->get_class_attribute_value($name)
306 =head2 $meta->set_class_attribute_value($name, $value)
308 =head2 $meta->set_class_attribute_value($name)
310 =head2 $meta->clear_class_attribute_value($name)
312 These methods operate on the storage for class attribute values, which
313 is attached to the metaclass object.
315 There's really no good reason for you to call these methods unless
316 you're doing some deep hacking. They are named as public methods
317 solely because they are used by other meta roles and classes in this
320 =head2 inline_class_slot_access($name)
322 =head2 inline_get_class_slot_value($name)
324 =head2 inline_set_class_slot_value($name, $val_name)
326 =head2 inline_is_class_slot_initialized($name)
328 =head2 inline_deinitialize_class_slot($name)
330 =head2 inline_weaken_class_slot_value($name)
332 These methods return code snippets for inlining.
334 There's really no good reason for you to call these methods unless
335 you're doing some deep hacking. They are named as public methods
336 solely because they are used by other meta roles and classes in this
341 Dave Rolsky, C<< <autarch@urth.org> >>
345 See L<MooseX::ClassAttribute> for details.
347 =head1 COPYRIGHT & LICENSE
349 Copyright 2007-2008 Dave Rolsky, All Rights Reserved.
351 This program is free software; you can redistribute it and/or modify
352 it under the same terms as Perl itself.