Changeset 8683 for lang/perl/Class-Component/trunk/lib/Class/Component.pm

Timestamp:

04/03/08 00:14:10 (5 years ago)

Author:

yappo

Message:

lang/perl/Class-Component: 遅くて何回も呼ばれそうな所にキャッシュいれて早くした

Files:

• lang/perl/Class-Component/trunk/lib/Class/Component.pm (modified) (3 diffs)

lang/perl/Class-Component/trunk/lib/Class/Component.pm

@@ -104 +104 @@
     my $pkg;
     if (($pkg = $component) =~ s/^\+// || ($pkg = $c->class_component_load_component_resolver($component))) {
-        if (Class::Inspector->installed($pkg)) {
-            $pkg->require or croak $@;
-        } else {
-            croak "$pkg is not installed";
-        }
+        $pkg->require or croak $@;
     } else {
-        for my $isa_pkg (@{ $class->isa_list_cache($c) }) {
-            my $comp = "$isa_pkg\::Component::$component";
-            next unless Class::Inspector->installed($comp);
-            $comp->require or croak $@;
-            $pkg = $comp;
-            last;
-        }
-        croak "$component is not installed" unless $pkg;
+        unless ($pkg = $class->pkg_require($c => "Component::$component")) {
+            $@ and croak $@;
+            croak "$component is not installed";
+        }
     }
 
@@ -178 +170 @@
         $pkg->require or croak $@;
     } else {
-        for my $isa_pkg (@{ $class->isa_list_cache($class->_class($c)) }) {
-            my $comp = "$isa_pkg\::Plugin::$plugin";
-            next unless Class::Inspector->installed($comp);
-            $comp->require or croak $@;
-            $pkg = $comp;
-            last;
-        }
-        croak "$plugin is not installed" unless $pkg;
+        unless ($pkg = $class->pkg_require($c => "Plugin::$plugin")) {
+            $@ and croak $@;
+            croak "$plugin is not installed";
+        }
     }
 
@@ -388 +376 @@
     my($class, $c) = @_;
     ref($c) || $c;
+}
+
+my %pkg_require_cache = ();
+sub pkg_require_cache_clear { %pkg_require_cache = () }
+my $ins = 0;
+sub _pkg_require {
+    my($class, $pkg) = @_;
+
+    if (exists $pkg_require_cache{$pkg}) {
+        return $pkg_require_cache{$pkg} ? $pkg : undef;
+    }
+    $pkg_require_cache{$pkg} = 0;
+
+    return unless Class::Inspector->installed($pkg);
+    $pkg->require or return;
+    $pkg_require_cache{$pkg} = 1;
+
+    return $pkg;
+}
+sub pkg_require {
+    my($class, $c, $pkg) = @_;
+
+    my $pkg2;
+    if (($pkg2 = $pkg) =~ s/^\+//) {
+        return $class->_pkg_require($pkg2);
+    }
+    for my $isa_pkg (@{ $class->isa_list_cache($c) }) {
+        my $ret = $class->_pkg_require("$isa_pkg\::$pkg");
+        return $ret if $ret;
+        return if $@;
+    }
 }