X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FMethod%2FConstructor.pm;h=0df3eabd6250a63536b62ef2a7842a579e0816aa;hb=f2560fde38fb3827df7a380a5774e265b092a6fd;hp=84d36ee90009a2d8435e3ec70f3326dd20cedb73;hpb=41cdacce13ef9c29c2daabb92114572d15e762e5;p=gitmo%2FMouse.git diff --git a/lib/Mouse/Meta/Method/Constructor.pm b/lib/Mouse/Meta/Method/Constructor.pm index 84d36ee..0df3eab 100644 --- a/lib/Mouse/Meta/Method/Constructor.pm +++ b/lib/Mouse/Meta/Method/Constructor.pm @@ -3,89 +3,120 @@ use strict; use warnings; sub generate_constructor_method_inline { - my ($class, $meta) = @_; - my $code = $class->_generate_constructor_method_inline($meta); - warn $code if $ENV{DEBUG}; - - local $@; - my $res = eval $code; - die $@ if $@; - $res; -} - -sub _generate_constructor_method_inline { my ($class, $meta) = @_; + + my @attrs = $meta->compute_all_applicable_attributes; # this one is using by evaled code 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); - return <<"..."; + my $code = <<"..."; sub { my \$class = shift; my \$args = $buildargs; - my \$instance = bless {}, '$classname'; - my \$meta = \$instance->meta; + 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} = \$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 { "" } @@ -93,13 +124,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 .= <<"..."; } } ... @@ -136,9 +170,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;