}
unlink "DynaLoader.pm" if -f "DynaLoader.pm";
-open OUT, ">DynaLoader.pm" or die $!;
+open OUT, '>', "DynaLoader.pm" or die $!;
print OUT <<'EOT';
-# Generated from DynaLoader_pm.PL
+# Generated from DynaLoader_pm.PL, this file is unique for every OS
package DynaLoader;
# Tim.Bunce@ig.co.uk, August 1994
BEGIN {
- $VERSION = '1.11';
+ $VERSION = '1.42';
}
-require AutoLoader;
-*AUTOLOAD = \&AutoLoader::AUTOLOAD;
+EOT
-use Config;
+if (!$ENV{PERL_BUILD_EXPAND_CONFIG_VARS}) {
+ print OUT "use Config;\n";
+}
+
+print OUT <<'EOT';
# enable debug/trace messages from DynaLoader perl code
$dl_debug = $ENV{PERL_DL_DEBUG} || 0 unless defined $dl_debug;
# 0x01 make symbols available for linking later dl_load_file's.
# (only known to work on Solaris 2 using dlopen(RTLD_GLOBAL))
# (ignored under VMS; effect is built-in to image linking)
+# (ignored under Android; the linker always uses RTLD_LOCAL)
#
# This is called as a class method $module->dl_load_flags. The
# definition here will be inherited and result on "default" loading
<</$^O-eq-VMS>>
$do_expand = <<$^O-eq-VMS>>1<<|$^O-eq-VMS>>0<</$^O-eq-VMS>>;
-@dl_require_symbols = (); # names of symbols we need
-@dl_resolve_using = (); # names of files to link with
+@dl_require_symbols = (); # names of symbols we need<<$^O-eq-freemint>>
+@dl_resolve_using = (); # names of files to link with<</$^O-eq-freemint>><<$^O-eq-hpux>>
+@dl_resolve_using = (); # names of files to link with<</$^O-eq-hpux>>
@dl_library_path = (); # path to look for files
#XSLoader.pm may have added elements before we were required
#@dl_librefs = (); # things we have loaded
#@dl_modules = (); # Modules we have loaded
-# This is a fix to support DLD's unfortunate desire to relink -lc
-@dl_resolve_using = dl_findfile('-lc') if $dlsrc eq "dl_dld.xs";
-
EOT
my $cfg_dl_library_path = <<'EOT';
EOT
}
+if ( $Config::Config{d_libname_unique} ) {
+ printf OUT <<'EOT', length($Config::Config{dlext}) + 1;
+sub mod2fname {
+ my $parts = shift;
+ my $so_len = %d;
+ 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');
bootstrap(@_);
}
-# The bootstrap function cannot be autoloaded (without complications)
-# so we define it here:
-
sub bootstrap {
# use local vars to enable $module.bs script to edit values
local(@args) = @_;
<</$^O-eq-os2>>
my @modparts = split(/::/,$module);
my $modfname = $modparts[-1];
+ my $modfname_orig = $modfname; # For .bs file search
# Some systems have restrictions on files names for DLL's etc.
# mod2fname returns appropriate file base name (typically truncated)
"(auto/$modpname/$modfname.$dl_dlext)\n"
if $dl_debug;
+ my $dir;
foreach (@INC) {
<<$^O-eq-VMS>>chop($_ = VMS::Filespec::unixpath($_));<</$^O-eq-VMS>>
- my $dir = "$_/auto/$modpname";
+ $dir = "$_/auto/$modpname";
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
# Execute optional '.bootstrap' perl script for this module.
# The .bs file can be used to configure @dl_resolve_using etc to
# match the needs of the individual module on this architecture.
- my $bs = $file;
+ # N.B. The .bs file does not following the naming convention used
+ # by mod2fname.
+ my $bs = "$dir/$modfname_orig";
$bs =~ s/(\.\w+)?(;\d*)?$/\.bs/; # look for .bs 'beside' the library
if (-s $bs) { # only read file if it's not empty
print STDERR "BS: $bs ($^O, $dlsrc)\n" if $dl_debug;
- eval { do $bs; };
+ eval { local @INC = ('.'); do $bs; };
warn "$bs: $@\n" if $@;
}
my $boot_symbol_ref;
<<$^O-eq-darwin>>
- if ($boot_symbol_ref = dl_find_symbol(0, $bootname)) {
+ if ($boot_symbol_ref = dl_find_symbol(0, $bootname, 1)) {
goto boot; #extension library has already been loaded, e.g. darwin
}
<</$^O-eq-darwin>>
# in this perl code simply because this was the last perl code
# it executed.
- my $libref = dl_load_file($file, $module->dl_load_flags) or
+ my $flags = $module->dl_load_flags;
+ <<$^O-eq-android>>
+ # See the note above regarding the linker.
+ $flags = 0x00;
+ <</$^O-eq-android>>
+ my $libref = dl_load_file($file, $flags) or
croak("Can't load '$file' for module $module: ".dl_error());
push(@dl_librefs,$libref); # record loaded object
-
+<<$^O-eq-freemint>>
my @unresolved = dl_undef_symbols();
if (@unresolved) {
require Carp;
Carp::carp("Undefined symbols present after loading $file: @unresolved\n");
}
-
+<</$^O-eq-freemint>>
$boot_symbol_ref = dl_find_symbol($libref, $bootname) or
croak("Can't find '$bootname' symbol in $file\n");
&$xs(@args);
}
-
-#sub _check_file { # private utility to handle dl_expandspec vs -f tests
-# my($file) = @_;
-# return $file if (!$do_expand && -f $file); # the common case
-# return $file if ( $do_expand && ($file=dl_expandspec($file)));
-# return undef;
-#}
-
-
-# Let autosplit and the autoloader deal with these functions:
-__END__
-
-
sub dl_findfile {
- # Read ext/DynaLoader/DynaLoader.doc for detailed information.
# This function does not automatically consider the architecture
# or the perl library auto directories.
my (@args) = @_;
# these should be ordered with the most likely first
push(@names,"$_.$dl_dlext") unless m/\.$dl_dlext$/o;
push(@names,"$_.$dl_so") unless m/\.$dl_so$/o;
+ <<$^O-eq-cygwin>>
+ push(@names,"cyg$_.$dl_so") unless m:/:;
+ <</$^O-eq-cygwin>>
push(@names,"lib$_.$dl_so") unless m:/:;
- push(@names,"$_.a") if !m/\.a$/ and $dlsrc eq "dl_dld.xs";
push(@names, $_);
}
my $dirsep = '/';
}
+<<$^O-eq-VMS>>
+# dl_expandspec should be defined in dl_vms.xs
+<<|$^O-eq-VMS>>
sub dl_expandspec {
my($spec) = @_;
# Optional function invoked if DynaLoader.pm sets $do_expand.
# Most systems do not require or use this function.
# Some systems may implement it in the dl_*.xs file in which case
- # this autoload version will not be called but is harmless.
+ # this Perl version should be excluded at build time.
# This function is designed to deal with systems which treat some
# 'filenames' in a special way. For example VMS 'Logical Names'
my $file = $spec; # default output to input
- <<$^O-eq-VMS>>
- # dl_expandspec should be defined in dl_vms.xs
- require Carp;
- Carp::croak("dl_expandspec: should be defined in XS file!\n");
- <<|$^O-eq-VMS>>
return undef unless -f $file;
- <</$^O-eq-VMS>>
print STDERR "dl_expandspec($spec) => $file\n" if $dl_debug;
$file;
}
+<</$^O-eq-VMS>>
sub dl_find_symbol_anywhere
{
my $sym = shift;
my $libref;
foreach $libref (@dl_librefs) {
- my $symref = dl_find_symbol($libref,$sym);
+ my $symref = dl_find_symbol($libref,$sym,1);
return $symref if $symref;
}
return undef;
}
+__END__
+
=head1 NAME
DynaLoader - Dynamically load C libraries into Perl code
The DynaLoader is designed to be a very simple high-level
interface that is sufficiently general to cover the requirements
-of SunOS, HP-UX, NeXT, Linux, VMS and other platforms.
+of SunOS, HP-UX, Linux, VMS and other platforms.
It is also hoped that the interface will cover the needs of OS/2, NT
etc and also allow pseudo-dynamic linking (using C<ld -A> at runtime).
@dl_resolve_using
@dl_require_symbols
$dl_debug
+ $dl_dlext
@dl_librefs
@dl_modules
@dl_shared_objects
PERL_DL_DEBUG environment variable. Set to 1 for minimal information or
higher for more.
+=item $dl_dlext
+
+When specified (localised) in a module's F<.pm> file, indicates the extension
+which the module's loadable object will have. For example:
+
+ local $DynaLoader::dl_dlext = 'unusual_ext';
+
+would indicate that the module's loadable object has an extension of
+C<unusual_ext> instead of the more usual C<$Config{dlext}>. NOTE: This also
+requires that the module's F<Makefile.PL> specify (in C<WriteMakefile()>):
+
+ DLEXT => 'unusual_ext',
+
=item dl_findfile()
Syntax:
order to deal with symbolic names for files (i.e., VMS's Logical Names).
To support these systems a dl_expandspec() function can be implemented
-either in the F<dl_*.xs> file or code can be added to the autoloadable
-dl_expandspec() function in F<DynaLoader.pm>. See F<DynaLoader.pm> for
-more information.
+either in the F<dl_*.xs> file or code can be added to the dl_expandspec()
+function in F<DynaLoader.pm>. See F<DynaLoader_pm.PL> for more information.
=item dl_load_file()
SunOS: dlopen($filename)
HP-UX: shl_load($filename)
Linux: dld_create_reference(@dl_require_symbols); dld_link($filename)
- NeXT: rld_load($filename, @dl_resolve_using)
VMS: lib$find_image_symbol($filename,$dl_require_symbols[0])
(The dlopen() function is also used by Solaris and some versions of
Dynamically unload $libref, which must be an opaque 'library reference' as
returned from dl_load_file. Returns one on success and zero on failure.
-
This function is optional and may not necessarily be provided on all platforms.
-If it is defined, it is called automatically when the interpreter exits for
+
+If it is defined and perl is compiled with the C macro C<DL_UNLOAD_ALL_AT_EXIT>
+defined, then it is called automatically when the interpreter exits for
every shared object or library loaded by DynaLoader::bootstrap. All such
library references are stored in @dl_librefs by DynaLoader::Bootstrap as it
loads the libraries. The files are unloaded in last-in, first-out order.
SunOS: dlclose($libref)
HP-UX: ???
Linux: ???
- NeXT: ???
VMS: ???
(The dlclose() function is also used by Solaris and some versions of
SunOS: dlsym($libref, $symbol)
HP-UX: shl_findsym($libref, $symbol)
Linux: dld_get_func($symbol) and/or dld_get_symbol($symbol)
- NeXT: rld_lookup("_$symbol")
VMS: lib$find_image_symbol($libref,$symbol)
Create a new Perl external subroutine named $perl_name using $symref as
a pointer to the function which implements the routine. This is simply
-a direct call to newXSUB(). Returns a reference to the installed
+a direct call to newXS()/newXS_flags(). Returns a reference to the installed
function.
The $filename parameter is used by Perl to identify the source file for