1N/Ause Config;

1N/A

1N/Asub to_string {

1N/A my ($value) = @_;

1N/A $value =~ s/\\/\\\\/g;

1N/A $value =~ s/'/\\'/g;

1N/A return "'$value'";

1N/A}

1N/A

1N/Aunlink "DynaLoader.pm" if -f "DynaLoader.pm";

1N/Aopen OUT, ">DynaLoader.pm" or die $!;

1N/Aprint OUT <<'EOT';

1N/A

1N/A

1N/Apackage DynaLoader;

1N/A

1N/A

1N/A

1N/Ause vars qw($VERSION *AUTOLOAD);

1N/A

1N/A$VERSION = '1.05'; # avoid typo warning

1N/A

1N/Arequire AutoLoader;

1N/A*AUTOLOAD = \&AutoLoader::AUTOLOAD;

1N/A

1N/Ause Config;

1N/A

1N/Arequire Carp if $] < 5.00450;

1N/A

1N/A$dl_debug = $ENV{PERL_DL_DEBUG} || 0 unless defined $dl_debug;

1N/A

1N/A

1N/Asub dl_load_flags { 0x00 }

1N/A

1N/A

1N/Aprint OUT " (\$dl_dlext, \$dlsrc) = (",

1N/A to_string($Config::Config{'dlext'}), ",",

1N/A to_string($Config::Config{'dlsrc'}), ")\n;" ;

1N/A

1N/Aprint OUT <<'EOT';

1N/A

1N/A$Is_VMS = $^O eq 'VMS';

1N/A$do_expand = $Is_VMS;

1N/A$Is_MacOS = $^O eq 'MacOS';

1N/A

1N/Amy $Mac_FS;

1N/A$Mac_FS = eval { require Mac::FileSpec::Unixish } if $Is_MacOS;

1N/A

1N/A@dl_shared_objects = (); # shared objects for symbols we have

1N/A@dl_require_symbols = (); # names of symbols we need

1N/A@dl_resolve_using = (); # names of files to link with

1N/A@dl_library_path = (); # path to look for files

1N/A

1N/A

1N/A@dl_resolve_using = dl_findfile('-lc') if $dlsrc eq "dl_dld.xs";

1N/A

1N/A

1N/Amy $cfg_dl_library_path = <<'EOT';

1N/Apush(@dl_library_path, split(' ', $Config::Config{libpth}));

1N/A

1N/Asub dquoted_comma_list {

1N/A join(", ", map {qq("$_")} @_);

1N/A}

1N/A

1N/Aif ($ENV{PERL_BUILD_EXPAND_CONFIG_VARS}) {

1N/A eval $cfg_dl_library_path;

1N/A if (!$ENV{PERL_BUILD_EXPAND_ENV_VARS}) {

1N/A my $dl_library_path = dquoted_comma_list(@dl_library_path);

1N/A print OUT <<EOT;

1N/A

1N/A\@dl_library_path = ($dl_library_path);

1N/A

1N/A }

1N/A}

1N/Aelse {

1N/A print OUT <<EOT;

1N/A

1N/A$cfg_dl_library_path

1N/A

1N/A}

1N/A

1N/Amy $ldlibpthname;

1N/Amy $ldlibpthname_defined;

1N/Amy $pthsep;

1N/A

1N/Aif ($ENV{PERL_BUILD_EXPAND_CONFIG_VARS}) {

1N/A $ldlibpthname = $Config::Config{ldlibpthname};

1N/A $ldlibpthname_defined = defined $Config::Config{ldlibpthname} ? 1 : 0;

1N/A $pthsep = $Config::Config{path_sep};

1N/A}

1N/Aelse {

1N/A $ldlibpthname = q($Config::Config{ldlibpthname});

1N/A $ldlibpthname_defined = q(defined $Config::Config{ldlibpthname});

1N/A $pthsep = q($Config::Config{path_sep});

1N/A print OUT <<EOT;

1N/Amy \$ldlibpthname = $ldlibpthname;

1N/Amy \$ldlibpthname_defined = $ldlibpthname_defined;

1N/Amy \$pthsep = $pthsep;

1N/A

1N/A}

1N/A

1N/Amy $env_dl_library_path = <<'EOT';

1N/Aif ($ldlibpthname_defined &&

1N/A exists $ENV{$ldlibpthname}) {

1N/A push(@dl_library_path, split(/$pthsep/, $ENV{$ldlibpthname}));

1N/A}

1N/A

1N/A

1N/Aif ($ldlibpthname_defined &&

1N/A $ldlibpthname ne 'LD_LIBRARY_PATH' &&

1N/A exists $ENV{LD_LIBRARY_PATH}) {

1N/A push(@dl_library_path, split(/$pthsep/, $ENV{LD_LIBRARY_PATH}));

1N/A}

1N/A

1N/Aif ($ENV{PERL_BUILD_EXPAND_CONFIG_VARS} && $ENV{PERL_BUILD_EXPAND_ENV_VARS}) {

1N/A eval $env_dl_library_path;

1N/A}

1N/Aelse {

1N/A print OUT <<EOT;

1N/A

1N/A$env_dl_library_path

1N/A

1N/A}

1N/A

1N/Aif ($ENV{PERL_BUILD_EXPAND_CONFIG_VARS} && $ENV{PERL_BUILD_EXPAND_ENV_VARS}) {

1N/A my $dl_library_path = dquoted_comma_list(@dl_library_path);

1N/A print OUT <<EOT;

1N/A

1N/A\@dl_library_path = ($dl_library_path);

1N/A

1N/A}

1N/A

1N/Aprint OUT <<'EOT';

1N/Aboot_DynaLoader('DynaLoader') if defined(&boot_DynaLoader) &&

1N/A !defined(&dl_error);

1N/A

1N/Aif ($dl_debug) {

1N/A print STDERR "DynaLoader.pm loaded (@INC, @dl_library_path)\n";

1N/A print STDERR "DynaLoader not linked into this perl\n"

1N/A unless defined(&boot_DynaLoader);

1N/A}

1N/A

1N/A1; # End of main code

1N/A

1N/A

1N/Asub croak { require Carp; Carp::croak(@_) }

1N/A

1N/Asub bootstrap_inherit {

1N/A my $module = $_[0];

1N/A local *isa = *{"$module\::ISA"};

1N/A local @isa = (@isa, 'DynaLoader');

1N/A # Cannot goto due to delocalization. Will report errors on a wrong line?

1N/A bootstrap(@_);

1N/A}

1N/A

1N/A

1N/Asub bootstrap {

1N/A # use local vars to enable $module.bs script to edit values

1N/A local(@args) = @_;

1N/A local($module) = $args[0];

1N/A local(@dirs, $file);

1N/A

1N/A unless ($module) {

1N/A require Carp;

1N/A Carp::confess("Usage: DynaLoader::bootstrap(module)");

1N/A }

1N/A

1N/A # A common error on platforms which don't support dynamic loading.

1N/A # Since it's fatal and potentially confusing we give a detailed message.

1N/A croak("Can't load module $module, dynamic loading not available in this perl.\n".

1N/A " (You may need to build a new perl executable which either supports\n".

1N/A " dynamic loading or has the $module module statically linked into it.)\n")

1N/A unless defined(&dl_load_file);

1N/A

1N/A

1N/Aprint OUT <<'EOT' if $^O eq 'os2';

1N/A # Can dynaload, but cannot dynaload Perl modules...

1N/A die 'Dynaloaded Perl modules are not available in this build of Perl' if $OS2::is_static;

1N/A

1N/A

1N/Aprint OUT <<'EOT';

1N/A my @modparts = split(/::/,$module);

1N/A my $modfname = $modparts[-1];

1N/A

1N/A # Some systems have restrictions on files names for DLL's etc.

1N/A # mod2fname returns appropriate file base name (typically truncated)

1N/A # It may also edit @modparts if required.

1N/A $modfname = &mod2fname(\@modparts) if defined &mod2fname;

1N/A

1N/A # Truncate the module name to 8.3 format for NetWare

1N/A if (($^O eq 'NetWare') && (length($modfname) > 8)) {

1N/A $modfname = substr($modfname, 0, 8);

1N/A }

1N/A

1N/A my $modpname = join(($Is_MacOS ? ':' : '/'),@modparts);

1N/A

1N/A print STDERR "DynaLoader::bootstrap for $module ",

1N/A ($Is_MacOS

1N/A ? "(:auto:$modpname:$modfname.$dl_dlext)\n" :

1N/A "(auto/$modpname/$modfname.$dl_dlext)\n")

1N/A if $dl_debug;

1N/A

1N/A foreach (@INC) {

1N/A chop($_ = VMS::Filespec::unixpath($_)) if $Is_VMS;

1N/A my $dir;

1N/A if ($Is_MacOS) {

1N/A my $path = $_;

1N/A if ($Mac_FS && ! -d $path) {

1N/A $path = Mac::FileSpec::Unixish::nativize($path);

1N/A }

1N/A $path .= ":" unless /:$/;

1N/A $dir = "${path}auto:$modpname";

1N/A } else {

1N/A $dir = "$_/auto/$modpname";

1N/A }

1N/A

1N/A next unless -d $dir; # skip over uninteresting directories

1N/A

1N/A # check for common cases to avoid autoload of dl_findfile

1N/A my $try = $Is_MacOS ? "$dir:$modfname.$dl_dlext" : "$dir/$modfname.$dl_dlext";

1N/A last if $file = ($do_expand) ? dl_expandspec($try) : ((-f $try) && $try);

1N/A

1N/A # no luck here, save dir for possible later dl_findfile search

1N/A push @dirs, $dir;

1N/A }

1N/A # last resort, let dl_findfile have a go in all known locations

1N/A $file = dl_findfile(map("-L$_",@dirs,@INC), $modfname) unless $file;

1N/A

1N/A croak("Can't locate loadable object for module $module in \@INC (\@INC contains: @INC)")

1N/A unless $file; # wording similar to error from 'require'

1N/A

1N/A $file = uc($file) if $Is_VMS && $Config::Config{d_vms_case_sensitive_symbols};

1N/A my $bootname = "boot_$module";

1N/A $bootname =~ s/\W/_/g;

1N/A @dl_require_symbols = ($bootname);

1N/A

1N/A # Execute optional '.bootstrap' perl script for this module.

1N/A # The .bs file can be used to configure @dl_resolve_using etc to

1N/A # match the needs of the individual module on this architecture.

1N/A my $bs = $file;

1N/A $bs =~ s/(\.\w+)?(;\d*)?$/\.bs/; # look for .bs 'beside' the library

1N/A if (-s $bs) { # only read file if it's not empty

1N/A print STDERR "BS: $bs ($^O, $dlsrc)\n" if $dl_debug;

1N/A eval { do $bs; };

1N/A warn "$bs: $@\n" if $@;

1N/A }

1N/A

1N/A my $boot_symbol_ref;

1N/A

1N/A if ($^O eq 'darwin') {

1N/A if ($boot_symbol_ref = dl_find_symbol(0, $bootname)) {

1N/A goto boot; #extension library has already been loaded, e.g. darwin

1N/A }

1N/A }

1N/A

1N/A # Many dynamic extension loading problems will appear to come from

1N/A # this section of code: XYZ failed at line 123 of DynaLoader.pm.

1N/A # Often these errors are actually occurring in the initialisation

1N/A # C code of the extension XS file. Perl reports the error as being

1N/A # in this perl code simply because this was the last perl code

1N/A # it executed.

1N/A

1N/A my $libref = dl_load_file($file, $module->dl_load_flags) or

1N/A croak("Can't load '$file' for module $module: ".dl_error());

1N/A

1N/A push(@dl_librefs,$libref); # record loaded object

1N/A

1N/A my @unresolved = dl_undef_symbols();

1N/A if (@unresolved) {

1N/A require Carp;

1N/A Carp::carp("Undefined symbols present after loading $file: @unresolved\n");

1N/A }

1N/A

1N/A $boot_symbol_ref = dl_find_symbol($libref, $bootname) or

1N/A croak("Can't find '$bootname' symbol in $file\n");

1N/A

1N/A push(@dl_modules, $module); # record loaded module

1N/A

1N/A boot:

1N/A my $xs = dl_install_xsub("${module}::bootstrap", $boot_symbol_ref, $file);

1N/A

1N/A # See comment block above

1N/A

1N/A push(@dl_shared_objects, $file); # record files loaded

1N/A

1N/A &$xs(@args);

1N/A}

1N/A

1N/A

1N/A

1N/A

1N/A

1N/A

1N/Asub dl_findfile {

1N/A # Read ext/DynaLoader/DynaLoader.doc for detailed information.

1N/A # This function does not automatically consider the architecture

1N/A # or the perl library auto directories.

1N/A my (@args) = @_;

1N/A my (@dirs, $dir); # which directories to search

1N/A my (@found); # full paths to real files we have found

1N/A

1N/Aprint OUT ' my $dl_ext= ' . to_string($Config::Config{'dlext'}) .

1N/A "; # \$Config::Config{'dlext'} suffix for perl extensions\n";

1N/Aprint OUT ' my $dl_so = ' . to_string($Config::Config{'so'}) .

1N/A "; # \$Config::Config{'so'} suffix for shared libraries\n";

1N/A

1N/Aprint OUT <<'EOT';

1N/A

1N/A print STDERR "dl_findfile(@args)\n" if $dl_debug;

1N/A

1N/A # accumulate directories but process files as they appear

1N/A arg: foreach(@args) {

1N/A # Special fast case: full filepath requires no search

1N/A if ($Is_VMS && m%[:>/\]]% && -f $_) {

1N/A push(@found,dl_expandspec(VMS::Filespec::vmsify($_)));

1N/A last arg unless wantarray;

1N/A next;

1N/A }

1N/A elsif ($Is_MacOS) {

1N/A if (m/:/ && -f $_) {

1N/A push(@found,$_);

1N/A last arg unless wantarray;

1N/A }

1N/A }

1N/A elsif (m:/: && -f $_ && !$do_expand) {

1N/A push(@found,$_);

1N/A last arg unless wantarray;

1N/A next;

1N/A }

1N/A

1N/A # Deal with directories first:

1N/A # Using a -L prefix is the preferred option (faster and more robust)

1N/A if (m:^-L:) { s/^-L//; push(@dirs, $_); next; }

1N/A

1N/A if ($Is_MacOS) {

1N/A # Otherwise we try to try to spot directories by a heuristic

1N/A # (this is a more complicated issue than it first appears)

1N/A if (m/:/ && -d $_) { push(@dirs, $_); next; }

1N/A # Only files should get this far...

1N/A my(@names, $name); # what filenames to look for

1N/A s/^-l//;

1N/A push(@names, $_);

1N/A foreach $dir (@dirs, @dl_library_path) {

1N/A next unless -d $dir;

1N/A $dir =~ s/^([^:]+)$/:$1/;

1N/A $dir =~ s/:$//;

1N/A foreach $name (@names) {

1N/A my($file) = "$dir:$name";

1N/A print STDERR " checking in $dir for $name\n" if $dl_debug;

1N/A if (-f $file) {

1N/A push(@found, $file);

1N/A next arg; # no need to look any further

1N/A }

1N/A }

1N/A }

1N/A next;

1N/A }

1N/A

1N/A # Otherwise we try to try to spot directories by a heuristic

1N/A # (this is a more complicated issue than it first appears)

1N/A if (m:/: && -d $_) { push(@dirs, $_); next; }

1N/A

1N/A # VMS: we may be using native VMS directory syntax instead of

1N/A # Unix emulation, so check this as well

1N/A if ($Is_VMS && /[:>\]]/ && -d $_) { push(@dirs, $_); next; }

1N/A

1N/A # Only files should get this far...

1N/A my(@names, $name); # what filenames to look for

1N/A if (m:-l: ) { # convert -lname to appropriate library name

1N/A s/-l//;

1N/A push(@names,"lib$_.$dl_so");

1N/A push(@names,"lib$_.a");

1N/A } else { # Umm, a bare name. Try various alternatives:

1N/A # these should be ordered with the most likely first

1N/A push(@names,"$_.$dl_ext") unless m/\.$dl_ext$/o;

1N/A push(@names,"$_.$dl_so") unless m/\.$dl_so$/o;

1N/A push(@names,"lib$_.$dl_so") unless m:/:;

1N/A push(@names,"$_.a") if !m/\.a$/ and $dlsrc eq "dl_dld.xs";

1N/A push(@names, $_);

1N/A }

1N/A foreach $dir (@dirs, @dl_library_path) {

1N/A next unless -d $dir;

1N/A chop($dir = VMS::Filespec::unixpath($dir)) if $Is_VMS;

1N/A foreach $name (@names) {

1N/A my($file) = "$dir/$name";

1N/A print STDERR " checking in $dir for $name\n" if $dl_debug;

1N/A $file = ($do_expand) ? dl_expandspec($file) : (-f $file && $file);

1N/A #$file = _check_file($file);

1N/A if ($file) {

1N/A push(@found, $file);

1N/A next arg; # no need to look any further

1N/A }

1N/A }

1N/A }

1N/A }

1N/A if ($dl_debug) {

1N/A foreach(@dirs) {

1N/A print STDERR " dl_findfile ignored non-existent directory: $_\n" unless -d $_;

1N/A }

1N/A print STDERR "dl_findfile found: @found\n";

1N/A }

1N/A return $found[0] unless wantarray;

1N/A @found;

1N/A}

1N/A

1N/A

1N/Asub dl_expandspec {

1N/A my($spec) = @_;

1N/A # Optional function invoked if DynaLoader.pm sets $do_expand.

1N/A # Most systems do not require or use this function.

1N/A # Some systems may implement it in the dl_*.xs file in which case

1N/A # this autoload version will not be called but is harmless.

1N/A

1N/A # This function is designed to deal with systems which treat some

1N/A # 'filenames' in a special way. For example VMS 'Logical Names'

1N/A # (something like unix environment variables - but different).

1N/A # This function should recognise such names and expand them into

1N/A # full file paths.

1N/A # Must return undef if $spec is invalid or file does not exist.

1N/A

1N/A my $file = $spec; # default output to input

1N/A

1N/A if ($Is_VMS) { # dl_expandspec should be defined in dl_vms.xs

1N/A require Carp;

1N/A Carp::croak("dl_expandspec: should be defined in XS file!\n");

1N/A } else {

1N/A return undef unless -f $file;

1N/A }

1N/A print STDERR "dl_expandspec($spec) => $file\n" if $dl_debug;

1N/A $file;

1N/A}

1N/A

1N/Asub dl_find_symbol_anywhere

1N/A{

1N/A my $sym = shift;

1N/A my $libref;

1N/A foreach $libref (@dl_librefs) {

1N/A my $symref = dl_find_symbol($libref,$sym);

1N/A return $symref if $symref;

1N/A }

1N/A return undef;

1N/A}

1N/A

1N/A

1N/Aclose OUT or die $!;

1N/A