From: Stevan Little Date: Thu, 5 Apr 2007 19:39:43 +0000 (+0000) Subject: adding metaclass alias stuff X-Git-Tag: 0_21~29 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c1935ade51be974ad39b76bbc9f55f0e6685d503;p=gitmo%2FMoose.git adding metaclass alias stuff --- diff --git a/Changes b/Changes index 6304094..2eb8e43 100644 --- a/Changes +++ b/Changes @@ -2,11 +2,11 @@ Revision history for Perl extension Moose 0.19 * Moose::Util::TypeConstraints - - type now supports messages as well + - 'type' now supports messages as well thanks to phaylon for finding this - added tests for this - - added list_all_type_constraints and - list_all_builtin_type_constraints + - added &list_all_type_constraints and + &list_all_builtin_type_constraints functions to facilitate introspection. * Moose::Meta::Attribute @@ -16,12 +16,19 @@ Revision history for Perl extension Moose things like &new) thanks to ashleyb for finding this - added tests and docs for this - - added the "documentation" attributes + - added the 'documentation' attributes so that you can actually document your attributes and inspect them through the meta-object. - added tests and docs for this + * Moose::Meta::Class + - when loading custom attribute metaclasses + it will first look in for the class in the + Moose::Meta::Attribute::Custom::$name, and + then default to just loading $name. + - added tests and docs for this + * Moose::Meta::TypeConstraint - type constraints now stringify to their names. - added test for this diff --git a/lib/Moose.pm b/lib/Moose.pm index 4de5436..553c7e3 100644 --- a/lib/Moose.pm +++ b/lib/Moose.pm @@ -424,6 +424,22 @@ If an attribute is marked as lazy it B have a default supplied. This tells the accessor whether to automatically dereference the value returned. This is only legal if your C option is either an C or C. +=item I $metaclass_name> + +This tells the class to use a custom attribute metaclass for this particular +attribute. Custom attribute metaclasses are useful for extending the capabilities +of the I keyword, they are the simplest way to extend the MOP, but they are +still a fairly advanced topic and too much to cover here. I will try and write a +recipe on it soon. + +The default behavior here is to just load C<$metaclass_name>, however, we also +have a way to alias to a shorter name. This will first look to see if +B exists, if it does it will +then check to see if that has the method C which +should return the actual name of the custom attribute metaclass. If there is +no C method, it will just default to using +B as the metaclass name. + =item I $code> The trigger option is a CODE reference which will be called after the value of diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm index 44cf326..3354d07 100644 --- a/lib/Moose/Meta/Class.pm +++ b/lib/Moose/Meta/Class.pm @@ -9,7 +9,7 @@ use Class::MOP; use Carp 'confess'; use Scalar::Util 'weaken', 'blessed', 'reftype'; -our $VERSION = '0.11'; +our $VERSION = '0.12'; our $AUTHORITY = 'cpan:STEVAN'; use Moose::Meta::Method::Overriden; @@ -275,8 +275,18 @@ sub _process_attribute { } else { if ($options{metaclass}) { - Class::MOP::load_class($options{metaclass}); - $self->add_attribute($options{metaclass}->new($name, %options)); + my $metaclass_name = $options{metaclass}; + eval { + my $possible_full_name = 'Moose::Meta::Attribute::Custom::' . $metaclass_name; + Class::MOP::load_class($possible_full_name); + $metaclass_name = $possible_full_name->can('register_implementation') + ? $possible_full_name->register_implementation + : $possible_full_name; + }; + if ($@) { + Class::MOP::load_class($metaclass_name); + } + $self->add_attribute($metaclass_name->new($name, %options)); } else { $self->add_attribute($name, %options); diff --git a/t/036_attribute_custom_metaclass.t b/t/036_attribute_custom_metaclass.t index 46cd8f0..a7b8bdb 100644 --- a/t/036_attribute_custom_metaclass.t +++ b/t/036_attribute_custom_metaclass.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 11; +use Test::More tests => 17; use Test::Exception; BEGIN { @@ -28,25 +28,25 @@ BEGIN { has 'foo' => (metaclass => 'Foo::Meta::Attribute'); } +{ + my $foo = Foo->new; + isa_ok($foo, 'Foo'); -my $foo = Foo->new; -isa_ok($foo, 'Foo'); - -my $foo_attr = Foo->meta->get_attribute('foo'); -isa_ok($foo_attr, 'Foo::Meta::Attribute'); -isa_ok($foo_attr, 'Moose::Meta::Attribute'); - -is($foo_attr->name, 'foo', '... got the right name for our meta-attribute'); -ok($foo_attr->has_accessor, '... our meta-attrubute created the accessor for us'); + my $foo_attr = Foo->meta->get_attribute('foo'); + isa_ok($foo_attr, 'Foo::Meta::Attribute'); + isa_ok($foo_attr, 'Moose::Meta::Attribute'); -ok($foo_attr->has_type_constraint, '... our meta-attrubute created the type_constraint for us'); + is($foo_attr->name, 'foo', '... got the right name for our meta-attribute'); + ok($foo_attr->has_accessor, '... our meta-attrubute created the accessor for us'); -my $foo_attr_type_constraint = $foo_attr->type_constraint; -isa_ok($foo_attr_type_constraint, 'Moose::Meta::TypeConstraint'); + ok($foo_attr->has_type_constraint, '... our meta-attrubute created the type_constraint for us'); -is($foo_attr_type_constraint->name, 'Foo', '... got the right type constraint name'); -is($foo_attr_type_constraint->parent->name, 'Object', '... got the right type constraint parent name'); + my $foo_attr_type_constraint = $foo_attr->type_constraint; + isa_ok($foo_attr_type_constraint, 'Moose::Meta::TypeConstraint'); + is($foo_attr_type_constraint->name, 'Foo', '... got the right type constraint name'); + is($foo_attr_type_constraint->parent->name, 'Object', '... got the right type constraint parent name'); +} { package Bar::Meta::Attribute; use Moose; @@ -61,3 +61,35 @@ is($foo_attr_type_constraint->parent->name, 'Object', '... got the right type co } '... the attribute metaclass need not be a Moose::Meta::Attribute as long as it behaves'; } +{ + package Moose::Meta::Attribute::Custom::Foo; + sub register_implementation { 'Foo::Meta::Attribute' } + + package Moose::Meta::Attribute::Custom::Bar; + use Moose; + + extends 'Moose::Meta::Attribute'; + + package Another::Foo; + use Moose; + + ::lives_ok { + has 'foo' => (metaclass => 'Foo'); + } '... the attribute metaclass alias worked correctly'; + + ::lives_ok { + has 'bar' => (metaclass => 'Bar'); + } '... the attribute metaclass alias worked correctly'; +} + +{ + my $foo_attr = Another::Foo->meta->get_attribute('foo'); + isa_ok($foo_attr, 'Foo::Meta::Attribute'); + isa_ok($foo_attr, 'Moose::Meta::Attribute'); + + my $bar_attr = Another::Foo->meta->get_attribute('bar'); + isa_ok($bar_attr, 'Moose::Meta::Attribute::Custom::Bar'); + isa_ok($bar_attr, 'Moose::Meta::Attribute'); +} + +