X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP%2FMethod%2FConstructor.pm;h=31392dde273df17b4411ffefbc6b9a7b40bb5bf9;hb=cc66fac6ef15584503dfcbc1953da2d58aad7989;hp=c1ac2b38b6a6daff3ca4c0099d10cdfce3750cee;hpb=812d58f9517c19217fd09da63a6a87d80c202f11;p=gitmo%2FClass-MOP.git

diff --git a/lib/Class/MOP/Method/Constructor.pm b/lib/Class/MOP/Method/Constructor.pm
index c1ac2b3..31392dd 100644
--- a/lib/Class/MOP/Method/Constructor.pm
+++ b/lib/Class/MOP/Method/Constructor.pm
@@ -5,9 +5,10 @@ use strict;
 use warnings;
 
 use Carp         'confess';
-use Scalar::Util 'blessed', 'weaken', 'looks_like_number';
+use Scalar::Util 'blessed', 'weaken';
+use Try::Tiny;
 
-our $VERSION   = '0.89';
+our $VERSION   = '1.11';
 $VERSION = eval $VERSION;
 our $AUTHORITY = 'cpan:STEVAN';
 
@@ -72,37 +73,16 @@ sub associated_metaclass { (shift)->{'associated_metaclass'} }
 
 ## cached values ...
 
-sub meta_instance {
-    Carp::cluck('The meta_instance method has been made private.'
-        . " The public version is deprecated and will be removed in a future release.\n");
-    shift->_meta_instance;
-}
-
-sub _meta_instance {
-    my $self = shift;
-    $self->{'meta_instance'} ||= $self->associated_metaclass->get_meta_instance;
-}
-
-sub attributes {
-    Carp::cluck('The attributes method has been made private.'
-        . " The public version is deprecated and will be removed in a future release.\n");
-
-    return shift->_attributes;
-}
-
 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
 
-sub initialize_body {
-    Carp::cluck('The initialize_body method has been made private.'
-        . " The public version is deprecated and will be removed in a future release.\n");
-    shift->_initialize_body;
-}
-
 sub _initialize_body {
     my $self        = shift;
     my $method_name = '_generate_constructor_method';
@@ -112,103 +92,40 @@ sub _initialize_body {
     $self->{'body'} = $self->$method_name;
 }
 
-sub generate_constructor_method {
-    Carp::cluck('The generate_constructor_method method has been made private.'
-        . " The public version is deprecated and will be removed in a future release.\n");
-    shift->_generate_constructor_method;
+sub _eval_environment {
+    my $self = shift;
+    my $defaults = [map { $_->default } @{ $self->_attributes }];
+    return {
+        '$defaults' => \$defaults,
+    };
 }
 
 sub _generate_constructor_method {
     return sub { Class::MOP::Class->initialize(shift)->new_object(@_) }
 }
 
-sub generate_constructor_method_inline {
-    Carp::cluck('The generate_constructor_method_inline method has been made private.'
-        . " The public version is deprecated and will be removed in a future release.\n");
-    shift->_generate_constructor_method_inline;
-}
-
 sub _generate_constructor_method_inline {
     my $self = shift;
 
-    my $close_over = {};
-
-    my $source = 'sub {';
-    $source .= "\n" . 'my $class = shift;';
-
-    $source .= "\n" . 'return Class::MOP::Class->initialize($class)->new_object(@_)';
-    $source .= "\n" . '    if $class ne \'' . $self->associated_metaclass->name . '\';';
+    my $meta = $self->associated_metaclass;
 
-    $source .= "\n" . 'my $params = @_ == 1 ? $_[0] : {@_};';
-
-    $source .= "\n" . 'my $instance = ' . $self->_meta_instance->inline_create_instance('$class');
-    $source .= ";\n" . (join ";\n" => map {
-        $self->_generate_slot_initializer($_, $close_over)
-    } @{ $self->_attributes });
-    $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;
-}
+    warn join("\n", @source) if $self->options->{debug};
 
-sub _generate_slot_initializer {
-    my $self  = shift;
-    my $attr  = shift;
-    my $close = shift;
-
-    my $default;
-    if ($attr->has_default) {
-        # 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) {
-            my $idx = @{$close->{'@defaults'}||=[]};
-            push(@{$close->{'@defaults'}}, $attr->default);
-            $default = '$defaults[' . $idx . ']->($instance)';
-        }
-        else {
-            $default = $attr->default;
-            # make sure to quote strings ...
-            unless (looks_like_number($default)) {
-                $default = "'$default'";
-            }
-        }
-    } elsif( $attr->has_builder ) {
-        $default = '$instance->'.$attr->builder;
+    my $code = try {
+        $self->_compile_code(\@source);
     }
+    catch {
+        my $source = join("\n", @source);
+        confess "Could not eval the constructor :\n\n$source\n\nbecause :\n\n$_";
+    };
 
-    if ( defined(my $init_arg = $attr->init_arg) ) {
-      return (
-          'if(exists $params->{\'' . $init_arg . '\'}){' . "\n" .
-                $self->_meta_instance->inline_set_slot_value(
-                    '$instance',
-                    $attr->name,
-                    '$params->{\'' . $init_arg . '\'}' ) . "\n" .
-           '} ' . (!defined $default ? '' : 'else {' . "\n" .
-                $self->_meta_instance->inline_set_slot_value(
-                    '$instance',
-                    $attr->name,
-                     $default ) . "\n" .
-           '}')
-        );
-    } elsif ( defined $default ) {
-        return (
-            $self->_meta_instance->inline_set_slot_value(
-                '$instance',
-                $attr->name,
-                 $default ) . "\n"
-        );
-    } else { return '' }
+    return $code;
 }
 
 1;
@@ -287,7 +204,7 @@ Stevan Little E<lt>stevan@iinteractive.comE<gt>
 
 =head1 COPYRIGHT AND LICENSE
 
-Copyright 2006-2009 by Infinity Interactive, Inc.
+Copyright 2006-2010 by Infinity Interactive, Inc.
 
 L<http://www.iinteractive.com>