X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FMethod%2FConstructor.pm;h=e57dd6e9117162b6d7d24c48d37f7479fba6ae74;hb=6e1e5b31f9ff0a46de1d7e396840da18c385962d;hp=6a78407cbd5b6942e07a0b09989cfab8feb8be7d;hpb=506fb74dbff3e8f756230c643d8bff7b85ae9ca3;p=gitmo%2FMouse.git diff --git a/lib/Mouse/Meta/Method/Constructor.pm b/lib/Mouse/Meta/Method/Constructor.pm index 6a78407..e57dd6e 100644 --- a/lib/Mouse/Meta/Method/Constructor.pm +++ b/lib/Mouse/Meta/Method/Constructor.pm @@ -1,40 +1,71 @@ package Mouse::Meta::Method::Constructor; use Mouse::Util qw(:meta); # enables strict and warnings -sub _inline_slot{ +sub _inline_create_instance { + my(undef, $class_expr) = @_; + return "bless {}, $class_expr"; +} + +sub _inline_slot { my(undef, $self_var, $attr_name) = @_; return sprintf '%s->{q{%s}}', $self_var, $attr_name; } +sub _inline_has_slot { + my($class, $self_var, $attr_name) = @_; + + return sprintf 'exists(%s)', $class->_inline_slot($self_var, $attr_name); +} + +sub _inline_get_slot { + my($class, $self_var, $attr_name) = @_; + + return $class->_inline_slot($self_var, $attr_name); +} + +sub _inline_set_slot { + my($class, $self_var, $attr_name, $rvalue) = @_; + + return $class->_inline_slot($self_var, $attr_name) . " = $rvalue"; +} + +sub _inline_weaken_slot { + my($class, $self_var, $attr_name) = @_; + + return sprintf 'Scalar::Util::weaken(%s)', $class->_inline_slot($self_var, $attr_name); +} + sub _generate_constructor { my ($class, $metaclass, $args) = @_; - my $associated_metaclass_name = $metaclass->name; - my @attrs = $metaclass->get_all_attributes; - my $buildall = $class->_generate_BUILDALL($metaclass); + my $init_attrs = $class->_generate_processattrs($metaclass, \@attrs); my $buildargs = $class->_generate_BUILDARGS($metaclass); - my $processattrs = $class->_generate_processattrs($metaclass, \@attrs); + my $buildall = $class->_generate_BUILDALL($metaclass); my @checks = map { $_ && $_->_compiled_type_constraint } map { $_->type_constraint } @attrs; - my $source = sprintf("#line %d %s\n", __LINE__, __FILE__).<<"..."; - sub \{ - my \$class = shift; - return \$class->Mouse::Object::new(\@_) - if \$class ne q{$associated_metaclass_name}; + my $class_name = $metaclass->name; + my $source = sprintf(<<'END_CONSTRUCTOR', $class_name, __LINE__, __FILE__, $class_name, $buildargs, $class->_inline_create_instance('$class'), $init_attrs, $buildall); +package %s; +#line %d "constructor of %s (%s)" + sub { + my $class = shift; + return $class->Mouse::Object::new(@_) + if $class ne __PACKAGE__; # BUILDARGS - $buildargs; - my \$instance = bless {}, \$class; + %s; + # create instance + my $instance = %s; # process attributes - $processattrs; + %s; # BUILDALL - $buildall; - return \$instance; + %s; + return $instance; } -... +END_CONSTRUCTOR #warn $source; my $code; my $e = do{ @@ -51,6 +82,11 @@ sub _generate_processattrs { my @res; my $has_triggers; + my $strict = $metaclass->__strict_constructor; + + if($strict){ + push @res, 'my $used = 0;'; + } for my $index (0 .. @$attrs - 1) { my $code = ''; @@ -63,7 +99,8 @@ sub _generate_processattrs { my $is_weak_ref = $attr->is_weak_ref; my $need_coercion; - my $instance_slot = $method_class->_inline_slot('$instance', $key); + my $instance = '$instance'; + my $instance_slot = $method_class->_inline_get_slot($instance, $key); my $attr_var = "\$attrs[$index]"; my $constraint_var; @@ -77,10 +114,10 @@ sub _generate_processattrs { my $post_process = ''; if(defined $type_constraint){ $post_process .= "\$checks[$index]->($instance_slot)"; - $post_process .= " or $attr_var->verify_type_constraint_error(q{$key}, $instance_slot, $constraint_var);\n"; + $post_process .= " or $attr_var->_throw_type_constraint_error($instance_slot, $constraint_var);\n"; } if($is_weak_ref){ - $post_process .= "Scalar::Util::weaken($instance_slot) if ref $instance_slot;\n"; + $post_process .= $method_class->_inline_weaken_slot($instance, $key) . " if ref $instance_slot;\n"; } if (defined $init_arg) { @@ -92,7 +129,7 @@ sub _generate_processattrs { $value = "$constraint_var->coerce($value)"; } - $code .= "$instance_slot = $value;\n"; + $code .= $method_class->_inline_set_slot($instance, $key, $value) . ";\n"; $code .= $post_process; if ($attr->has_trigger) { @@ -100,7 +137,11 @@ sub _generate_processattrs { $code .= "push \@triggers, [$attr_var\->{trigger}, $instance_slot];\n"; } - $code .= "\n} else {\n"; + if ($strict){ + $code .= '++$used;' . "\n"; + } + + $code .= "\n} else {\n"; # $value exists } if ($attr->has_default || $attr->has_builder) { @@ -126,9 +167,9 @@ sub _generate_processattrs { $value = "$constraint_var->coerce($value)"; } - $code .= "$instance_slot = $value;\n"; + $code .= $method_class->_inline_set_slot($instance, $key, $value) . ";\n"; if($is_weak_ref){ - $code .= "Scalar::Util::weaken($instance_slot);\n"; + $code .= $method_class->_inline_weaken_slot($instance, $key) . ";\n"; } } } @@ -141,13 +182,18 @@ sub _generate_processattrs { push @res, $code; } + if($strict){ + push @res, q{if($used < keys %{$args})} + . sprintf q{{ %s->_report_unknown_args($metaclass, \@attrs, $args) }}, $method_class; + } + if($metaclass->is_anon_class){ push @res, q{$instance->{__METACLASS__} = $metaclass;}; } if($has_triggers){ unshift @res, q{my @triggers;}; - push @res, q{$_->[0]->($instance, $_->[1]) for @triggers;}; + push @res, q{$_->[0]->($instance, $_->[1]) for @triggers;}; } return join "\n", @res; @@ -188,6 +234,30 @@ sub _generate_BUILDALL { return join "\n", @code; } +sub _report_unknown_args { + my(undef, $metaclass, $attrs, $args) = @_; + + my @unknowns; + my %init_args; + foreach my $attr(@{$attrs}){ + my $init_arg = $attr->init_arg; + if(defined $init_arg){ + $init_args{$init_arg}++; + } + } + + while(my $key = each %{$args}){ + if(!exists $init_args{$key}){ + push @unknowns, $key; + } + } + + $metaclass->throw_error( sprintf + "Unknown attribute passed to the constructor of %s: %s", + $metaclass->name, Mouse::Util::english_list(@unknowns), + ); +} + 1; __END__ @@ -197,7 +267,7 @@ Mouse::Meta::Method::Constructor - A Mouse method generator for constructors =head1 VERSION -This document describes Mouse version 0.40_09 +This document describes Mouse version 0.50_06 =head1 SEE ALSO