From: Ash Berlin <ash_github@firemirror.com>
Date: Fri, 20 Mar 2009 20:17:45 +0000 (+0000)
Subject: Make Meta::Method::Constructor easier to subclass
X-Git-Tag: 0.72_01~63^2~1
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ac070e13fc31a98410cc1a5c6d1b01bb720f6ec6;p=gitmo%2FMoose.git

Make Meta::Method::Constructor easier to subclass
---

diff --git a/Changes b/Changes
index 5ae8e64..541d2a4 100644
--- a/Changes
+++ b/Changes
@@ -16,6 +16,9 @@ Revision history for Perl extension Moose
     * Moose::Cookbook::Basics::Recipe9
       - Link to this recipe from Moose.pm's builder blurb
 
+    * Moose::Meta::Method::Constructor
+      - Make it easier to subclass the inlining behaviour
+
 0.72 Mon, February 23, 2009
     * Moose::Object
     * Moose::Meta::Method::Constructor
diff --git a/lib/Moose/Meta/Method/Constructor.pm b/lib/Moose/Meta/Method/Constructor.pm
index e1a8bb9..66eff82 100644
--- a/lib/Moose/Meta/Method/Constructor.pm
+++ b/lib/Moose/Meta/Method/Constructor.pm
@@ -122,6 +122,24 @@ sub associated_metaclass { (shift)->{'associated_metaclass'} }
 # any other code using the original broken spelling
 sub intialize_body { $_[0]->throw_error("Please correct the spelling of 'intialize_body' to 'initialize_body'") }
 
+sub _generate_params {
+  my ($self, $var, $class_var) = @_;
+  "my $var = " . $self->_generate_BUILDARGS($class_var, '@_') . ";\n";
+}
+
+sub _generate_instance {
+  my ($self, $var, $class_var) = @_;
+  "my $var = " . $self->meta_instance->inline_create_instance($class_var) 
+               . ";\n";
+}
+
+sub _generate_slot_initializers {
+    my ($self) = @_;
+    return (join ";\n" => map {
+        $self->_generate_slot_initializer($_)
+    } 0 .. (@{$self->attributes} - 1)) . ";\n";
+}
+
 sub initialize_body {
     my $self = shift;
     # TODO:
@@ -135,20 +153,17 @@ sub initialize_body {
     $source .= "\n" . 'my $class = shift;';
 
     $source .= "\n" . 'return $class->Moose::Object::new(@_)';
-    $source .= "\n" . '    if $class ne \'' . $self->associated_metaclass->name . '\';';
-
-    $source .= "\n" . 'my $params = ' . $self->_generate_BUILDARGS('$class', '@_');
+    $source .= "\n    if \$class ne '" . $self->associated_metaclass->name 
+            .  "';\n";
 
-    $source .= ";\n" . 'my $instance = ' . $self->meta_instance->inline_create_instance('$class');
-
-    $source .= ";\n" . (join ";\n" => map {
-        $self->_generate_slot_initializer($_)
-    } 0 .. (@{$self->attributes} - 1));
+    $source .= $self->_generate_params('$params', '$class');
+    $source .= $self->_generate_instance('$instance', '$class');
+    $source .= $self->_generate_slot_initializers;
 
-    $source .= ";\n" . $self->_generate_triggers();
+    $source .= $self->_generate_triggers();
     $source .= ";\n" . $self->_generate_BUILDALL();
 
-    $source .= ";\n" . 'return $instance';
+    $source .= ";\nreturn \$instance";
     $source .= ";\n" . '}';
     warn $source if $self->options->{debug};