1 package MooseX::ClassAttribute::Trait::Class;
8 use MooseX::ClassAttribute::Trait::Attribute;
9 use Scalar::Util qw( blessed );
11 use namespace::autoclean;
14 with 'MooseX::ClassAttribute::Trait::Mixin::HasClassAttributes';
16 has _class_attribute_values => (
21 'get_class_attribute_value' => 'get',
22 'set_class_attribute_value' => 'set',
23 'has_class_attribute_value' => 'exists',
24 'clear_class_attribute_value' => 'delete',
27 default => sub { $_[0]->_class_attribute_values_hashref() },
31 around add_class_attribute => sub {
35 blessed $_[0] && $_[0]->isa('Class::MOP::Attribute')
37 : $self->_process_class_attribute(@_)
45 sub _post_add_class_attribute {
49 my $name = $attr->name();
53 eval { $attr->install_accessors() };
58 $self->remove_attribute($name);
63 sub _attach_class_attribute {
64 my ($self, $attribute) = @_;
65 $attribute->attach_to_class($self);
68 # It'd be nice if I didn't have to replicate this for class
69 # attributes, since it's basically just a copy of
70 # Moose::Meta::Class->_process_attribute
71 sub _process_class_attribute {
76 @args = %{ $args[0] } if scalar @args == 1 && ref( $args[0] ) eq 'HASH';
78 if ( $name =~ /^\+(.*)/ ) {
79 return $self->_process_inherited_class_attribute( $1, @args );
82 return $self->_process_new_class_attribute( $name, @args );
86 sub _process_new_class_attribute {
92 push @{ $p{traits} }, 'MooseX::ClassAttribute::Trait::Attribute';
95 $p{traits} = ['MooseX::ClassAttribute::Trait::Attribute'];
98 return Moose::Meta::Attribute->interpolate_class_and_new( $name, %p );
101 sub _process_inherited_class_attribute {
106 my $inherited_attr = $self->find_class_attribute_by_name($name);
108 ( defined $inherited_attr )
110 "Could not find an attribute by the name of '$name' to inherit from";
112 return $inherited_attr->clone_and_inherit_options(%p);
115 around remove_class_attribute => sub {
119 my $removed_attr = $self->$orig(@_)
122 $removed_attr->remove_accessors();
123 $removed_attr->detach_from_class();
125 return $removed_attr;
128 sub get_all_class_attributes {
133 my $meta = Class::MOP::class_of($_);
134 $meta && $meta->can('_class_attribute_map')
135 ? %{ $meta->_class_attribute_map() }
138 reverse $self->linearized_isa;
140 return values %attrs;
143 sub compute_all_applicable_class_attributes {
145 'The compute_all_applicable_class_attributes method has been deprecated.'
146 . " Use get_all_class_attributes instead.\n";
148 shift->compute_all_applicable_class_attributes(@_);
151 sub find_class_attribute_by_name {
155 foreach my $class ( $self->linearized_isa() ) {
156 my $meta = Class::MOP::class_of($class)
159 return $meta->get_class_attribute($name)
160 if $meta->can('has_class_attribute')
161 && $meta->has_class_attribute($name);
167 sub _class_attribute_values_hashref {
171 return \%{ $self->_class_attribute_var_name() };
174 sub _class_attribute_var_name {
177 return $self->name() . q'::__ClassAttributeValues';
180 sub inline_class_slot_access {
186 . $self->_class_attribute_var_name . '{"'
187 . quotemeta($name) . '"}';
190 sub inline_get_class_slot_value {
194 return $self->inline_class_slot_access($name);
197 sub inline_set_class_slot_value {
200 my $val_name = shift;
202 return $self->inline_class_slot_access($name) . ' = ' . $val_name;
205 sub inline_is_class_slot_initialized {
209 return 'exists ' . $self->inline_class_slot_access($name);
212 sub inline_deinitialize_class_slot {
216 return 'delete ' . $self->inline_class_slot_access($name);
219 sub inline_weaken_class_slot_value {
224 'Scalar::Util::weaken( '
225 . $self->inline_class_slot_access($name) . ')';
236 MooseX::ClassAttribute::Trait::Class - A trait for classes with class attributes
240 for my $attr ( HasClassAttributes->meta()->get_all_class_attributes() )
247 This role adds awareness of class attributes to a metaclass object. It
248 provides a set of introspection methods that largely parallel the
249 existing attribute methods, except they operate on class attributes.
253 Every method provided by this role has an analogous method in
254 C<Class::MOP::Class> or C<Moose::Meta::Class> for regular attributes.
256 =head2 $meta->has_class_attribute($name)
258 =head2 $meta->get_class_attribute($name)
260 =head2 $meta->get_class_attribute_list()
262 These methods operate on the current metaclass only.
264 =head2 $meta->add_class_attribute(...)
266 This accepts the same options as the L<Moose::Meta::Attribute>
267 C<add_attribute()> method. However, if an attribute is specified as
268 "required" an error will be thrown.
270 =head2 $meta->remove_class_attribute($name)
272 If the named class attribute exists, it is removed from the class,
273 along with its accessor methods.
275 =head2 $meta->get_all_class_attributes()
277 This method returns a list of attribute objects for the class and all
280 =head2 $meta->find_class_attribute_by_name($name)
282 This method looks at the class and all its parent classes for the
283 named class attribute.
285 =head2 $meta->get_class_attribute_value($name)
287 =head2 $meta->set_class_attribute_value($name, $value)
289 =head2 $meta->set_class_attribute_value($name)
291 =head2 $meta->clear_class_attribute_value($name)
293 These methods operate on the storage for class attribute values, which
294 is attached to the metaclass object.
296 There's really no good reason for you to call these methods unless
297 you're doing some deep hacking. They are named as public methods
298 solely because they are used by other meta roles and classes in this
301 =head2 $meta->inline_class_slot_access($name)
303 =head2 $meta->inline_get_class_slot_value($name)
305 =head2 $meta->inline_set_class_slot_value($name, $val_name)
307 =head2 $meta->inline_is_class_slot_initialized($name)
309 =head2 $meta->inline_deinitialize_class_slot($name)
311 =head2 $meta->inline_weaken_class_slot_value($name)
313 These methods return code snippets for inlining.
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
322 Dave Rolsky, C<< <autarch@urth.org> >>
326 See L<MooseX::ClassAttribute> for details.
328 =head1 COPYRIGHT & LICENSE
330 Copyright 2007-2010 Dave Rolsky, All Rights Reserved.
332 This program is free software; you can redistribute it and/or modify
333 it under the same terms as Perl itself.