X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FClass-MOP.git;a=blobdiff_plain;f=lib%2FClass%2FMOP%2FClass.pm;fp=lib%2FClass%2FMOP%2FClass.pm;h=fbe64e49489f9ae89f93c2e9aca920d93df5db9f;hp=983dd48d091a52625f9c0d50dac03a539fbc5bc8;hb=939ec2879f2eef695c063d980c47ecf5c6437481;hpb=1322c26b43bfd579ca9f2921b7f26674a6d245f2 diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm index 983dd48..fbe64e4 100644 --- a/lib/Class/MOP/Class.pm +++ b/lib/Class/MOP/Class.pm @@ -587,26 +587,65 @@ sub _construct_instance { sub _inline_new_object { my $self = shift; - my $idx = 0; return ( 'my $class = shift;', - 'return Class::MOP::Class->initialize($class)->new_object(@_)', - 'if $class ne \'' . $self->name . '\';', - 'my $params = @_ == 1 ? $_[0] : {@_};', - 'my $instance = ' . $self->_inline_create_instance('$class') . ';', - (map { $self->_inline_slot_initializer($_, $idx++) } - $self->get_all_attributes), + '$class = Scalar::Util::blessed($class) || $class;', + $self->_inline_fallback_constructor('$class'), + $self->_inline_params('$params', '$class'), + $self->_inline_generate_instance('$instance', '$class'), + $self->_inline_slot_initializers, $self->_inline_preserve_weak_metaclasses, + $self->_inline_extra_init, 'return $instance', ); } +sub _inline_fallback_constructor { + my $self = shift; + my ($class) = @_; + return ( + 'return ' . $self->_generate_fallback_constructor($class), + 'if ' . $class . ' ne \'' . $self->name . '\';', + ); +} + +sub _generate_fallback_constructor { + my $self = shift; + my ($class) = @_; + return 'Class::MOP::Class->initialize(' . $class . ')->new_object(@_)', +} + +sub _inline_params { + my $self = shift; + my ($params, $class) = @_; + return ( + 'my ' . $params . ' = @_ == 1 ? $_[0] : {@_};', + ); +} + +sub _inline_generate_instance { + my $self = shift; + my ($inst, $class) = @_; + return ( + 'my ' . $inst . ' = ' . $self->_inline_create_instance($class) . ';', + ); +} + sub _inline_create_instance { my $self = shift; return $self->get_meta_instance->inline_create_instance(@_); } +sub _inline_slot_initializers { + my $self = shift; + + my $idx = 0; + + return map { $self->_inline_slot_initializer($_, $idx++) } + $self->get_all_attributes; +} + sub _inline_slot_initializer { my $self = shift; my ($attr, $idx) = @_; @@ -678,6 +717,8 @@ sub _inline_preserve_weak_metaclasses { } } +sub _inline_extra_init { } + sub get_meta_instance { my $self = shift;