DynaLoader: Introduce d_libname_unique

Android's linker has some unusual behavior, in that it only uses
the basename of a library in its cache.  That means that, as far as
dlopen() is concerned, the libraries for Hash::Util and List::Util,
both of which are called Util.so, are the same.

This commit teaches DynaLoader about d_libname_unique.  When
defined, it signals DynaLoader define a mod2fname sub that renames
the .so files to something "unique" -- so for example,
Hash/Util/Util.so becomes Hash/Util/PL_Hash__Util.so.

2 files changed, 58 insertions, 3 deletions

diff --git a/ext/DynaLoader/DynaLoader_pm.PL b/ext/DynaLoader/DynaLoader_pm.PL
index f0139f9abe..6c2a3e61ed 100644
--- a/ext/DynaLoader/DynaLoader_pm.PL
+++ b/ext/DynaLoader/DynaLoader_pm.PL
@@ -85,7 +85,7 @@ package DynaLoader;
 # Tim.Bunce@ig.co.uk, August 1994
 
 BEGIN {
-    $VERSION = '1.22';
+    $VERSION = '1.23';
 }
 
 use Config;
@@ -235,6 +235,32 @@ if ($ENV{PERL_BUILD_EXPAND_CONFIG_VARS} && $ENV{PERL_BUILD_EXPAND_ENV_VARS}) {
 EOT
 }
 
+if ( $Config::Config{d_libname_unique} ) {
+    print OUT <<'EOT';
+sub mod2fname {
+    my $parts = shift;
+    my $so_len = length($Config::Config{dlext})+1;
+    my $name_max = 255; # No easy way to get this here
+    
+    my $libname = "PL_" .  join("__", @$parts);
+    
+    return $libname if (length($libname)+$so_len) <= $name_max;
+    
+    # It's too darned big, so we need to go strip. We use the same
+    # algorithm as xsubpp does. First, strip out doubled __
+    $libname =~ s/__/_/g;
+    return $libname if (length($libname)+$so_len) <= $name_max;
+    
+    # Strip duplicate letters
+    1 while $libname =~ s/(.)\1/\U$1/i;
+    return $libname if (length($libname)+$so_len) <= $name_max;
+    
+    # Still too long. Truncate.
+    $libname = substr($libname, 0, $name_max - $so_len);
+    return $libname;
+}
+EOT
+}
 
 # following long string contains $^O-specific stuff, which is factored out
 print OUT expand_os_specific(<<'EOT');
@@ -314,7 +340,7 @@ sub bootstrap {
 	next unless -d $dir; # skip over uninteresting directories
 	
 	# check for common cases to avoid autoload of dl_findfile
-	my $try = "$dir/$modfname.$dl_dlext";
+        my $try = "$dir/$modfname.$dl_dlext";
 	last if $file = ($do_expand) ? dl_expandspec($try) : ((-f $try) && $try);
 	
 	# no luck here, save dir for possible later dl_findfile search
diff --git a/ext/DynaLoader/t/DynaLoader.t b/ext/DynaLoader/t/DynaLoader.t
index 1aa8c4ec60..a95287ae8d 100644
--- a/ext/DynaLoader/t/DynaLoader.t
+++ b/ext/DynaLoader/t/DynaLoader.t
@@ -26,7 +26,7 @@ BEGIN {
     'Time::HiRes'=> q| ::is( ref Time::HiRes->can('usleep'),'CODE' ) |,  # 5.7.3
 );
 
-plan tests => 22 + keys(%modules) * 3;
+plan tests => 26 + keys(%modules) * 3;
 
 
 # Try to load the module
@@ -155,3 +155,32 @@ for my $libref (reverse @DynaLoader::dl_librefs) {
         }
     }
 }
+
+SKIP: {
+    skip "mod2fname not defined on this platform", 4
+        unless defined &DynaLoader::mod2fname && $Config{d_libname_unique};
+
+    is(
+        DynaLoader::mod2fname(["Hash", "Util"]),
+        "PL_Hash__Util",
+        "mod2fname + libname_unique works"
+    );
+
+    is(
+        DynaLoader::mod2fname([("Hash", "Util") x 25]),
+        "PL_" . join("_", ("Hash", "Util")x25),
+        "mod2fname + libname_unique collapses double __'s for long names"
+    );
+
+    is(
+        DynaLoader::mod2fname([("Haash", "Uttil") x 25]),
+        "PL_" . join("_", ("HAsh", "UTil")x25),
+        "mod2fname + libname_unique collapses repeated characters for long names"
+    );
+
+    is(
+        DynaLoader::mod2fname([("Hash", "Util")x30]),
+        substr(("PL_" . join("_", ("Hash", "Util")x30)), 0, 255 - (length($Config::Config{dlext})+1)),
+        "mod2fname + libname_unique correctly truncates long names"
+    );
+}