X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FMeta%2FMethod%2FConstructor.pm;h=9d8fc18204fa7d5e236abad958d054a738acb736;hb=a62dcd43575e3069a70277082c7be85fb71322bf;hp=d622ac59214482272da9bb67696118e365259bff;hpb=1aeb15481cdb866ee2e451a320619ffe591f2d19;p=gitmo%2FMoose.git

diff --git a/lib/Moose/Meta/Method/Constructor.pm b/lib/Moose/Meta/Method/Constructor.pm
index d622ac5..9d8fc18 100644
--- a/lib/Moose/Meta/Method/Constructor.pm
+++ b/lib/Moose/Meta/Method/Constructor.pm
@@ -6,7 +6,7 @@ use warnings;
 
 use Scalar::Util 'blessed', 'weaken', 'looks_like_number';
 
-our $VERSION   = '0.63';
+our $VERSION   = '0.71_01';
 our $AUTHORITY = 'cpan:STEVAN';
 
 use base 'Moose::Meta::Method',
@@ -117,7 +117,7 @@ sub associated_metaclass { (shift)->{'associated_metaclass'} }
 
 # this was changed in 0.41, but broke MooseX::Singleton, so try to catch
 # any other code using the original broken spelling
-sub intialize_body { Moose->throw_error("Please correct the spelling of 'intialize_body' to 'initialize_body'") }
+sub intialize_body { $_[0]->throw_error("Please correct the spelling of 'intialize_body' to 'initialize_body'") }
 
 sub initialize_body {
     my $self = shift;
@@ -142,42 +142,42 @@ sub initialize_body {
         $self->_generate_slot_initializer($_)
     } 0 .. (@{$self->attributes} - 1));
 
-    $source .= ";\n" . $self->_generate_triggers();    
+    $source .= ";\n" . $self->_generate_triggers();
     $source .= ";\n" . $self->_generate_BUILDALL();
 
     $source .= ";\n" . 'return $instance';
     $source .= ";\n" . '}';
     warn $source if $self->options->{debug};
 
-    my $code;
+    # We need to check if the attribute ->can('type_constraint')
+    # since we may be trying to immutabilize a Moose meta class,
+    # which in turn has attributes which are Class::MOP::Attribute
+    # objects, rather than Moose::Meta::Attribute. And
+    # Class::MOP::Attribute attributes have no type constraints.
+    # However we need to make sure we leave an undef value there
+    # because the inlined code is using the index of the attributes
+    # to determine where to find the type constraint
+
     my $attrs = $self->attributes;
-    my @type_constraints = map { 
+
+    my @type_constraints = map {
         $_->can('type_constraint') ? $_->type_constraint : undef
     } @$attrs;
-    my $environment = {
-
-        # lexicals for the scope within which we will be constructed
-
-        '$meta' => \$self, # FIXME for _inline_throw_error...
-        '$attrs' => \$attrs,
-
-        # We need to check if the attribute ->can('type_constraint')
-        # since we may be trying to immutabilize a Moose meta class,
-        # which in turn has attributes which are Class::MOP::Attribute
-        # objects, rather than Moose::Meta::Attribute. And 
-        # Class::MOP::Attribute attributes have no type constraints.
-        # However we need to make sure we leave an undef value there
-        # because the inlined code is using the index of the attributes
-        # to determine where to find the type constraint
-        
-        '@type_constraints' => \@type_constraints,
-        
-        '@type_constraint_bodies' => [ map {
-            defined $_ ? $_->_compiled_type_constraint : undef;
-        } @type_constraints ]
-    };
-    $code = $self->_eval_closure($environment, $source);
-    $self->throw_error("Could not eval the constructor :\n\n$source\n\nbecause :\n\n$@", error => $@, data => $source ) if $@;
+
+    my @type_constraint_bodies = map {
+        defined $_ ? $_->_compiled_type_constraint : undef;
+    } @type_constraints;
+
+    my $code = $self->_compile_code(
+        code => $source,
+        environment => {
+            '$meta'  => \$self,
+            '$attrs' => \$attrs,
+            '@type_constraints' => \@type_constraints,
+            '@type_constraint_bodies' => \@type_constraint_bodies,
+        },
+    ) or $self->throw_error("Could not eval the constructor :\n\n$source\n\nbecause :\n\n$@", error => $@, data => $source );
+    
     $self->{'body'} = $code;
 }
 
@@ -190,7 +190,7 @@ sub _generate_BUILDARGS {
         return join("\n",
             'do {',
             $self->_inline_throw_error('"Single parameters to new() must be a HASH ref"', 'data => $_[0]'),
-            '    if scalar @_ == 1 && defined $_[0] && ref($_[0]) ne q{HASH};',
+            '    if scalar @_ == 1 && !( defined $_[0] && ref $_[0] eq q{HASH} );',
             '(scalar @_ == 1) ? {%{$_[0]}} : {@_};',
             '}',
         );
@@ -221,8 +221,10 @@ sub _generate_triggers {
                     .       '$instance, ' 
                     .        $self->meta_instance->inline_get_slot_value(
                                  '$instance',
-                                 ("'" . $attr->name . "'")
+                                 $attr->name,
                              ) 
+                             . ', '
+                    .        '$attrs->[' . $i . ']'
                     .   ');'
                     ."\n}"
                 );
@@ -317,7 +319,7 @@ sub _generate_slot_assignment {
         $source = (
             $self->meta_instance->inline_set_slot_value(
                 '$instance',
-                ("'" . $attr->name . "'"),
+                $attr->name,
                 $value
             ) . ';'
         );        
@@ -330,7 +332,7 @@ sub _generate_slot_assignment {
             "\n" .
             $self->meta_instance->inline_weaken_slot_value(
                 '$instance',
-                ("'" . $attr->name . "'")
+                $attr->name
             ) .
             ' if ref ' . $value . ';'
         );
@@ -407,7 +409,7 @@ Moose::Meta::Method::Constructor - Method Meta Object for constructors
 =head1 DESCRIPTION
 
 This is a subclass of L<Class::MOP::Method> which handles
-constructing an approprate Constructor methods. This is primarily
+constructing an appropriate Constructor methods. This is primarily
 used in the making of immutable metaclasses, otherwise it is
 not particularly useful.
 
@@ -429,8 +431,6 @@ not particularly useful.
 
 =item B<associated_metaclass>
 
-=item B<can_be_inlined>
-
 =back
 
 =head1 AUTHORS
@@ -439,7 +439,7 @@ Stevan Little E<lt>stevan@iinteractive.comE<gt>
 
 =head1 COPYRIGHT AND LICENSE
 
-Copyright 2006-2008 by Infinity Interactive, Inc.
+Copyright 2006-2009 by Infinity Interactive, Inc.
 
 L<http://www.iinteractive.com>