ext/DynaLoader/DynaLoader.pm

   1 package DynaLoader;
   2
   3 #
   4 #   And Gandalf said: 'Many folk like to know beforehand what is to
   5 #   be set on the table; but those who have laboured to prepare the
   6 #   feast like to keep their secret; for wonder makes the words of
   7 #   praise louder.'
   8 #
   9
  10 # Quote from Tolkien sugested by Anno Siegel.
  11 #
  12 # Read ext/DynaLoader/README and DynaLoader.doc for
  13 # detailed information.
  14 #
  15 # Tim.Bunce@ig.co.uk, August 1994
  16
  17 use Config;
  18 use Carp;
  19 use AutoLoader;
  20
  21 @ISA=qw(AutoLoader);
  22
  23
  24 # enable messages from DynaLoader perl code
  25 $dl_debug = 0 unless $dl_debug;
  26 $dl_debug = $ENV{'PERL_DL_DEBUG'} if $ENV{'PERL_DL_DEBUG'};
  27
  28 $dl_so = $dl_dlext = ""; # avoid typo warnings
  29 $dl_so = $Config{'so'}; # suffix for shared libraries
  30 $dl_dlext = $Config{'dlext'}; # suffix for dynamic modules
  31
  32 # Some systems need special handling to expand file specifications
  33 # (VMS support by Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU>)
  34 # See dl_expandspec() for more details. Should be harmless but
  35 # inefficient to define on systems that don't need it.
  36 $do_expand = ($Config{'osname'} eq 'VMS');
  37
  38 @dl_require_symbols = ();       # names of symbols we need
  39 @dl_resolve_using   = ();       # names of files to link with
  40 @dl_library_path    = ();       # path to look for files
  41
  42 # This is a fix to support DLD's unfortunate desire to relink -lc
  43 @dl_resolve_using = dl_findfile('-lc') if $Config{'dlsrc'} eq "dl_dld.xs";
  44
  45 # Initialise @dl_library_path with the 'standard' library path
  46 # for this platform as determined by Configure
  47 push(@dl_library_path, split(' ',$Config{'libpth'}));
  48
  49 # Add to @dl_library_path any extra directories we can gather from
  50 # environment variables. So far LD_LIBRARY_PATH is the only known
  51 # variable used for this purpose. Others may be added later.
  52 push(@dl_library_path, split(/:/, $ENV{'LD_LIBRARY_PATH'}))
  53     if $ENV{'LD_LIBRARY_PATH'};
  54
  55
  56 # No prizes for guessing why we don't say 'bootstrap DynaLoader;' here.
  57 boot_DynaLoader() if defined(&boot_DynaLoader);
  58
  59
  60 if ($dl_debug){
  61         print STDERR "DynaLoader.pm loaded (@dl_library_path)\n";
  62         print STDERR "DynaLoader not linked into this perl\n"
  63                 unless defined(&boot_DynaLoader);
  64 }
  65
  66 1; # End of main code
  67
  68
  69 # The bootstrap function cannot be autoloaded (without complications)
  70 # so we define it here:
  71
  72 sub bootstrap {
  73     # use local vars to enable $module.bs script to edit values
  74     local(@args) = @_;
  75     local($module) = $args[0];
  76     local(@dirs, $file);
  77
  78     croak "Usage: DynaLoader::bootstrap(module)"
  79         unless ($module);
  80
  81     croak "Can't load module $module, dynamic loading not available in this perl"
  82         unless defined(&dl_load_file);
  83
  84     print STDERR "DynaLoader::bootstrap($module)\n" if $dl_debug;
  85
  86     my(@modparts) = split(/::/,$module);
  87     my($modfname) = $modparts[-1];
  88     my($modpname) = join('/',@modparts);
  89     foreach (@INC) {
  90         my $dir = "$_/auto/$modpname";
  91         next unless -d $dir; # skip over uninteresting directories
  92
  93         # check for common cases to avoid autoload of dl_findfile
  94         last if ($file=_check_file("$dir/$modfname.$dl_dlext"));
  95
  96         # no luck here, save dir for possible later dl_findfile search
  97         push(@dirs, "-L$dir");
  98     }
  99     # last resort, let dl_findfile have a go in all known locations
 100     $file = dl_findfile(@dirs, map("-L$_",@INC), $modfname) unless $file;
 101
 102     croak "Can't find loadable object for module $module in \@INC"
 103         unless $file;
 104
 105     my($bootname) = "boot_$module";
 106     $bootname =~ s/\W/_/g;
 107     @dl_require_symbols = ($bootname);
 108
 109     # Execute optional '.bootstrap' perl script for this module.
 110     # The .bs file can be used to configure @dl_resolve_using etc to
 111     # match the needs of the individual module on this architecture.
 112     my $bs = $file;
 113     $bs =~ s/(\.\w+)?$/\.bs/; # look for .bs 'beside' the library
 114     if (-s $bs) { # only read file if it's not empty
 115         local($osname, $dlsrc) = @Config{'osname','dlsrc'};
 116         print STDERR "BS: $bs ($osname, $dlsrc)\n" if $dl_debug;
 117         eval { do $bs; };
 118         warn "$bs: $@\n" if $@;
 119     }
 120
 121     # Many dynamic extension loading problems will appear to come from
 122     # this section of code: XYZ failed at line 123 of DynaLoader.pm.
 123     # Often these errors are actually occurring in the initialisation
 124     # C code of the extension XS file. Perl reports the error as being
 125     # in this perl code simply because this was the last perl code
 126     # it executed.
 127
 128     my $libref = dl_load_file($file) or
 129         croak "Can't load '$file' for module $module: ".dl_error()."\n";
 130
 131     my(@unresolved) = dl_undef_symbols();
 132     carp "Undefined symbols present after loading $file: @unresolved\n"
 133         if (@unresolved);
 134
 135     my $boot_symbol_ref = dl_find_symbol($libref, $bootname) or
 136          croak "Can't find '$bootname' symbol in $file\n";
 137
 138     dl_install_xsub("${module}::bootstrap", $boot_symbol_ref, $file);
 139
 140     # See comment block above
 141     &{"${module}::bootstrap"}(@args);
 142 }
 143
 144
 145 sub _check_file{   # private utility to handle dl_expandspec vs -f tests
 146     my($file) = @_;
 147     return $file if (!$do_expand && -f $file); # the common case
 148     return $file if ( $do_expand && ($file=dl_expandspec($file)));
 149     return undef;
 150 }
 151
 152
 153 # Let autosplit and the autoloader deal with these functions:
 154 __END__
 155
 156
 157 sub dl_findfile {
 158     # Read ext/DynaLoader/DynaLoader.doc for detailed information.
 159     # This function does not automatically consider the architecture
 160     # or the perl library auto directories.
 161     my (@args) = @_;
 162     my (@dirs,  $dir);   # which directories to search
 163     my (@found);         # full paths to real files we have found
 164     my ($vms) = ($Config{'osname'} eq 'VMS');
 165
 166     print STDERR "dl_findfile(@args)\n" if $dl_debug;
 167
 168     # accumulate directories but process files as they appear
 169     arg: foreach(@args) {
 170         #  Special fast case: full filepath requires no search
 171         if (m:/: && -f $_ && !$do_expand){
 172             push(@found,$_);
 173             last arg unless wantarray;
 174             next;
 175         }
 176
 177         # Deal with directories first:
 178         #  Using a -L prefix is the preferred option (faster and more robust)
 179         if (m:^-L:){ s/^-L//; push(@dirs, $_); next; }
 180         #  Otherwise we try to try to spot directories by a heuristic
 181         #  (this is a more complicated issue than it first appears)
 182         if (m:/: && -d $_){   push(@dirs, $_); next; }
 183         # VMS: we may be using native VMS directry syntax instead of
 184         # Unix emulation, so check this as well
 185         if ($vms && /[:>\]]/ && -d $_){   push(@dirs, $_); next; }
 186
 187         #  Only files should get this far...
 188         my(@names, $name);    # what filenames to look for
 189         if (m:-l: ){          # convert -lname to appropriate library name
 190             s/-l//;
 191             push(@names,"lib$_.$dl_so");
 192             push(@names,"lib$_.a");
 193         }else{                # Umm, a bare name. Try various alternatives:
 194             # these should be ordered with the most likely first
 195             push(@names,"$_.$dl_so")     unless m/\.$dl_so$/o;
 196             push(@names,"lib$_.$dl_so")  unless m:/:;
 197             push(@names,"$_.o")          unless m/\.(o|$dl_so)$/o;
 198             push(@names,"$_.a")          unless m/\.a$/;
 199             push(@names, $_);
 200         }
 201         foreach $dir (@dirs, @dl_library_path) {
 202             next unless -d $dir;
 203             foreach $name (@names) {
 204                 my($file) = "$dir/$name";
 205                 print STDERR " checking in $dir for $name\n" if $dl_debug;
 206                 $file = _check_file($file);
 207                 if ($file){
 208                     push(@found, $file);
 209                     next arg; # no need to look any further
 210                 }
 211             }
 212         }
 213     }
 214     if ($dl_debug) {
 215         foreach(@dirs) {
 216             print STDERR " dl_findfile ignored non-existent directory: $_\n" unless -d $_;
 217         }
 218         print STDERR "dl_findfile found: @found\n";
 219     }
 220     return $found[0] unless wantarray;
 221     @found;
 222 }
 223
 224
 225 sub dl_expandspec{
 226     my($spec) = @_;
 227     # Optional function invoked if DynaLoader.pm sets $do_expand.
 228     # Most systems do not require or use this function.
 229     # Some systems may implement it in the dl_*.xs file in which case
 230     # this autoload version will not be called but is harmless.
 231
 232     # This function is designed to deal with systems which treat some
 233     # 'filenames' in a special way. For example VMS 'Logical Names'
 234     # (something like unix environment variables - but different).
 235     # This function should recognise such names and expand them into
 236     # full file paths.
 237     # Must return undef if $spec is invalid or file does not exist.
 238
 239     my($file)   = $spec; # default output to input
 240     my($osname) = $Config{'osname'};
 241
 242     if ($osname eq 'VMS'){ # dl_expandspec should be defined in dl_vms.xs
 243         croak "dl_expandspec: should be defined in XS file!\n";
 244     }else{
 245         return undef unless -f $file;
 246     }
 247     print STDERR "dl_expandspec($spec) => $file\n" if $dl_debug;
 248     $file;
 249 }