diff options
author | doy <doy@tozt.net> | 2009-04-13 23:49:15 -0500 |
---|---|---|
committer | doy <doy@tozt.net> | 2009-04-13 23:49:15 -0500 |
commit | 63f1d0d103a8008d3c292f1f681d17fee0b45c5d (patch) | |
tree | 279e90d8a05ed09997c1a5e469d6a415ea06a015 /lib | |
parent | c04fa8b27f9a4e9d8f12cc3a792d870677e62490 (diff) | |
download | moosex-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.pm | 64 |
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; |