From: Jesse Luehrs <doy@tozt.net>
Date: Thu, 11 Nov 2010 05:54:07 +0000 (-0600)
Subject: make the constructor a bit more extensible
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=939ec2879f2eef695c063d980c47ecf5c6437481;p=gitmo%2FClass-MOP.git

make the constructor a bit more extensible
---

diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index 983dd48..fbe64e4 100644
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -587,26 +587,65 @@ sub _construct_instance {
 sub _inline_new_object {
     my $self = shift;
 
-    my $idx = 0;
     return (
         'my $class = shift;',
-        'return Class::MOP::Class->initialize($class)->new_object(@_)',
-            'if $class ne \'' . $self->name . '\';',
-        'my $params = @_ == 1 ? $_[0] : {@_};',
-        'my $instance = ' . $self->_inline_create_instance('$class') . ';',
-        (map { $self->_inline_slot_initializer($_, $idx++) }
-             $self->get_all_attributes),
+        '$class = Scalar::Util::blessed($class) || $class;',
+        $self->_inline_fallback_constructor('$class'),
+        $self->_inline_params('$params', '$class'),
+        $self->_inline_generate_instance('$instance', '$class'),
+        $self->_inline_slot_initializers,
         $self->_inline_preserve_weak_metaclasses,
+        $self->_inline_extra_init,
         'return $instance',
     );
 }
 
+sub _inline_fallback_constructor {
+    my $self = shift;
+    my ($class) = @_;
+    return (
+        'return ' . $self->_generate_fallback_constructor($class),
+            'if ' . $class . ' ne \'' . $self->name . '\';',
+    );
+}
+
+sub _generate_fallback_constructor {
+    my $self = shift;
+    my ($class) = @_;
+    return 'Class::MOP::Class->initialize(' . $class . ')->new_object(@_)',
+}
+
+sub _inline_params {
+    my $self = shift;
+    my ($params, $class) = @_;
+    return (
+        'my ' . $params . ' = @_ == 1 ? $_[0] : {@_};',
+    );
+}
+
+sub _inline_generate_instance {
+    my $self = shift;
+    my ($inst, $class) = @_;
+    return (
+        'my ' . $inst . ' = ' . $self->_inline_create_instance($class) . ';',
+    );
+}
+
 sub _inline_create_instance {
     my $self = shift;
 
     return $self->get_meta_instance->inline_create_instance(@_);
 }
 
+sub _inline_slot_initializers {
+    my $self = shift;
+
+    my $idx = 0;
+
+    return map { $self->_inline_slot_initializer($_, $idx++) }
+               $self->get_all_attributes;
+}
+
 sub _inline_slot_initializer {
     my $self  = shift;
     my ($attr, $idx) = @_;
@@ -678,6 +717,8 @@ sub _inline_preserve_weak_metaclasses {
     }
 }
 
+sub _inline_extra_init { }
+
 
 sub get_meta_instance {
     my $self = shift;
diff --git a/t/010_self_introspection.t b/t/010_self_introspection.t
index 90d2f69..04efa2d 100644
--- a/t/010_self_introspection.t
+++ b/t/010_self_introspection.t
@@ -64,7 +64,9 @@ my @class_mop_class_methods = qw(
     create_meta_instance _create_meta_instance
     new_object clone_object
     _inline_new_object _inline_default_value _inline_preserve_weak_metaclasses
-    _inline_slot_initializer
+    _inline_slot_initializer _inline_extra_init _inline_fallback_constructor
+    _inline_generate_instance _inline_params _inline_slot_initializers
+    _generate_fallback_constructor
     construct_instance _construct_instance
     construct_class_instance _construct_class_instance
     clone_instance _clone_instance