From: Yuval Kogman <nothingmuch@woobling.org>
Date: Sat, 9 Aug 2008 05:17:58 +0000 (+0000)
Subject: use mro::get_isarev if available
X-Git-Tag: 0_64_01~64
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9efe16ca2dc9eeb791af15d3e4f9f993696376f7;p=gitmo%2FClass-MOP.git

use mro::get_isarev if available
---

diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm
index efa1166..4af7900 100644
--- a/lib/Class/MOP.pm
+++ b/lib/Class/MOP.pm
@@ -24,6 +24,10 @@ BEGIN {
         ? sub () { 0 }
         : sub () { 1 };    
 
+    *HAVE_ISAREV = defined(&mro::get_isarev)
+        ? sub () { 1 }
+        : sub () { 1 };
+
     # NOTE:
     # we may not use this yet, but once 
     # the get_code_info XS gets merged 
@@ -972,6 +976,11 @@ We set this constant depending on what version perl we are on, this
 allows us to take advantage of new 5.10 features and stay backwards 
 compat.
 
+=item I<HAVE_ISAREV>
+
+Whether or not C<mro> provides C<get_isarev>, a much faster way to get all the
+subclasses of a certain class.
+
 =back
 
 =head2 Utility functions
diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index f517a56..b8834a6 100644
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -496,44 +496,49 @@ sub subclasses {
     my $self = shift;
 
     my $super_class = $self->name;
-    my @derived_classes;
-    
-    my $find_derived_classes;
-    $find_derived_classes = sub {
-        my ($outer_class) = @_;
 
-        my $symbol_table_hashref = do { no strict 'refs'; \%{"${outer_class}::"} };
+    if ( Class::MOP::HAVE_ISAREV() ) {
+        return @{ $super_class->mro::get_isarev() };
+    } else {
+        my @derived_classes;
 
-        SYMBOL:
-        for my $symbol ( keys %$symbol_table_hashref ) {
-            next SYMBOL if $symbol !~ /\A (\w+):: \z/x;
-            my $inner_class = $1;
+        my $find_derived_classes;
+        $find_derived_classes = sub {
+            my ($outer_class) = @_;
 
-            next SYMBOL if $inner_class eq 'SUPER';    # skip '*::SUPER'
+            my $symbol_table_hashref = do { no strict 'refs'; \%{"${outer_class}::"} };
 
-            my $class =
-              $outer_class
-              ? "${outer_class}::$inner_class"
-              : $inner_class;
+            SYMBOL:
+            for my $symbol ( keys %$symbol_table_hashref ) {
+                next SYMBOL if $symbol !~ /\A (\w+):: \z/x;
+                my $inner_class = $1;
 
-            if ( $class->isa($super_class) and $class ne $super_class ) {
-                push @derived_classes, $class;
-            }
+                next SYMBOL if $inner_class eq 'SUPER';    # skip '*::SUPER'
 
-            next SYMBOL if $class eq 'main';           # skip 'main::*'
+                my $class =
+                $outer_class
+                ? "${outer_class}::$inner_class"
+                : $inner_class;
 
-            $find_derived_classes->($class);
-        }
-    };
+                if ( $class->isa($super_class) and $class ne $super_class ) {
+                    push @derived_classes, $class;
+                }
 
-    my $root_class = q{};
-    $find_derived_classes->($root_class);
+                next SYMBOL if $class eq 'main';           # skip 'main::*'
 
-    undef $find_derived_classes;
+                $find_derived_classes->($class);
+            }
+        };
+
+        my $root_class = q{};
+        $find_derived_classes->($root_class);
 
-    @derived_classes = sort { $a->isa($b) ? 1 : $b->isa($a) ? -1 : 0 } @derived_classes;
+        undef $find_derived_classes;
 
-    return @derived_classes;
+        @derived_classes = sort { $a->isa($b) ? 1 : $b->isa($a) ? -1 : 0 } @derived_classes;
+
+        return @derived_classes;
+    }
 }