From: Stevan Little <stevan.little@iinteractive.com>
Date: Wed, 4 Jun 2008 06:24:13 +0000 (+0000)
Subject: some speed gains
X-Git-Tag: 0_64~38
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9b522fc4b2f36a31ba00ddf00abf369c28c705c7;p=gitmo%2FClass-MOP.git

some speed gains
---

diff --git a/Changes b/Changes
index 9f7fae7..7c56059 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,19 @@
 Revision history for Perl extension Class-MOP.
 
+0.59
+
+    * Class::MOP::Class
+      - now stores the instance of the instance 
+        metaclass to avoid needless recomputation
+    
+    * Class::MOP
+      Class::MOP::Class      
+      Class::MOP::Method
+      Class::MOP::Method::Wrapped
+      Class::MOP::Attribute
+      - switched usage of reftype to ref because 
+        it is much faster
+
 0.58 Thurs. May 29, 2008
     (late night release engineering)--
     
diff --git a/README b/README
index 32af088..bdd7bca 100644
--- a/README
+++ b/README
@@ -1,4 +1,4 @@
-Class::MOP version 0.58
+Class::MOP version 0.59
 ===========================
 
 See the individual module documentation for more information
diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm
index 85a5a23..88cd78a 100644
--- a/lib/Class/MOP.pm
+++ b/lib/Class/MOP.pm
@@ -16,7 +16,7 @@ use Class::MOP::Method;
 use Class::MOP::Immutable;
 
 BEGIN {
-    our $VERSION   = '0.58';
+    our $VERSION   = '0.59';
     our $AUTHORITY = 'cpan:STEVAN';    
     
     *IS_RUNNING_ON_5_10 = ($] < 5.009_005) 
@@ -530,7 +530,7 @@ Class::MOP::Method->meta->add_method('wrap' => sub {
     my $code    = shift;
     my %options = @_;
 
-    ('CODE' eq (Scalar::Util::reftype($code) || ''))
+    ('CODE' eq ref($code))
         || confess "You must supply a CODE reference to bless, not (" . ($code || 'undef') . ")";
 
     ($options{package_name} && $options{name})
diff --git a/lib/Class/MOP/Attribute.pm b/lib/Class/MOP/Attribute.pm
index 8d3fe04..9f09d2f 100644
--- a/lib/Class/MOP/Attribute.pm
+++ b/lib/Class/MOP/Attribute.pm
@@ -7,9 +7,9 @@ use warnings;
 use Class::MOP::Method::Accessor;
 
 use Carp         'confess';
-use Scalar::Util 'blessed', 'reftype', 'weaken';
+use Scalar::Util 'blessed', 'weaken';
 
-our $VERSION   = '0.25';
+our $VERSION   = '0.26';
 our $AUTHORITY = 'cpan:STEVAN';
 
 use base 'Class::MOP::Object';
@@ -231,7 +231,7 @@ sub get_write_method_ref {
 }
 
 sub is_default_a_coderef {
-    ('CODE' eq (reftype($_[0]->{'$!default'} || $_[0]->{default}) || ''))
+    ('CODE' eq ref($_[0]->{'$!default'} || $_[0]->{default}))
 }
 
 sub default {
@@ -320,8 +320,8 @@ sub accessor_metaclass { 'Class::MOP::Method::Accessor' }
 
 sub process_accessors {
     my ($self, $type, $accessor, $generate_as_inline_methods) = @_;
-    if (reftype($accessor)) {
-        (reftype($accessor) eq 'HASH')
+    if (ref($accessor)) {
+        (ref($accessor) eq 'HASH')
             || confess "bad accessor/reader/writer/predicate/clearer format, must be a HASH ref";
         my ($name, $method) = %{$accessor};
         $method = $self->accessor_metaclass->wrap(
@@ -381,7 +381,7 @@ sub install_accessors {
 {
     my $_remove_accessor = sub {
         my ($accessor, $class) = @_;
-        if (reftype($accessor) && reftype($accessor) eq 'HASH') {
+        if (ref($accessor) && ref($accessor) eq 'HASH') {
             ($accessor) = keys %{$accessor};
         }
         my $method = $class->get_method($accessor);
diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index 642accb..a3ac27d 100644
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -9,9 +9,9 @@ use Class::MOP::Instance;
 use Class::MOP::Method::Wrapped;
 
 use Carp         'confess';
-use Scalar::Util 'blessed', 'reftype', 'weaken';
+use Scalar::Util 'blessed', 'weaken';
 
-our $VERSION   = '0.32';
+our $VERSION   = '0.33';
 our $AUTHORITY = 'cpan:STEVAN';
 
 use base 'Class::MOP::Module';
@@ -103,7 +103,8 @@ sub construct_class_instance {
             # we can tell the first time the 
             # methods are fetched
             # - SL
-            '$!_package_cache_flag'       => undef,            
+            '$!_package_cache_flag'       => undef,  
+            '$!_meta_instance'            => undef,          
         } => $class;
     }
     else {
@@ -367,7 +368,7 @@ sub construct_instance {
     # NOTE:
     # this will only work for a HASH instance type
     if ($class->is_anon_class) {
-        (reftype($instance) eq 'HASH')
+        (Scalar::Util::reftype($instance) eq 'HASH')
             || confess "Currently only HASH based instances are supported with instance of anon-classes";
         # NOTE:
         # At some point we should make this official
@@ -379,11 +380,26 @@ sub construct_instance {
     return $instance;
 }
 
+
 sub get_meta_instance {
-    my $class = shift;
-    return $class->instance_metaclass->new(
-        $class,
-        $class->compute_all_applicable_attributes()
+    my $self = shift;
+    # NOTE:
+    # just about any fiddling with @ISA or 
+    # any fiddling with attributes will 
+    # also fiddle with the symbol table 
+    # and therefore invalidate the package 
+    # cache, in which case we should blow 
+    # away the meta-instance cache. Of course
+    # this will invalidate it more often then 
+    # is probably needed, but better safe 
+    # then sorry.
+    # - SL
+    $self->{'$!_meta_instance'} = undef
+        if defined $self->{'$!_package_cache_flag'} && 
+                   $self->{'$!_package_cache_flag'} == Class::MOP::check_package_cache_flag($self->name);
+    $self->{'$!_meta_instance'} ||= $self->instance_metaclass->new(
+        $self,
+        $self->compute_all_applicable_attributes()
     );
 }
 
@@ -580,7 +596,7 @@ sub add_method {
     }
     else {
         $body = $method;
-        ('CODE' eq (reftype($body) || ''))
+        ('CODE' eq ref($body))
             || confess "Your code block must be a CODE reference";
         $method = $self->method_metaclass->wrap(
             $body => (
@@ -674,7 +690,7 @@ sub alias_method {
         || confess "You must define a method name";
 
     my $body = (blessed($method) ? $method->body : $method);
-    ('CODE' eq (reftype($body) || ''))
+    ('CODE' eq ref($body))
         || confess "Your code block must be a CODE reference";
 
     $self->add_package_symbol("&${method_name}" => $body);
diff --git a/lib/Class/MOP/Method.pm b/lib/Class/MOP/Method.pm
index 0c8fd12..1553ff6 100644
--- a/lib/Class/MOP/Method.pm
+++ b/lib/Class/MOP/Method.pm
@@ -5,9 +5,9 @@ use strict;
 use warnings;
 
 use Carp         'confess';
-use Scalar::Util 'reftype', 'blessed';
+use Scalar::Util 'blessed';
 
-our $VERSION   = '0.08';
+our $VERSION   = '0.09';
 our $AUTHORITY = 'cpan:STEVAN';
 
 use base 'Class::MOP::Object';
@@ -31,7 +31,7 @@ before spending too much time chasing this one down.
 sub wrap {
     my ( $class, $code, %params ) = @_;
 
-    ('CODE' eq (reftype($code) || ''))
+    ('CODE' eq ref($code))
         || confess "You must supply a CODE reference to bless, not (" . ($code || 'undef') . ")";
 
     ($params{package_name} && $params{name})
diff --git a/lib/Class/MOP/Method/Wrapped.pm b/lib/Class/MOP/Method/Wrapped.pm
index fb3cd6d..0f0a969 100644
--- a/lib/Class/MOP/Method/Wrapped.pm
+++ b/lib/Class/MOP/Method/Wrapped.pm
@@ -5,9 +5,9 @@ use strict;
 use warnings;
 
 use Carp         'confess';
-use Scalar::Util 'reftype', 'blessed';
+use Scalar::Util 'blessed';
 
-our $VERSION   = '0.03';
+our $VERSION   = '0.04';
 our $AUTHORITY = 'cpan:STEVAN';
 
 use base 'Class::MOP::Method';
diff --git a/t/010_self_introspection.t b/t/010_self_introspection.t
index e440c99..a933e85 100644
--- a/t/010_self_introspection.t
+++ b/t/010_self_introspection.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 201;
+use Test::More tests => 200;
 use Test::Exception;
 
 BEGIN {
@@ -125,7 +125,7 @@ foreach my $method_name (@class_mop_module_methods) {
 
 foreach my $non_method_name (qw(
     confess
-    blessed reftype
+    blessed
     subname
     svref_2object
     )) {