home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl501m.zip / lib / DynaLoader.pm < prev    next >
Text File  |  1995-05-13  |  9KB  |  251 lines
  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.     $modfname .= '_' if $Config{'osname'} eq "OS/2";
  89.     my($modpname) = join('/',@modparts);
  90.     foreach (@INC) {
  91.         my $dir = "$_/auto/$modpname";
  92.     next unless -d $dir; # skip over uninteresting directories
  93.  
  94.     # check for common cases to avoid autoload of dl_findfile
  95.     last if ($file=_check_file("$dir/$modfname.$dl_dlext"));
  96.  
  97.     # no luck here, save dir for possible later dl_findfile search
  98.     push(@dirs, "-L$dir");
  99.     }
  100.     # last resort, let dl_findfile have a go in all known locations
  101.     $file = dl_findfile(@dirs, map("-L$_",@INC), $modfname) unless $file;
  102.  
  103.     croak "Can't find loadable object for module $module in \@INC"
  104.         unless $file;
  105.  
  106.     my($bootname) = "boot_$module";
  107.     $bootname =~ s/\W/_/g;
  108.     @dl_require_symbols = ($bootname);
  109.  
  110.     # Execute optional '.bootstrap' perl script for this module.
  111.     # The .bs file can be used to configure @dl_resolve_using etc to
  112.     # match the needs of the individual module on this architecture.
  113.     my $bs = $file;
  114.     $bs =~ s/(\.\w+)?$/\.bs/; # look for .bs 'beside' the library
  115.     if (-s $bs) { # only read file if it's not empty
  116.         local($osname, $dlsrc) = @Config{'osname','dlsrc'};
  117.         print STDERR "BS: $bs ($osname, $dlsrc)\n" if $dl_debug;
  118.         eval { do $bs; };
  119.         warn "$bs: $@\n" if $@;
  120.     }
  121.  
  122.     # Many dynamic extension loading problems will appear to come from
  123.     # this section of code: XYZ failed at line 123 of DynaLoader.pm.
  124.     # Often these errors are actually occurring in the initialisation
  125.     # C code of the extension XS file. Perl reports the error as being
  126.     # in this perl code simply because this was the last perl code
  127.     # it executed.
  128.  
  129.     my $libref = dl_load_file($file) or
  130.     croak "Can't load '$file' for module $module: ".dl_error()."\n";
  131.  
  132.     my(@unresolved) = dl_undef_symbols();
  133.     carp "Undefined symbols present after loading $file: @unresolved\n"
  134.         if (@unresolved);
  135.  
  136.     my $boot_symbol_ref = dl_find_symbol($libref, $bootname) or
  137.          croak "Can't find '$bootname' symbol in $file\n";
  138.  
  139.     dl_install_xsub("${module}::bootstrap", $boot_symbol_ref, $file);
  140.  
  141.     # See comment block above
  142.     &{"${module}::bootstrap"}(@args);
  143. }
  144.  
  145.  
  146. sub _check_file{   # private utility to handle dl_expandspec vs -f tests
  147.     my($file) = @_;
  148.     return $file if (!$do_expand && -f $file); # the common case
  149.     return $file if ( $do_expand && ($file=dl_expandspec($file)));
  150.     return undef;
  151. }
  152.  
  153.  
  154. # Let autosplit and the autoloader deal with these functions:
  155. __END__
  156.  
  157.  
  158. sub dl_findfile {
  159.     # Read ext/DynaLoader/DynaLoader.doc for detailed information.
  160.     # This function does not automatically consider the architecture
  161.     # or the perl library auto directories.
  162.     my (@args) = @_;
  163.     my (@dirs,  $dir);   # which directories to search
  164.     my (@found);         # full paths to real files we have found
  165.     my ($vms) = ($Config{'osname'} eq 'VMS');
  166.  
  167.     print STDERR "dl_findfile(@args)\n" if $dl_debug;
  168.  
  169.     # accumulate directories but process files as they appear
  170.     arg: foreach(@args) {
  171.         #  Special fast case: full filepath requires no search
  172.         if (m:/: && -f $_ && !$do_expand){
  173.         push(@found,$_);
  174.         last arg unless wantarray;
  175.         next;
  176.     }
  177.  
  178.         # Deal with directories first:
  179.         #  Using a -L prefix is the preferred option (faster and more robust)
  180.         if (m:^-L:){ s/^-L//; push(@dirs, $_); next; }
  181.         #  Otherwise we try to try to spot directories by a heuristic
  182.         #  (this is a more complicated issue than it first appears)
  183.         if (m:/: && -d $_){   push(@dirs, $_); next; }
  184.         # VMS: we may be using native VMS directry syntax instead of
  185.         # Unix emulation, so check this as well
  186.         if ($vms && /[:>\]]/ && -d $_){   push(@dirs, $_); next; }
  187.  
  188.         #  Only files should get this far...
  189.         my(@names, $name);    # what filenames to look for
  190.         if (m:-l: ){          # convert -lname to appropriate library name
  191.             s/-l//;
  192.             push(@names,"lib$_.$dl_so");
  193.             push(@names,"lib$_.a");
  194.         }else{                # Umm, a bare name. Try various alternatives:
  195.             # these should be ordered with the most likely first
  196.             push(@names,"$_.$dl_so")     unless m/\.$dl_so$/o;
  197.             push(@names,"lib$_.$dl_so")  unless m:/:;
  198.             push(@names,"$_.o")          unless m/\.(o|$dl_so)$/o;
  199.             push(@names,"$_.a")          unless m/\.a$/;
  200.             push(@names, $_);
  201.         }
  202.         foreach $dir (@dirs, @dl_library_path) {
  203.             next unless -d $dir;
  204.             foreach $name (@names) {
  205.         my($file) = "$dir/$name";
  206.                 print STDERR " checking in $dir for $name\n" if $dl_debug;
  207.         $file = _check_file($file);
  208.         if ($file){
  209.                     push(@found, $file);
  210.                     next arg; # no need to look any further
  211.                 }
  212.             }
  213.         }
  214.     }
  215.     if ($dl_debug) {
  216.         foreach(@dirs) {
  217.             print STDERR " dl_findfile ignored non-existent directory: $_\n" unless -d $_;
  218.         }
  219.         print STDERR "dl_findfile found: @found\n";
  220.     }
  221.     return $found[0] unless wantarray;
  222.     @found;
  223. }
  224.  
  225.  
  226. sub dl_expandspec{
  227.     my($spec) = @_;
  228.     # Optional function invoked if DynaLoader.pm sets $do_expand.
  229.     # Most systems do not require or use this function.
  230.     # Some systems may implement it in the dl_*.xs file in which case
  231.     # this autoload version will not be called but is harmless.
  232.  
  233.     # This function is designed to deal with systems which treat some
  234.     # 'filenames' in a special way. For example VMS 'Logical Names'
  235.     # (something like unix environment variables - but different).
  236.     # This function should recognise such names and expand them into
  237.     # full file paths.
  238.     # Must return undef if $spec is invalid or file does not exist.
  239.  
  240.     my($file)   = $spec; # default output to input
  241.     my($osname) = $Config{'osname'};
  242.  
  243.     if ($osname eq 'VMS'){ # dl_expandspec should be defined in dl_vms.xs
  244.     croak "dl_expandspec: should be defined in XS file!\n";
  245.     }else{
  246.     return undef unless -f $file;
  247.     }
  248.     print STDERR "dl_expandspec($spec) => $file\n" if $dl_debug;
  249.     $file;
  250. }
  251.