Implement an idea of reducing inline constructors in basic metaclasses

put all the inlined constructors _new() in modules directly.

diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm
index e3c38ff..1f54f1d 100644 (file)
--- a/lib/Class/MOP.pm
+++ b/lib/Class/MOP.pm
@@ -691,8 +691,7 @@ undef Class::MOP::Instance->meta->{_package_cache_flag};
 # the compile time of the MOP, and gives us no actual benefits.
 
 $_->meta->make_immutable(
-    inline_constructor  => 1,
-    replace_constructor => 1,
+    inline_constructor  => 0,
     constructor_name    => "_new",
     inline_accessors => 0,
 ) for qw/

diff --git a/lib/Class/MOP/Attribute.pm b/lib/Class/MOP/Attribute.pm
index 3e41652..b6b3f52 100644 (file)
--- a/lib/Class/MOP/Attribute.pm
+++ b/lib/Class/MOP/Attribute.pm
@@ -57,6 +57,10 @@ sub new {
 
 sub _new {
     my $class = shift;
+
+    return Class::MOP::Class->initialize($class)->new_object(@_)
+      if $class ne __PACKAGE__;
+
     my $options = @_ == 1 ? $_[0] : {@_};
 
     bless {

diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index bb2385b..32eec6a 100644 (file)
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -107,9 +107,12 @@ sub _construct_class_instance {
 
 sub _new {
     my $class = shift;
+    return Class::MOP::Class->initialize($class)->new_object(@_)
+      if $class ne __PACKAGE__;
+
     my $options = @_ == 1 ? $_[0] : {@_};
 
-    bless {
+    return bless {
         # inherited from Class::MOP::Package
         'package' => $options->{package},
 

diff --git a/lib/Class/MOP/Instance.pm b/lib/Class/MOP/Instance.pm
index 8643e3e..b617afa 100644 (file)
--- a/lib/Class/MOP/Instance.pm
+++ b/lib/Class/MOP/Instance.pm
@@ -45,8 +45,12 @@ sub new {
 }
 
 sub _new {
-    my ( $class, %options ) = @_;
-    bless {
+    my $class = shift;
+    return Class::MOP::Class->initialize($class)->new_object(@_)
+      if $class ne __PACKAGE__;
+
+    my $params = @_ == 1 ? $_[0] : {@_};
+    return bless {
         # NOTE:
         # I am not sure that it makes
         # sense to pass in the meta
@@ -57,10 +61,10 @@ sub _new {
         # which is *probably* a safe
         # assumption,.. but you can
         # never tell <:)
-        'associated_metaclass' => $options{associated_metaclass},
-        'attributes'           => $options{attributes},
-        'slots'                => $options{slots},
-        'slot_hash'            => $options{slot_hash},
+        'associated_metaclass' => $params->{associated_metaclass},
+        'attributes'           => $params->{attributes},
+        'slots'                => $params->{slots},
+        'slot_hash'            => $params->{slot_hash},
     } => $class;
 }
 

diff --git a/lib/Class/MOP/Method.pm b/lib/Class/MOP/Method.pm
index ea580ab..112a038 100644 (file)
--- a/lib/Class/MOP/Method.pm
+++ b/lib/Class/MOP/Method.pm
@@ -43,13 +43,17 @@ sub wrap {
 
 sub _new {
     my $class = shift;
+    return Class::MOP::Class->initialize($class)->new_object(@_)
+      if $class ne __PACKAGE__;
+
     my $params = @_ == 1 ? $_[0] : {@_};
 
-    my $self = bless {
+    return bless {
         'body'                 => $params->{body},
         'associated_metaclass' => $params->{associated_metaclass},
         'package_name'         => $params->{package_name},
         'name'                 => $params->{name},
+        'original_method'      => $params->{original_method},
     } => $class;
 }
 

diff --git a/lib/Class/MOP/Method/Accessor.pm b/lib/Class/MOP/Method/Accessor.pm
index ecc84ad..4d0aa8f 100644 (file)
--- a/lib/Class/MOP/Method/Accessor.pm
+++ b/lib/Class/MOP/Method/Accessor.pm
@@ -43,11 +43,28 @@ sub new {
 
 sub _new {
     my $class = shift;
-    my $options = @_ == 1 ? $_[0] : {@_};
 
-    $options->{is_inline} ||= 0;
+    return Class::MOP::Class->initialize($class)->new_object(@_)
+      if $class ne __PACKAGE__;
 
-    return bless $options, $class;
+    my $params = @_ == 1 ? $_[0] : {@_};
+
+    return bless {
+        # inherited from Class::MOP::Method
+        body                 => $params->{body},
+        associated_metaclass => $params->{associated_metaclass},
+        package_name         => $params->{package_name},
+        name                 => $params->{name},
+        original_method      => $params->{original_method},
+
+        # inherit from Class::MOP::Generated
+        is_inline            => $params->{is_inline} || 0,
+        definition_context   => $params->{definition_context},
+
+        # defined in this class
+        attribute            => $params->{attribute},
+        accessor_type        => $params->{accessor_type},
+    } => $class;
 }
 
 ## accessors

diff --git a/lib/Class/MOP/Method/Constructor.pm b/lib/Class/MOP/Method/Constructor.pm
index 9a1bf3f..8382286 100644 (file)
--- a/lib/Class/MOP/Method/Constructor.pm
+++ b/lib/Class/MOP/Method/Constructor.pm
@@ -38,17 +38,29 @@ sub new {
 
 sub _new {
     my $class = shift;
-    my $options = @_ == 1 ? $_[0] : {@_};
-
-    bless {
-        # from our superclass
-        'body'                 => undef,
-        'package_name'         => $options->{package_name},
-        'name'                 => $options->{name},        
-        # specific to this subclass
-        'options'              => $options->{options} || {},
-        'associated_metaclass' => $options->{metaclass},
-        'is_inline'            => ($options->{is_inline} || 0),
+    return Class::MOP::Class->initialize($class)->new_object(@_)
+      if $class ne __PACKAGE__;
+
+    my $params = @_ == 1 ? $_[0] : {@_};
+
+    return bless {
+        # inherited from Class::MOP::Method
+        body                 => $params->{body},
+        # associated_metaclass => $params->{associated_metaclass}, # overriden
+        package_name         => $params->{package_name},
+        name                 => $params->{name},
+        original_method      => $params->{original_method},
+
+        # inherited from Class::MOP::Generated
+        is_inline            => $params->{is_inline} || 0,
+        definition_context   => $params->{definition_context},
+
+        # inherited from Class::MOP::Inlined
+        _expected_method_class => $params->{_expected_method_class},
+
+        # defined in this subclass
+        options              => $params->{options} || {},
+        associated_metaclass => $params->{metaclass},
     }, $class;
 }
 

diff --git a/lib/Class/MOP/Module.pm b/lib/Class/MOP/Module.pm
index 2c125f5..24eeaca 100644 (file)
--- a/lib/Class/MOP/Module.pm
+++ b/lib/Class/MOP/Module.pm
@@ -13,6 +13,23 @@ our $AUTHORITY = 'cpan:STEVAN';
 
 use base 'Class::MOP::Package';
 
+sub _new{
+    my $class = shift;
+    return Class::MOP::Class->initialize($class)->new_object(@_)
+      if $class ne __PACKAGE__;
+
+    my $params = @_ == 1 ? $_[0] : {@_};
+    return bless {
+        # from Class::MOP::Package
+        package   => $params->{package},
+        namespace => \undef,
+
+        # attributes
+        version   => \undef,
+        authority => \undef
+    } => $class;
+}
+
 sub version {  
     my $self = shift;
     ${$self->get_package_symbol({ sigil => '$', type => 'SCALAR', name => 'VERSION' })};

diff --git a/lib/Class/MOP/Package.pm b/lib/Class/MOP/Package.pm
index 0336a57..d2cc021 100644 (file)
--- a/lib/Class/MOP/Package.pm
+++ b/lib/Class/MOP/Package.pm
@@ -58,18 +58,25 @@ sub reinitialize {
 
 sub _new {
     my $class = shift;
-    my $options = @_ == 1 ? $_[0] : {@_};
+    return Class::MOP::Class->initialize($class)->new_object(@_)
+      if $class ne __PACKAGE__;
 
-    # NOTE:
-    # because of issues with the Perl API 
-    # to the typeglob in some versions, we 
-    # need to just always grab a new 
-    # reference to the hash in the accessor. 
-    # Ideally we could just store a ref and 
-    # it would Just Work, but oh well :\
-    $options->{namespace} ||= \undef;
+    my $params = @_ == 1 ? $_[0] : {@_};
+
+    return bless {
+        package   => $params->{package},
+
+        # NOTE:
+        # because of issues with the Perl API
+        # to the typeglob in some versions, we
+        # need to just always grab a new
+        # reference to the hash in the accessor.
+        # Ideally we could just store a ref and
+        # it would Just Work, but oh well :\
+
+        namespace => \undef,
 
-    bless $options, $class;
+    } => $class;
 }
 
 # Attributes