X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FClass-MOP.git;a=blobdiff_plain;f=lib%2FClass%2FMOP%2FMethod%2FConstructor.pm;fp=lib%2FClass%2FMOP%2FMethod%2FConstructor.pm;h=56f38c5c0db4557b43c3f55480a347e26a6fb870;hp=05c8d925c62dd9f7c092794354468bab3e0d398b;hb=777b1f18dd34d5d656f15d14ce9836cfc9c2978f;hpb=15961c86cfd845e6f46b6c362cc1a4b94ffb45db diff --git a/lib/Class/MOP/Method/Constructor.pm b/lib/Class/MOP/Method/Constructor.pm index 05c8d92..56f38c5 100644 --- a/lib/Class/MOP/Method/Constructor.pm +++ b/lib/Class/MOP/Method/Constructor.pm @@ -97,38 +97,37 @@ sub _generate_constructor_method_inline { my $self = shift; my $defaults = [map { $_->default } @{ $self->_attributes }]; - my $close_over = { '$defaults' => \$defaults, }; - 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 . '\';'; - - $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 @source = ( + 'sub {', + 'my $class = shift;', + 'return Class::MOP::Class->initialize($class)->new_object(@_)', + 'if $class ne \'' . $meta->name . '\';', + 'my $params = @_ == 1 ? $_[0] : {@_};', + 'my $instance = ' . $meta->inline_create_instance('$class') . ';', + (map { $self->_generate_slot_initializer($_, $idx++) } + @{ $self->_attributes }), + $self->_preserve_weak_metaclasses, + 'return $instance', + '}', + ); + + warn join("\n", @source) if $self->options->{debug}; my $code = try { $self->_compile_code( - source => $source, + source => \@source, environment => $close_over, ); } catch { + my $source = join("\n", @source); confess "Could not eval the constructor :\n\n$source\n\nbecause :\n\n$_"; }; @@ -137,62 +136,73 @@ sub _generate_constructor_method_inline { sub _generate_slot_initializer { my $self = shift; - my $attr = shift; - my $idx = shift; + my ($attr, $idx) = @_; - my $default; - if ($attr->has_default) { - $default = $self->_generate_default_value($attr, $idx); - } elsif( $attr->has_builder ) { - $default = '$instance->'.$attr->builder; - } + my $default = $self->_generate_default_value($attr, $idx); - 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" . '}' - ) + if (defined(my $init_arg = $attr->init_arg)) { + my @source = ( + 'if (exists $params->{\'' . $init_arg . '\'}) {', + $attr->inline_set( + '$instance', '$params->{\'' . $init_arg . '\'}' + ) . ';', + '}', ); + if (defined $default) { + push @source, ( + 'else {', + $attr->inline_set('$instance', $default) . ';', + '}', + ); + } + return @source; } - elsif ( defined $default ) { + elsif (defined $default) { + return ($attr->inline_set('$instance', $default) . ';'); + } + else { + return (); + } +} + +sub _preserve_weak_metaclasses { + my $self = shift; + my $meta = $self->associated_metaclass; + if (Class::MOP::metaclass_is_weak($meta->name)) { return ( - $attr->inline_set( - '$instance', - $default - ) - . "\n" + $meta->_inline_set_mop_slot( + '$instance', 'Class::MOP::class_of($class)' + ) . ';' ); } else { - return ''; + return (); } } 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)'; + my $self = shift; + my ($attr, $index) = @_; + + 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) { + return '$defaults->[' . $index . ']->($instance)'; + } + else { + return '$defaults->[' . $index . ']'; + } + } + elsif ($attr->has_builder) { + return '$instance->' . $attr->builder; } else { - return '$defaults->[' . $index . ']'; + return; } }