diff options
author | doy <doy@tozt.net> | 2009-04-16 17:37:34 -0500 |
---|---|---|
committer | doy <doy@tozt.net> | 2009-04-16 17:37:34 -0500 |
commit | 9804f05faf74e7ac3aabeb710c778e39d80c63b1 (patch) | |
tree | 8925a1abb73adce1d82240cfbc349fe2372fd1da /lib/MooseX/NonMoose | |
parent | e334c4262d204730348fbc27e287d42d904d4624 (diff) | |
download | moosex-nonmoose-9804f05faf74e7ac3aabeb710c778e39d80c63b1.tar.gz moosex-nonmoose-9804f05faf74e7ac3aabeb710c778e39d80c63b1.zip |
move the actual logic into the metaclass, rather than the sugar layer - should work fine just using Moose's extends now
Diffstat (limited to 'lib/MooseX/NonMoose')
-rw-r--r-- | lib/MooseX/NonMoose/Meta/Role/Class.pm | 53 |
1 files changed, 53 insertions, 0 deletions
diff --git a/lib/MooseX/NonMoose/Meta/Role/Class.pm b/lib/MooseX/NonMoose/Meta/Role/Class.pm index 8195b4a..b27091a 100644 --- a/lib/MooseX/NonMoose/Meta/Role/Class.pm +++ b/lib/MooseX/NonMoose/Meta/Role/Class.pm @@ -15,6 +15,59 @@ around _make_immutable_transformer => sub { $self->$orig(@args); }; +around superclasses => sub { + my $orig = shift; + my $self = shift; + + return $self->$orig unless @_; + + my @superclasses = @_; + push @superclasses, 'Moose::Object' + unless grep { $_->isa('Moose::Object') } @superclasses; + + my @ret = $self->$orig(@superclasses); + + # we need to get the non-moose constructor from the superclass + # of the class where this method actually exists, regardless of what class + # we're calling it on + # XXX: get constructor name from the constructor metaclass? + my $super_new = $self->find_next_method_by_name('new'); + + # if we're trying to extend a (non-immutable) moose class, just do nothing + return @ret if $super_new->package_name eq 'Moose::Object'; + + if ($super_new->associated_metaclass->can('constructor_class')) { + my $constructor_class_meta = Class::MOP::Class->initialize( + $super_new->associated_metaclass->constructor_class + ); + + # if the constructor we're inheriting is already one of ours, there's + # no reason to install a new one + return @ret if $constructor_class_meta->can('does_role') + && $constructor_class_meta->does_role('MooseX::NonMoose::Meta::Role::Constructor'); + + # if the constructor we're inheriting is an inlined version of the + # default moose constructor, don't do anything either + return @ret if $constructor_class_meta->name eq 'Moose::Meta::Method::Constructor'; + } + + $self->add_method(new => sub { + my $class = shift; + + my $params = $class->BUILDARGS(@_); + my $instance = $super_new->execute($class, @_); + my $self = Class::MOP::Class->initialize($class)->new_object( + __INSTANCE__ => $instance, + %$params, + ); + $self->BUILDALL($params); + return $self; + }); + $self->replace_constructor(1); + + return @ret; +}; + no Moose::Role; 1; |