summaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
authordoy <doy@tozt.net>2009-04-13 23:49:15 -0500
committerdoy <doy@tozt.net>2009-04-13 23:49:15 -0500
commit63f1d0d103a8008d3c292f1f681d17fee0b45c5d (patch)
tree279e90d8a05ed09997c1a5e469d6a415ea06a015 /lib
parentc04fa8b27f9a4e9d8f12cc3a792d870677e62490 (diff)
downloadmoosex-nonmoose-63f1d0d103a8008d3c292f1f681d17fee0b45c5d.tar.gz
moosex-nonmoose-63f1d0d103a8008d3c292f1f681d17fee0b45c5d.zip
more intelligent inlining (i hope?)
Diffstat (limited to 'lib')
-rw-r--r--lib/MooseX/NonMoose/Meta/Role/Constructor.pm64
1 files changed, 2 insertions, 62 deletions
diff --git a/lib/MooseX/NonMoose/Meta/Role/Constructor.pm b/lib/MooseX/NonMoose/Meta/Role/Constructor.pm
index 31e5046..eef0573 100644
--- a/lib/MooseX/NonMoose/Meta/Role/Constructor.pm
+++ b/lib/MooseX/NonMoose/Meta/Role/Constructor.pm
@@ -15,71 +15,11 @@ around can_be_inlined => sub {
return $self->$orig(@_);
};
-sub _initialize_body {
- my $self = shift;
- # TODO:
- # the %options should also include a both
- # a call 'initializer' and call 'SUPER::'
- # options, which should cover approx 90%
- # of the possible use cases (even if it
- # requires some adaption on the part of
- # the author, after all, nothing is free)
- my $source = 'sub {';
- $source .= "\n" . 'my $class = shift;';
-
- $source .= "\n" . 'return $class->Moose::Object::new(@_)';
- $source .= "\n if \$class ne '" . $self->associated_metaclass->name
- . "';\n";
-
- $source .= $self->_generate_params('$params', '$class');
- $source .= $self->_generate_instance('$instance', '$class');
- $source .= $self->_generate_slot_initializers;
-
- $source .= $self->_generate_triggers();
- $source .= ";\n" . $self->_generate_BUILDALL();
-
- $source .= ";\nreturn \$instance";
- $source .= ";\n" . '}';
- warn $source if $self->options->{debug};
-
- # We need to check if the attribute ->can('type_constraint')
- # since we may be trying to immutabilize a Moose meta class,
- # which in turn has attributes which are Class::MOP::Attribute
- # objects, rather than Moose::Meta::Attribute. And
- # Class::MOP::Attribute attributes have no type constraints.
- # However we need to make sure we leave an undef value there
- # because the inlined code is using the index of the attributes
- # to determine where to find the type constraint
-
- my $attrs = $self->_attributes;
-
- my @type_constraints = map {
- $_->can('type_constraint') ? $_->type_constraint : undef
- } @$attrs;
-
- my @type_constraint_bodies = map {
- defined $_ ? $_->_compiled_type_constraint : undef;
- } @type_constraints;
-
- my $super_new = $self->associated_metaclass->find_next_method_by_name('new');
- my $code = $self->_compile_code(
- code => $source,
- environment => {
- '$meta' => \$self,
- '$attrs' => \$attrs,
- '@type_constraints' => \@type_constraints,
- '@type_constraint_bodies' => \@type_constraint_bodies,
- '$super_new' => \$super_new,
- },
- ) or $self->throw_error("Could not eval the constructor :\n\n$source\n\nbecause :\n\n$@", error => $@, data => $source );
-
- $self->{'body'} = $code;
-}
-
sub _generate_instance {
my $self = shift;
my ($var, $class_var) = @_;
- "my $var = \$super_new->execute($class_var, \@_);\n";
+ my $super_new_class = $self->associated_metaclass->find_next_method_by_name('new')->package_name;
+ "my $var = bless $super_new_class->new(\@_), $class_var;\n";
}
no Moose::Role;