[libclass-tiny-perl] 03/07: optimize constructors/destructors

[gregor herrmann]

This is an automated email from the git hooks/post-receive script.

gregoa pushed a commit to annotated tag release-0.007
in repository libclass-tiny-perl.

commit 91313327b5d86365deb6159d6e2813fc2bf45413
Author: David Golden <dagolden at cpan.org>
Date:   Sat Sep 7 15:50:27 2013 -0400

    optimize constructors/destructors
---
 Changes           |  3 +++
 lib/Class/Tiny.pm | 52 ++++++++++++++++++++++++++++++++++++----------------
 2 files changed, 39 insertions(+), 16 deletions(-)

diff --git a/Changes b/Changes
index 3b75625..6fe9cad 100644
--- a/Changes
+++ b/Changes
@@ -7,6 +7,9 @@ Revision history for Class-Tiny
     - accessors without defaults are now much faster (comparable
       to Class::Accessor::Fast)
 
+    - constructor and destructors are slightly faster when there
+      are no superclasses except Class::Tiny::Object
+
 0.006     2013-09-05 11:56:48 America/New_York
 
     [ADDED]
diff --git a/lib/Class/Tiny.pm b/lib/Class/Tiny.pm
index 2a98f5a..da485ac 100644
--- a/lib/Class/Tiny.pm
+++ b/lib/Class/Tiny.pm
@@ -79,6 +79,8 @@ package Class::Tiny::Object;
 # ABSTRACT: Base class for classes built with Class::Tiny
 # VERSION
 
+my %can_cache;
+
 sub new {
     my $class = shift;
 
@@ -98,16 +100,20 @@ sub new {
 
     # create object and invoke BUILD
     my $self = bless {%$args}, $class;
-    my @search = @{ mro::get_linear_isa($class) };
-    for my $s ( reverse @search ) {
-        my $builder = *{ $s . "::BUILD" }{CODE};
-        $self->$builder($args) if defined $builder;
+    if ( @{"$class\::ISA"} == 1 && ${"$class\::ISA"}[0] eq "Class::Tiny::Object" ) {
+        $self->BUILD($args) if defined *{"$class\::BUILD"};
+    }
+    else {
+        for my $s ( reverse @{ mro::get_linear_isa($class) } ) {
+            &{ *{"$s\::BUILD"}{CODE} }( $self, $args ) if defined *{"$s\::BUILD"}{CODE};
+        }
     }
 
     # unknown attributes still in $args are fatal
     my @bad;
     for my $k ( keys %$args ) {
-        push( @bad, $k ) unless $self->can($k); # a heuristic to catch typos
+        push( @bad, $k )
+          unless $can_cache{$class}{$k} ||= $self->can($k); # a heuristic to catch typos
     }
     Carp::croak("Invalid attributes for $class: @bad") if @bad;
 
@@ -118,21 +124,35 @@ sub new {
 require Devel::GlobalDestruction unless defined ${^GLOBAL_PHASE};
 
 sub DESTROY {
-    my $self = shift;
+    my $self  = shift;
+    my $class = ref $self;
     my $in_global_destruction =
       defined ${^GLOBAL_PHASE}
       ? ${^GLOBAL_PHASE} eq 'DESTRUCT'
       : Devel::GlobalDestruction::in_global_destruction();
-    for my $s ( @{ mro::get_linear_isa( ref $self ) } ) {
-        my $demolisher = *{ $s . "::DEMOLISH" }{CODE};
-        next unless $demolisher;
-        my $e = do {
-            local ( $?, $@ );
-            eval { $self->$demolisher($in_global_destruction) };
-            $@;
-        };
-        no warnings 'misc'; # avoid (in cleanup) warnings
-        die $e if $e;       # rethrow
+    if ( @{"$class\::ISA"} == 1 && ${"$class\::ISA"}[0] eq "Class::Tiny::Object" ) {
+        if ( defined *{"$class\::DEMOLISH"} ) {
+            my $e = do {
+                local ( $?, $@ );
+                eval { $self->DEMOLISH($in_global_destruction) };
+                $@;
+            };
+            no warnings 'misc'; # avoid (in cleanup) warnings
+            die $e if $e;       # rethrow
+        }
+    }
+    else {
+        for my $s ( @{ mro::get_linear_isa($class) } ) {
+            my $demolisher = *{"$s\::DEMOLISH"}{CODE};
+            next unless $demolisher;
+            my $e = do {
+                local ( $?, $@ );
+                eval { $self->$demolisher($in_global_destruction) };
+                $@;
+            };
+            no warnings 'misc'; # avoid (in cleanup) warnings
+            die $e if $e;       # rethrow
+        }
     }
 }
 

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libclass-tiny-perl.git