Merge branch 'stable'

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

diff --git a/lib/Class/MOP/Method/Constructor.pm b/lib/Class/MOP/Method/Constructor.pm
index 3eb342f..29017ed 100644 (file)
--- a/lib/Class/MOP/Method/Constructor.pm
+++ b/lib/Class/MOP/Method/Constructor.pm
@@ -6,6 +6,7 @@ use warnings;
 
 use Carp         'confess';
 use Scalar::Util 'blessed', 'weaken';
+use Try::Tiny;
 
 our $VERSION   = '1.12';
 $VERSION = eval $VERSION;
@@ -74,7 +75,10 @@ sub associated_metaclass { (shift)->{'associated_metaclass'} }
 
 sub _attributes {
     my $self = shift;
-    $self->{'attributes'} ||= [ $self->associated_metaclass->get_all_attributes ]
+    $self->{'attributes'} ||= [
+        sort { $a->name cmp $b->name }
+             $self->associated_metaclass->get_all_attributes
+    ]
 }
 
 ## method
@@ -88,107 +92,40 @@ sub _initialize_body {
     $self->{'body'} = $self->$method_name;
 }
 
-sub _generate_constructor_method {
-    return sub { Class::MOP::Class->initialize(shift)->new_object(@_) }
-}
-
-sub _generate_constructor_method_inline {
+sub _eval_environment {
     my $self = shift;
-
     my $defaults = [map { $_->default } @{ $self->_attributes }];
-
-    my $close_over = {
+    return {
         '$defaults' => \$defaults,
     };
+}
 
-    my $source = 'sub {';
-    $source .= "\n" . 'my $class = shift;';
+sub _generate_constructor_method {
+    return sub { Class::MOP::Class->initialize(shift)->new_object(@_) }
+}
 
-    $source .= "\n" . 'return Class::MOP::Class->initialize($class)->new_object(@_)';
-    $source .= "\n" . '    if $class ne \'' . $self->associated_metaclass->name . '\';';
+sub _generate_constructor_method_inline {
+    my $self = shift;
 
-    $source .= "\n" . 'my $params = @_ == 1 ? $_[0] : {@_};';
+    my $meta = $self->associated_metaclass;
 
-    $source .= "\n" . 'my $instance = ' . $self->associated_metaclass->inline_create_instance('$class');
-    my $idx = 0;
-    $source .= ";\n" . (join ";\n" => map {
-        $self->_generate_slot_initializer($_, $idx++)
-    } @{ $self->_attributes });
-    if (Class::MOP::metaclass_is_weak($self->associated_metaclass->name)) {
-        $source .= ";\n" . $self->associated_metaclass->_inline_set_mop_slot('$instance', 'Class::MOP::class_of($class)');
-    }
-    $source .= ";\n" . 'return $instance';
-    $source .= ";\n" . '}';
-    warn $source if $self->options->{debug};
-
-    my ( $code, $e ) = $self->_eval_closure(
-        $close_over,
-        $source
+    my @source = (
+        'sub {',
+            $meta->_inline_new_object,
+        '}',
     );
-    confess "Could not eval the constructor :\n\n$source\n\nbecause :\n\n$e" if $e;
-
-    return $code;
-}
 
-sub _generate_slot_initializer {
-    my $self  = shift;
-    my $attr  = shift;
-    my $idx   = shift;
+    warn join("\n", @source) if $self->options->{debug};
 
-    my $default;
-    if ($attr->has_default) {
-        $default = $self->_generate_default_value($attr, $idx);
-    } elsif( $attr->has_builder ) {
-        $default = '$instance->'.$attr->builder;
-    }
-
-    if ( defined( my $init_arg = $attr->init_arg ) ) {
-        return (
-                  'if(exists $params->{\'' 
-                . $init_arg . '\'}){' . "\n"
-                . $attr->inline_set(
-                '$instance',
-                '$params->{\'' . $init_arg . '\'}'
-                )
-                . "\n" . '} '
-                . (
-                !defined $default ? '' : 'else {' . "\n"
-                    . $attr->inline_set(
-                    '$instance',
-                    $default
-                    )
-                    . "\n" . '}'
-                )
-        );
-    }
-    elsif ( defined $default ) {
-        return (
-            $attr->inline_set(
-                '$instance',
-                $default
-                )
-                . "\n"
-        );
+    my $code = try {
+        $self->_compile_code(\@source);
     }
-    else {
-        return '';
-    }
-}
+    catch {
+        my $source = join("\n", @source);
+        confess "Could not eval the constructor :\n\n$source\n\nbecause :\n\n$_";
+    };
 
-sub _generate_default_value {
-    my ($self, $attr, $index) = @_;
-    # NOTE:
-    # default values can either be CODE refs
-    # in which case we need to call them. Or
-    # they can be scalars (strings/numbers)
-    # in which case we can just deal with them
-    # in the code we eval.
-    if ($attr->is_default_a_coderef) {
-        return '$defaults->[' . $index . ']->($instance)';
-    }
-    else {
-        return '$defaults->[' . $index . ']';
-    }
+    return $code;
 }
 
 1;