From 9804f05faf74e7ac3aabeb710c778e39d80c63b1 Mon Sep 17 00:00:00 2001
From: doy <doy@tozt.net>
Date: Thu, 16 Apr 2009 17:37:34 -0500
Subject: move the actual logic into the metaclass, rather than the sugar layer
 - should work fine just using Moose's extends now

---
 lib/MooseX/NonMoose/Meta/Role/Class.pm | 53 ++++++++++++++++++++++++++++++++++
 1 file changed, 53 insertions(+)

(limited to 'lib/MooseX/NonMoose')

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;
-- 
cgit v1.2.3-54-g00ecf