X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FMethod%2FConstructor.pm;h=4b5e0994c93ba11f85712b81fd79324bab8d0c86;hp=13c4ad04c2d8b8c1daed5f76ea77eed0a409aa8e;hb=b4160dbe7bdfeacc3f559cf3eb9b792a5794a62b;hpb=c91862e86b5fb86424cef0d43d0731aaf9662e8e diff --git a/lib/Mouse/Meta/Method/Constructor.pm b/lib/Mouse/Meta/Method/Constructor.pm index 13c4ad0..4b5e099 100644 --- a/lib/Mouse/Meta/Method/Constructor.pm +++ b/lib/Mouse/Meta/Method/Constructor.pm @@ -5,7 +5,7 @@ use warnings; sub generate_constructor_method_inline { my ($class, $meta) = @_; - my @attrs = $meta->compute_all_applicable_attributes; # this one is using by evaled code + my @attrs = $meta->compute_all_applicable_attributes; my $buildall = $class->_generate_BUILDALL($meta); my $buildargs = $class->_generate_BUILDARGS(); my $processattrs = $class->_generate_processattrs($meta, \@attrs); @@ -21,8 +21,6 @@ sub generate_constructor_method_inline { } ... - warn $code if $ENV{DEBUG}; - local $@; my $res = eval $code; die $@ if $@; @@ -32,83 +30,97 @@ sub generate_constructor_method_inline { sub _generate_processattrs { my ($class, $meta, $attrs) = @_; my @res; - for my $index (0..scalar(@$attrs)-1) { + + for my $index (0 .. @$attrs - 1) { my $attr = $attrs->[$index]; - my $from = $attr->init_arg; my $key = $attr->name; + my $code = ''; - my $part1 = do { - my @code; + if (defined $attr->init_arg) { + my $from = $attr->init_arg; - push @code, "my \$value = \$args->{'$from'};"; + $code .= "if (exists \$args->{'$from'}) {\n"; - if ($attr->should_coerce) { - push @code, "\$value = \$attr->coerce_constraint( \$value );"; + if ($attr->should_coerce && $attr->type_constraint) { + $code .= "my \$value = Mouse::TypeRegistry->typecast_constraints('".$attr->associated_class->name."', \$attrs[$index]->{find_type_constraint}, \$attrs[$index]->{type_constraint}, \$args->{'$from'});"; + } + else { + $code .= "my \$value = \$args->{'$from'};"; } if ($attr->has_type_constraint) { - push @code, "\$attr->verify_type_constraint( \$value );"; + $code .= "{local \$_ = \$value; unless (\$attrs[$index]->{find_type_constraint}->(\$_)) {"; + $code .= "\$attrs[$index]->verify_type_constraint_error('$key', \$_, \$attrs[$index]->type_constraint)}}"; } - push @code, "\$instance->{'$key'} = \$value;"; + $code .= "\$instance->{'$key'} = \$value;"; if ($attr->is_weak_ref) { - push @code, "weaken( \$instance->{'$key'} ) if ref( \$value );"; + $code .= "Scalar::Util::weaken( \$instance->{'$key'} ) if ref( \$value );"; } - if ( $attr->has_trigger ) { - push @code, "\$attr->trigger->( \$instance, \$value, \$attr );"; + if ($attr->has_trigger) { + $code .= "\$attrs[$index]->{trigger}->( \$instance, \$value, \$attrs[$index] );"; } - join "\n", @code; - }; + $code .= "} else {"; + } + + if ($attr->has_default || $attr->has_builder) { + unless ($attr->is_lazy) { + my $default = $attr->default; + my $builder = $attr->builder; + + $code .= "my \$value = "; + + if ($attr->should_coerce && $attr->type_constraint) { + $code .= "Mouse::TypeRegistry->typecast_constraints('".$attr->associated_class->name."', \$attrs[$index]->{find_type_constraint}, \$attrs[$index]->{type_constraint}, "; + } - my $part2 = do { - my @code; - if ( $attr->has_default || $attr->has_builder ) { - unless ( $attr->is_lazy ) { - my $default = $attr->default; - my $builder = $attr->builder; if ($attr->has_builder) { - push @code, "my \$value = \$instance->$builder;"; - } elsif (ref($default) eq 'CODE') { - push @code, "my \$value = \$attr->default()->();"; - } else { - push @code, "my \$value = \$attr->default();"; + $code .= "\$instance->$builder"; } - if ($attr->should_coerce) { - push @code, "\$value = \$attr->coerce_constraint(\$value);"; + elsif (ref($default) eq 'CODE') { + $code .= "\$attrs[$index]->{default}->(\$instance)"; } - if ($attr->has_type_constraint) { - push @code, "\$attr->verify_type_constraint(\$value);"; + elsif (!defined($default)) { + $code .= 'undef'; } - push @code, "\$instance->{'$key'} = \$value;"; - if ($attr->is_weak_ref) { - push @code, "weaken( \$instance->{'$key'} ) if ref( \$instance->{'$key'} );"; + elsif ($default =~ /^\-?[0-9]+(?:\.[0-9]+)$/) { + $code .= $default; } + else { + $code .= "'$default'"; + } + + if ($attr->should_coerce) { + $code .= ");"; } - join "\n", @code; - } - else { - if ( $attr->is_required ) { - qq{Carp::confess("Attribute ($key) is required");}; - } else { - "" + else { + $code .= ";"; } - } - }; - my $code = <<"..."; - { - my \$attr = \$attrs[$index]; - if (exists(\$args->{'$from'})) { - $part1; - } else { - $part2; + + if ($attr->has_type_constraint) { + $code .= "{local \$_ = \$value; unless (\$attrs[$index]->{find_type_constraint}->(\$_)) {"; + $code .= "\$attrs[$index]->verify_type_constraint_error('$key', \$_, \$attrs[$index]->type_constraint)}}"; + } + + $code .= "\$instance->{'$key'} = \$value;"; + + if ($attr->is_weak_ref) { + $code .= "Scalar::Util::weaken( \$instance->{'$key'} ) if ref( \$value );"; } } -... + } + elsif ($attr->is_required) { + $code .= qq{Carp::confess("Attribute ($key) is required");}; + } + + $code .= "}" if defined $attr->init_arg; + push @res, $code; } + return join "\n", @res; } @@ -140,9 +152,9 @@ sub _generate_BUILDALL { push @code, q{no strict 'refs';}; push @code, q{no warnings 'once';}; no strict 'refs'; - for my $class ($meta->linearized_isa) { - if (*{ $class . '::BUILD' }{CODE}) { - push @code, qq{${class}::BUILD->(\$instance, \$args);}; + for my $klass ($meta->linearized_isa) { + if (*{ $klass . '::BUILD' }{CODE}) { + push @code, qq{${klass}::BUILD(\$instance, \$args);}; } } return join "\n", @code;