optimization: do not repeatedly try to load the same non-existent URI subclass

3 files changed, 21 insertions, 10 deletions

diff --git a/Changes b/Changes
index 86d6d96..6f1703b 100644
--- a/Changes
+++ b/Changes
@@ -4,6 +4,11 @@ Revision history for URI
 
     - Localize $@ when attempting to load URI subclasses (PR#30)
 
+  Karen Etheridge:
+
+    - speed up construction time by not attempting to load the same
+      non-existent URI subclass twice
+
 
 2015-07-25   Karen Etheridge <ether@cpan.org>
 
diff --git a/lib/URI.pm b/lib/URI.pm
index c472413..542f4de 100644
--- a/lib/URI.pm
+++ b/lib/URI.pm
@@ -94,6 +94,7 @@ sub _uric_escape
     return $str;
 }
 
+my %require_attempted;
 
 sub implementor
 {
@@ -128,11 +129,13 @@ sub implementor
     no strict 'refs';
     # check we actually have one for the scheme:
     unless (@{"${ic}::ISA"}) {
-        # Try to load it
-        my $_old_error = $@;
-        eval "require $ic";
-        die $@ if $@ && $@ !~ /Can\'t locate.*in \@INC/;
-        $@ = $_old_error;
+        if (not exists $require_attempted{$ic}) {
+            # Try to load it
+            my $_old_error = $@;
+            eval "require $ic";
+            die $@ if $@ && $@ !~ /Can\'t locate.*in \@INC/;
+            $@ = $_old_error;
+        }
         return undef unless @{"${ic}::ISA"};
     }
 
diff --git a/lib/URI/urn.pm b/lib/URI/urn.pm
index 4f0fbba..941940a 100644
--- a/lib/URI/urn.pm
+++ b/lib/URI/urn.pm
@@ -10,6 +10,7 @@ use parent 'URI';
 use Carp qw(carp);
 
 my %implementor;
+my %require_attempted;
 
 sub _init {
     my $class = shift;
@@ -29,11 +30,13 @@ sub _init {
 	$impclass = "URI::urn::$id";
 	no strict 'refs';
 	unless (@{"${impclass}::ISA"}) {
-	    # Try to load it
-            my $_old_error = $@;
-	    eval "require $impclass";
-	    die $@ if $@ && $@ !~ /Can\'t locate.*in \@INC/;
-            $@ = $old_error;
+            if (not exists $require_attempted{$impclass}) {
+                # Try to load it
+                my $_old_error = $@;
+                eval "require $impclass";
+                die $@ if $@ && $@ !~ /Can\'t locate.*in \@INC/;
+                $@ = $_old_error;
+            }
 	    $impclass = "URI::urn" unless @{"${impclass}::ISA"};
 	}
     }