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