X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FClassAttribute%2FRole%2FMeta%2FClass.pm;h=efa5d8a67d3740791682c3a9c885f03613794901;hb=7aab7f6c86e376ba82e20b9f342190d6bc104508;hp=e486b00c4c0f212b5011997e8b57708c9eb4251d;hpb=bb70fe3ad64b3a6061784a338ead11df88eb9367;p=gitmo%2FMooseX-ClassAttribute.git

diff --git a/lib/MooseX/ClassAttribute/Role/Meta/Class.pm b/lib/MooseX/ClassAttribute/Role/Meta/Class.pm
index e486b00..efa5d8a 100644
--- a/lib/MooseX/ClassAttribute/Role/Meta/Class.pm
+++ b/lib/MooseX/ClassAttribute/Role/Meta/Class.pm
@@ -4,6 +4,7 @@ use strict;
 use warnings;
 
 use MooseX::AttributeHelpers;
+use MooseX::ClassAttribute::Role::Meta::Attribute;
 use Scalar::Util qw( blessed );
 
 use Moose::Role;
@@ -12,7 +13,7 @@ use Moose::Role;
 has class_attribute_map =>
     ( metaclass => 'Collection::Hash',
       is        => 'ro',
-      isa       => 'HashRef[MooseX::ClassAttribute::Meta::Attribute]',
+      isa       => 'HashRef[Moose::Meta::Attribute]',
       provides  => { set    => '_add_class_attribute',
                      exists => 'has_class_attribute',
                      get    => 'get_class_attribute',
@@ -93,17 +94,13 @@ sub _process_new_class_attribute
     my $name = shift;
     my %p    = @_;
 
-    if ( $p{metaclass} )
+    if ( $p{traits} )
     {
-        $p{metaclass} =
-            Moose::Meta::Class->create_anon_class
-                ( superclasses => [ 'MooseX::ClassAttribute::Meta::Attribute', $p{metaclass} ],
-                  cache        => 1,
-                )->name();
+        push @{ $p{traits} },'MooseX::ClassAttribute::Role::Meta::Attribute'
     }
     else
     {
-        $p{metaclass} = 'MooseX::ClassAttribute::Meta::Attribute';
+        $p{traits} = [ 'MooseX::ClassAttribute::Role::Meta::Attribute' ];
     }
 
     return Moose::Meta::Attribute->interpolate_class_and_new( $name, %p );
@@ -152,7 +149,11 @@ sub compute_all_applicable_class_attributes
     my $self = shift;
 
     my %attrs =
-        map { %{ Class::MOP::Class->initialize($_)->get_class_attribute_map } }
+        map { my $meta = Class::MOP::Class->initialize($_);
+              $meta->can('get_class_attribute_map')
+              ? %{ $meta->get_class_attribute_map() }
+              : ()
+            }
         reverse $self->linearized_isa;
 
     return values %attrs;
@@ -168,7 +169,7 @@ sub find_class_attribute_by_name
         my $meta = Class::MOP::Class->initialize($class);
 
         return $meta->get_class_attribute($name)
-            if $meta->has_class_attribute($name);
+            if $meta->can('has_class_attribute') && $meta->has_class_attribute($name);
     }
 
     return;
@@ -194,7 +195,7 @@ sub inline_class_slot_access
     my $self = shift;
     my $name = shift;
 
-    return '$' . $self->_class_attribute_var_name . '{' . $name . '}';
+    return '$' . $self->_class_attribute_var_name . '{"' . quotemeta($name) . '"}';
 }
 
 sub inline_get_class_slot_value
@@ -241,3 +242,114 @@ sub inline_weaken_class_slot_value
 no Moose::Role;
 
 1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+MooseX::ClassAttribute::Role::Meta::Class - A metaclass role for classes with class attributes
+
+=head1 SYNOPSIS
+
+  for my $attr ( HasClassAttributes->meta()->get_all_class_attributes() )
+  {
+      print $attr->name();
+  }
+
+=head1 DESCRIPTION
+
+This role adds awareness of class attributes to a metaclass object. It
+provides a set of introspection methods that largely parallel the
+existing attribute methods, except they operate on class attributes.
+
+=head1 METHODS
+
+Every method provided by this role has an analogous method in
+C<Class::MOP::Class> or C<Moose::Meta::Class> for regular attributes.
+
+=head2 $meta->has_class_attribute($name)
+
+=head2 $meta->get_class_attribute($name)
+
+=head2 $meta->get_class_attribute_list()
+
+=head2 $meta->get_class_attribute_map()
+
+These methods operate on the current metaclass only.
+
+=head2 $meta->add_class_attribute(...)
+
+This accepts the same options as the L<Moose::Meta::Attribute>
+C<add_attribute()> method. However, if an attribute is specified as
+"required" an error will be thrown.
+
+=head2 $meta->remove_class_attribute($name)
+
+If the named class attribute exists, it is removed from the class,
+along with its accessor methods.
+
+=head2 $meta->get_all_class_attributes()
+
+=head2 $meta->compute_all_applicable_class_attributes()
+
+These methods return a list of attribute objects for the class and all
+its parent classes.
+
+=head2 $meta->find_class_attribute_by_name($name)
+
+This method looks at the class and all its parent classes for the
+named class attribute.
+
+=head2 $meta->get_class_attribute_value($name)
+
+=head2 $meta->set_class_attribute_value($name, $value)
+
+=head2 $meta->set_class_attribute_value($name)
+
+=head2 $meta->clear_class_attribute_value($name)
+
+These methods operate on the storage for class attribute values, which
+is attached to the metaclass object.
+
+There's really no good reason for you to call these methods unless
+you're doing some deep hacking. They are named as public methods
+solely because they are used by other meta roles and classes in this
+distribution.
+
+=head2 inline_class_slot_access($name)
+
+=head2 inline_get_class_slot_value($name)
+
+=head2 inline_set_class_slot_value($name, $val_name)
+
+=head2 inline_is_class_slot_initialized($name)
+
+=head2 inline_deinitialize_class_slot($name)
+
+=head2 inline_weaken_class_slot_value($name)
+
+These methods return code snippets for inlining.
+
+There's really no good reason for you to call these methods unless
+you're doing some deep hacking. They are named as public methods
+solely because they are used by other meta roles and classes in this
+distribution.
+
+=head1 AUTHOR
+
+Dave Rolsky, C<< <autarch@urth.org> >>
+
+=head1 BUGS
+
+See L<MooseX::ClassAttribute> for details.
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2007-2008 Dave Rolsky, All Rights Reserved.
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut