package Mouse::Meta::Method::Constructor;
use Mouse::Util qw(:meta); # enables strict and warnings
-sub _inline_create_instance {
- my(undef, $class_expr) = @_;
- return "bless {}, $class_expr";
-}
+use constant _MOUSE_DEBUG => $ENV{MOUSE_DEBUG} ? 1 : 0;
-sub _inline_slot {
+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 @attrs = $metaclass->get_all_attributes;
+ my $associated_metaclass_name = $metaclass->name;
- my $init_attrs = $class->_generate_processattrs($metaclass, \@attrs);
- my $buildargs = $class->_generate_BUILDARGS($metaclass);
my $buildall = $class->_generate_BUILDALL($metaclass);
-
- my @checks = map { $_ && $_->_compiled_type_constraint }
- map { $_->type_constraint } @attrs;
-
- 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)"
+ my $buildargs = $class->_generate_BUILDARGS($metaclass);
+ my $initializer = $metaclass->{_mouse_cache}{_initialize_object} ||=
+ $class->_generate_initialize_object($metaclass);
+ my $source = sprintf(<<'EOT', __FILE__, $metaclass->name, $buildargs, $buildall);
+#line 1 "%s"
+ package %s;
sub {
my $class = shift;
return $class->Mouse::Object::new(@_)
if $class ne __PACKAGE__;
# BUILDARGS
%s;
- # create instance
- my $instance = %s;
- # process attributes
- %s;
+ my $instance = bless {}, $class;
+ $metaclass->$initializer($instance, $args, 0);
# BUILDALL
%s;
return $instance;
}
-END_CONSTRUCTOR
- #warn $source;
- my $code;
+EOT
+ warn $source if _MOUSE_DEBUG;
+ my $body;
my $e = do{
local $@;
- $code = eval $source;
+ $body = eval $source;
$@;
};
die $e if $e;
- return $code;
+ return $body;
}
-sub _generate_processattrs {
- my ($method_class, $metaclass, $attrs) = @_;
+sub _generate_initialize_object {
+ my ($method_class, $metaclass) = @_;
+ my @attrs = $metaclass->get_all_attributes;
+
+ my @checks = map { $_ && $_->_compiled_type_constraint }
+ map { $_->type_constraint } @attrs;
+
my @res;
my $has_triggers;
- my $strict = $metaclass->__strict_constructor;
+ my $strict = $metaclass->strict_constructor;
if($strict){
push @res, 'my $used = 0;';
}
- for my $index (0 .. @$attrs - 1) {
+ for my $index (0 .. @attrs - 1) {
my $code = '';
- my $attr = $attrs->[$index];
+ my $attr = $attrs[$index];
my $key = $attr->name;
my $init_arg = $attr->init_arg;
my $is_weak_ref = $attr->is_weak_ref;
my $need_coercion;
- my $instance = '$instance';
- my $instance_slot = $method_class->_inline_get_slot($instance, $key);
+ my $instance_slot = $method_class->_inline_slot('$instance', $key);
my $attr_var = "\$attrs[$index]";
my $constraint_var;
my $post_process = '';
if(defined $type_constraint){
- $post_process .= "\$checks[$index]->($instance_slot)";
+ $post_process .= "\$checks[$index]->($instance_slot)\n";
$post_process .= " or $attr_var->_throw_type_constraint_error($instance_slot, $constraint_var);\n";
}
if($is_weak_ref){
- $post_process .= $method_class->_inline_weaken_slot($instance, $key) . " if ref $instance_slot;\n";
+ $post_process = "Scalar::Util::weaken($instance_slot) "
+ . "if ref $instance_slot;\n";
}
+ # build cde for an attribute
if (defined $init_arg) {
my $value = "\$args->{q{$init_arg}}";
$value = "$constraint_var->coerce($value)";
}
- $code .= $method_class->_inline_set_slot($instance, $key, $value) . ";\n";
+ $code .= "$instance_slot = $value;\n";
$code .= $post_process;
if ($attr->has_trigger) {
$value = "$constraint_var->coerce($value)";
}
- $code .= $method_class->_inline_set_slot($instance, $key, $value) . ";\n";
- if($is_weak_ref){
- $code .= $method_class->_inline_weaken_slot($instance, $key) . ";\n";
- }
+ $code .= "$instance_slot = $value;\n";
+ $code .= $post_process;
}
}
elsif ($attr->is_required) {
- $code .= "Carp::confess('Attribute ($key) is required');";
+ $code .= "\$meta->throw_error('Attribute ($key) is required')";
+ $code .= " unless \$is_cloning;\n";
}
$code .= "}\n" if defined $init_arg;
if($strict){
push @res, q{if($used < keys %{$args})}
- . sprintf q{{ %s->_report_unknown_args($metaclass, \@attrs, $args) }}, $method_class;
+ . q{{ $meta->_report_unknown_args(\@attrs, $args) }};
}
if($metaclass->is_anon_class){
- push @res, q{$instance->{__METACLASS__} = $metaclass;};
+ push @res, q{$instance->{__METACLASS__} = $meta;};
}
if($has_triggers){
push @res, q{$_->[0]->($instance, $_->[1]) for @triggers;};
}
- return join "\n", @res;
+ my $source = sprintf <<'EOT', __FILE__, $metaclass->name, join "\n", @res;
+#line 1 "%s"
+ package %s;
+ sub {
+ my($meta, $instance, $args, $is_cloning) = @_;
+ %s;
+ return $instance;
+ }
+EOT
+ warn $source if _MOUSE_DEBUG;
+ my $body;
+ my $e = do {
+ local $@;
+ $body = eval $source;
+ $@;
+ };
+ die $e if $e;
+ return $body;
}
sub _generate_BUILDARGS {
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__
=head1 VERSION
-This document describes Mouse version 0.50_06
+This document describes Mouse version 0.84
=head1 SEE ALSO
projects / gitmo/Mouse.git / blobdiff