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.pm                 | 55 +---------------------------------
 lib/MooseX/NonMoose/Meta/Role/Class.pm | 53 ++++++++++++++++++++++++++++++++
 2 files changed, 54 insertions(+), 54 deletions(-)

(limited to 'lib')

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;
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