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=83bf3efd82e06f0241ead220f4ec30e99cd81d5c;hp=b1db7d4bb471187b12ad1e29d54b2b4b6023d712;hb=6d46df7af00723bd7a0972abf5e5d62481ff6435;hpb=24ad3f66c198a2cad61e0d7c91c956b1926746f9 diff --git a/lib/Mouse/Meta/Method/Constructor.pm b/lib/Mouse/Meta/Method/Constructor.pm index b1db7d4..83bf3ef 100644 --- a/lib/Mouse/Meta/Method/Constructor.pm +++ b/lib/Mouse/Meta/Method/Constructor.pm @@ -5,9 +5,10 @@ use warnings; sub generate_constructor_method_inline { my ($class, $meta) = @_; + my @attrs = $meta->compute_all_applicable_attributes; my $buildall = $class->_generate_BUILDALL($meta); my $buildargs = $class->_generate_BUILDARGS(); - my $processattrs = $class->_generate_processattrs($meta); + my $processattrs = $class->_generate_processattrs($meta, \@attrs); my $code = <<"..."; sub { @@ -20,8 +21,6 @@ sub generate_constructor_method_inline { } ... - warn $code if $ENV{DEBUG}; - local $@; my $res = eval $code; die $@ if $@; @@ -29,58 +28,93 @@ sub generate_constructor_method_inline { } sub _generate_processattrs { - my ($class, $meta, ) = @_; - my @attrs = $meta->compute_all_applicable_attributes; + my ($class, $meta, $attrs) = @_; my @res; - for my $attr (@attrs) { + for my $index (0..scalar(@$attrs)-1) { + my $attr = $attrs->[$index]; my $from = $attr->init_arg; my $key = $attr->name; - my $part1 = do { + + my $set_value = do { my @code; - if ($attr->should_coerce) { - push @code, "\$args->{\$from} = \$attr->coerce_constraint( \$args->{\$from} );"; + + if ($attr->should_coerce && $attr->type_constraint) { + push @code, "my \$value = Mouse::TypeRegistry->typecast_constraints('".$attr->associated_class->name."', \$attrs[$index]->{find_type_constraint}, \$attrs[$index]->{type_constraint}, \$args->{'$from'});"; + } + else { + push @code, "my \$value = \$args->{'$from'};"; } + if ($attr->has_type_constraint) { - push @code, "\$attr->verify_type_constraint( \$args->{\$from} );"; + push @code, "{local \$_ = \$value; unless (\$attrs[$index]->{find_type_constraint}->(\$_)) {"; + push @code, "\$attrs[$index]->verify_type_constraint_error('$key', \$_, \$attrs[$index]->type_constraint)}}"; } - push @code, "\$instance->{\$key} = \$args->{\$from};"; + + push @code, "\$instance->{'$key'} = \$value;"; + if ($attr->is_weak_ref) { - push @code, "weaken( \$instance->{\$key} ) if ref( \$instance->{\$key} );"; + push @code, "Scalar::Util::weaken( \$instance->{'$key'} ) if ref( \$value );"; } + if ( $attr->has_trigger ) { - push @code, "\$attr->trigger->( \$instance, \$args->{\$from}, \$attr );"; + push @code, "\$attrs[$index]->{trigger}->( \$instance, \$value, \$attrs[$index] );"; } + join "\n", @code; }; - my $part2 = do { + + my $make_default_value = 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();"; + + push @code, "my \$value = "; + + if ($attr->should_coerce && $attr->type_constraint) { + push @code, "Mouse::TypeRegistry->typecast_constraints('".$attr->associated_class->name."', \$attrs[$index]->{find_type_constraint}, \$attrs[$index]->{type_constraint}, "; } + if ($attr->has_builder) { + push @code, "\$instance->$builder"; + } + elsif (ref($default) eq 'CODE') { + push @code, "\$attrs[$index]->{default}->(\$instance)"; + } + elsif (!defined($default)) { + push @code, 'undef'; + } + elsif ($default =~ /^\-?[0-9]+(?:\.[0-9]+)$/) { + push @code, $default; + } + else { + push @code, "'$default'"; + } + if ($attr->should_coerce) { - push @code, "\$value = \$attr->coerce_constraint(\$value);"; + push @code, ");"; + } + else { + push @code, ";"; } + if ($attr->has_type_constraint) { - push @code, "\$attr->verify_type_constraint(\$value);"; + push @code, "{local \$_ = \$value; unless (\$attrs[$index]->{find_type_constraint}->(\$_)) {"; + push @code, "\$attrs[$index]->verify_type_constraint_error('$key', \$_, \$attrs[$index]->type_constraint)}}"; } - push @code, "\$instance->{\$key} = \$value;"; + + push @code, "\$instance->{'$key'} = \$value;"; + if ($attr->is_weak_ref) { - push @code, "weaken( \$instance->{\$key} ) if ref( \$instance->{\$key} );"; + push @code, "Scalar::Util::weaken( \$instance->{'$key'} ) if ref( \$value );"; } } join "\n", @code; } else { if ( $attr->is_required ) { - q{Carp::confess("Attribute (} . $attr->name . q{) is required");}; + qq{Carp::confess("Attribute ($key) is required");}; } else { "" } @@ -88,13 +122,16 @@ sub _generate_processattrs { }; my $code = <<"..."; { - my \$attr = \$meta->get_attribute('$key'); - my \$from = '$from'; - my \$key = '$key'; - if (defined(\$from) && exists(\$args->{\$from})) { - $part1; + if (exists(\$args->{'$from'})) { + $set_value; +... + if ($make_default_value) { + $code .= <<"..."; } else { - $part2; + $make_default_value; +... + } + $code .= <<"..."; } } ... @@ -131,9 +168,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;