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.pm | |
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.pm')
-rw-r--r-- | lib/MooseX/NonMoose.pm | 55 |
1 files changed, 1 insertions, 54 deletions
diff --git a/lib/MooseX/NonMoose.pm b/lib/MooseX/NonMoose.pm index 55bbbc9..ee57c37 100644 --- a/lib/MooseX/NonMoose.pm +++ b/lib/MooseX/NonMoose.pm @@ -2,60 +2,7 @@ package MooseX::NonMoose; use Moose (); use Moose::Exporter; -Moose::Exporter->setup_import_methods( - with_caller => ['extends'], -); - -sub extends { - my $caller = shift; - - Moose->throw_error("Must derive at least one class") unless @_; - - my @superclasses = @_; - push @superclasses, 'Moose::Object' - unless grep { $_->isa('Moose::Object') } @superclasses; - - my $caller_meta = Moose::Meta::Class->initialize($caller); - $caller_meta->superclasses(@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 = $caller_meta->find_next_method_by_name('new'); - - # if we're trying to extend a (non-immutable) moose class, just do nothing - return 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 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 if $constructor_class_meta->name eq 'Moose::Meta::Method::Constructor'; - } - - $caller_meta->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; - }); - $caller_meta->replace_constructor(1); -} +Moose::Exporter->setup_import_methods; sub init_meta { shift; |