use strict;
use warnings;
+our $VERSION = '0.01';
+
+use Moose ();
+use Carp 'confess';
+use Scalar::Util 'blessed';
+
+sub import {
+ shift;
+
+ my $policy = shift || return;
+
+ unless (Moose::_is_class_already_loaded($policy)) {
+ ($policy->require)
+ || confess "Could not load policy module '$policy' because : " . $UNIVERSAL::require::ERROR;
+ }
+
+ my $metaclass = 'Moose::Meta::Class';
+ $metaclass = $policy->metaclass if $policy->can('metaclass');
+
+ my %options;
+
+ $options{':attribute_metaclass'} = $policy->attribute_metaclass
+ if $policy->can('attribute_metaclass');
+
+ my $package = caller();
+
+ # create a meta object so we can install &meta
+ my $meta = $metaclass->initialize($package => %options);
+ $meta->add_method('meta' => sub {
+ # we must re-initialize so that it
+ # works as expected in subclasses,
+ # since metaclass instances are
+ # singletons, this is not really a
+ # big deal anyway.
+ $metaclass->initialize((blessed($_[0]) || $_[0]) => %options)
+ });
+}
+
1;
__END__
extends 'Moose::Meta::Attribute';
- before '_process_options' => sub {
+ sub _process_options {
my ($class, $name, $options) = @_;
if (exists $options->{is}) {
if ($options->{is} eq 'ro') {
}
delete $options->{is};
}
- };
+
+ $class->SUPER::_process_options($name, $options);
+ }
}
-
{
package My::Moose::Policy;
use constant attribute_metaclass => 'My::Moose::Meta::Attribute';
has 'bar' => (default => 'Foo::bar');
}
+isa_ok(Foo->meta, 'Moose::Meta::Class');
+is(Foo->meta->attribute_metaclass, 'My::Moose::Meta::Attribute', '... got our custom attr metaclass');
+
+isa_ok()
my $foo = Foo->new;
isa_ok($foo, 'Foo');