X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FMethod%2FConstructor.pm;h=83bf3efd82e06f0241ead220f4ec30e99cd81d5c;hb=a4d5249cfe07046e7c8c6bbbecb97af544812ce1;hp=1786d4e6fae746a3300900497cb20b55127809df;hpb=fc1d8369f17d2d6a06ecdcb13199e1d4ecb2e53f;p=gitmo%2FMouse.git diff --git a/lib/Mouse/Meta/Method/Constructor.pm b/lib/Mouse/Meta/Method/Constructor.pm index 1786d4e..83bf3ef 100644 --- a/lib/Mouse/Meta/Method/Constructor.pm +++ b/lib/Mouse/Meta/Method/Constructor.pm @@ -3,80 +3,118 @@ use strict; use warnings; sub generate_constructor_method_inline { - my ($class, $meta) = @_; + my ($class, $meta) = @_; + + my @attrs = $meta->compute_all_applicable_attributes; my $buildall = $class->_generate_BUILDALL($meta); my $buildargs = $class->_generate_BUILDARGS(); - my $classname = $meta->name; - my $processattrs = $class->_generate_processattrs($meta); + my $processattrs = $class->_generate_processattrs($meta, \@attrs); my $code = <<"..."; sub { my \$class = shift; my \$args = $buildargs; - my \$instance = bless {}, '$classname'; + my \$instance = bless {}, \$class; $processattrs; $buildall; return \$instance; } ... - warn $code if $ENV{DEBUG}; + local $@; my $res = eval $code; die $@ if $@; $res; } 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'} = \$value;"; + + if ($attr->is_weak_ref) { + push @code, "Scalar::Util::weaken( \$instance->{'$key'} ) if ref( \$value );"; } - push @code, "\$instance->{\$key} = \$args->{\$from};"; - push @code, "weaken( \$instance->{\$key} ) if ref( \$instance->{\$key} ) && \$attr->is_weak_ref;"; + 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 { "" } @@ -84,13 +122,16 @@ sub _generate_processattrs { }; my $code = <<"..."; { - my \$attr = \$instance->meta->get_attribute_map->{'$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 .= <<"..."; } } ... @@ -127,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;