From: Stevan Little Date: Wed, 19 Apr 2006 20:50:02 +0000 (+0000) Subject: fixes X-Git-Tag: 0_05~17 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=590868a3b1abf3a280d3aff8682043fde74c6e1a;p=gitmo%2FMoose.git fixes --- diff --git a/Changes b/Changes index 9f02222..67be4f0 100644 --- a/Changes +++ b/Changes @@ -4,6 +4,10 @@ Revision history for Perl extension Moose * Moose - keywords are now exported with Sub::Exporter thanks to chansen for this commit + - has keyword now takes a 'metaclass' option + to support custom attribute meta-classes + on a per-attribute basis + - added tests for this * Moose::Role - keywords are now exported with Sub::Exporter diff --git a/lib/Moose.pm b/lib/Moose.pm index 483a487..ac35d37 100644 --- a/lib/Moose.pm +++ b/lib/Moose.pm @@ -42,16 +42,14 @@ use Moose::Util::TypeConstraints; $meta = $class->meta(); (blessed($meta) && $meta->isa('Moose::Meta::Class')) || confess "Whoops, not møøsey enough"; + ($meta->attribute_metaclass->isa('Moose::Meta::Attribute')) + || confess "Attribute metaclass must be a subclass of Moose::Meta::Attribute"; } else { - $meta = Moose::Meta::Class->initialize($class => ( - ':attribute_metaclass' => 'Moose::Meta::Attribute' - )); + $meta = Moose::Meta::Class->initialize($class); $meta->add_method('meta' => sub { # re-initialize so it inherits properly - Moose::Meta::Class->initialize($class => ( - ':attribute_metaclass' => 'Moose::Meta::Attribute' - )); + Moose::Meta::Class->initialize($class); }) } @@ -83,6 +81,9 @@ use Moose::Util::TypeConstraints; return subname 'Moose::has' => sub { my ($name, %options) = @_; if ($options{metaclass}) { + _load_all_classes($options{metaclass}); + ($options{metaclass}->isa('Moose::Meta::Attribute')) + || confess "Custom attribute metaclass must be a subclass of Moose::Meta::Attribute"; $meta->add_attribute($options{metaclass}->new($name, %options)); } else { diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm index e41d199..1c3ee1c 100644 --- a/lib/Moose/Meta/Class.pm +++ b/lib/Moose/Meta/Class.pm @@ -18,6 +18,14 @@ __PACKAGE__->meta->add_attribute('roles' => ( default => sub { [] } )); +sub initialize { + my $class = shift; + my $pkg = shift; + $class->SUPER::initialize($pkg, + ':attribute_metaclass' => 'Moose::Meta::Attribute', + @_); +} + sub add_role { my ($self, $role) = @_; (blessed($role) && $role->isa('Moose::Meta::Role')) @@ -184,6 +192,8 @@ to the L documentation. =over 4 +=item B + =item B We override this method to support the C attribute option. diff --git a/t/036_custom_attribute_metaclass.t b/t/036_custom_attribute_metaclass.t index aad1e00..eab082f 100644 --- a/t/036_custom_attribute_metaclass.t +++ b/t/036_custom_attribute_metaclass.t @@ -3,14 +3,14 @@ use strict; use warnings; -use Test::More tests => 10; +use Test::More tests => 11; use Test::Exception; BEGIN { use_ok('Moose'); } -{ +{ package Foo::Meta::Attribute; use strict; use warnings; @@ -47,3 +47,21 @@ 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 strict; + use warnings; + + use base 'Class::MOP::Attribute'; + + package Bar; + use strict; + use warnings; + use Moose; + + ::dies_ok { + has 'bar' => (metaclass => 'Bar::Meta::Attribute'); + } '... the attribute metaclass must be a subclass of Moose::Meta::Attribute'; +} +