make the constructor a bit more extensible

[gitmo/Class-MOP.git] / lib / Class / MOP / Class.pm

diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index 983dd48..fbe64e4 100644 (file)
--- 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;