home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / ext / DynaLoader / XSLoader_pm.PL < prev   
Perl Script  |  1999-12-07  |  4KB  |  159 lines
  1. use Config;
  2.  
  3. sub to_string {
  4.     my ($value) = @_;
  5.     $value =~ s/\\/\\\\/g;
  6.     $value =~ s/'/\\'/g;
  7.     return "'$value'";
  8. }
  9.  
  10. unlink "XSLoader.pm" if -f "XSLoader.pm";
  11. open OUT, ">XSLoader.pm" or die $!;
  12. print OUT <<'EOT';
  13. # Generated from XSLoader.pm.PL (resolved %Config::Config value)
  14.  
  15. package XSLoader;
  16.  
  17. #   And Gandalf said: 'Many folk like to know beforehand what is to
  18. #   be set on the table; but those who have laboured to prepare the
  19. #   feast like to keep their secret; for wonder makes the words of
  20. #   praise louder.'
  21.  
  22. #   (Quote from Tolkien sugested by Anno Siegel.)
  23. #
  24. # See pod text at end of file for documentation.
  25. # See also ext/DynaLoader/README in source tree for other information.
  26. #
  27. # Tim.Bunce@ig.co.uk, August 1994
  28.  
  29. $VERSION = "0.01";    # avoid typo warning
  30.  
  31. # enable debug/trace messages from DynaLoader perl code
  32. # $dl_debug = $ENV{PERL_DL_DEBUG} || 0 unless defined $dl_debug;
  33.  
  34. EOT
  35.  
  36. print OUT '  my $dl_dlext = ', to_string($Config::Config{'dlext'}), ";\n" ;
  37.  
  38. print OUT <<'EOT';
  39.  
  40. # No prizes for guessing why we don't say 'bootstrap DynaLoader;' here.
  41. package DynaLoader;
  42. boot_DynaLoader('DynaLoader') if defined(&boot_DynaLoader) &&
  43.                                 !defined(&dl_load_file);
  44. package XSLoader;
  45.  
  46. 1; # End of main code
  47.  
  48. # The bootstrap function cannot be autoloaded (without complications)
  49. # so we define it here:
  50.  
  51. sub load {
  52.     package DynaLoader;
  53.  
  54.     my($module) = $_[0];
  55.  
  56.     # work with static linking too
  57.     my $b = "$module\::bootstrap";
  58.     goto &$b if defined &$b;
  59.  
  60.     goto retry unless $module and defined &dl_load_file;
  61.  
  62.     my @modparts = split(/::/,$module);
  63.     my $modfname = $modparts[-1];
  64.  
  65. EOT
  66.  
  67. print OUT <<'EOT' if defined &DynaLoader::mod2fname;
  68.     # Some systems have restrictions on files names for DLL's etc.
  69.     # mod2fname returns appropriate file base name (typically truncated)
  70.     # It may also edit @modparts if required.
  71.     $modfname = &mod2fname(\@modparts) if defined &mod2fname;
  72.  
  73. EOT
  74.  
  75. print OUT <<'EOT';
  76.     my $modpname = join('/',@modparts);
  77.     my $modlibname = (caller())[1];
  78.     my $c = @modparts;
  79.     $modlibname =~ s,[\\/][^\\/]+$,, while $c--;    # Q&D basename
  80.     my $file = "$modlibname/auto/$modpname/$modfname.$dl_dlext";
  81.  
  82. #   print STDERR "XSLoader::load for $module ($file)\n" if $dl_debug;
  83.  
  84.     my $bs = $file;
  85.     $bs =~ s/(\.\w+)?(;\d*)?$/\.bs/; # look for .bs 'beside' the library
  86.  
  87.     goto retry if not -f $file or -s $bs;
  88.  
  89.     my $bootname = "boot_$module";
  90.     $bootname =~ s/\W/_/g;
  91.     @dl_require_symbols = ($bootname);
  92.  
  93.     # Many dynamic extension loading problems will appear to come from
  94.     # this section of code: XYZ failed at line 123 of DynaLoader.pm.
  95.     # Often these errors are actually occurring in the initialisation
  96.     # C code of the extension XS file. Perl reports the error as being
  97.     # in this perl code simply because this was the last perl code
  98.     # it executed.
  99.  
  100.     my $libref = dl_load_file($file, 0) or do { 
  101.     require Carp;
  102.     Carp::croak("Can't load '$file' for module $module: " . dl_error());
  103.     };
  104.     push(@dl_librefs,$libref);  # record loaded object
  105.  
  106.     my @unresolved = dl_undef_symbols();
  107.     if (@unresolved) {
  108.     require Carp;
  109.     Carp::carp("Undefined symbols present after loading $file: @unresolved\n");
  110.     }
  111.  
  112.     my $boot_symbol_ref = dl_find_symbol($libref, $bootname) or do {
  113.     require Carp;
  114.     Carp::croak("Can't find '$bootname' symbol in $file\n");
  115.     };
  116.  
  117.     my $xs = dl_install_xsub("${module}::bootstrap", $boot_symbol_ref, $file);
  118.  
  119.     push(@dl_modules, $module); # record loaded module
  120.  
  121.     # See comment block above
  122.     return &$xs(@_);
  123.  
  124.   retry:
  125.     require DynaLoader;
  126.     goto &DynaLoader::bootstrap_inherit;
  127. }
  128.  
  129. __END__
  130.  
  131. =head1 NAME
  132.  
  133. XSLoader - Dynamically load C libraries into Perl code
  134.  
  135. =head1 SYNOPSIS
  136.  
  137.     package YourPackage;
  138.     use XSLoader;
  139.  
  140.     XSLoader::load 'YourPackage', @args;
  141.  
  142. =head1 DESCRIPTION
  143.  
  144. This module defines a standard I<simplified> interface to the dynamic
  145. linking mechanisms available on many platforms.  Its primary purpose is
  146. to implement cheap automatic dynamic loading of Perl modules.
  147.  
  148. For more complicated interface see L<DynaLoader>.
  149.  
  150. =head1 AUTHOR
  151.  
  152. Ilya Zakharevich: extraction from DynaLoader.
  153.  
  154. =cut
  155. EOT
  156.  
  157. close OUT or die $!;
  158.  
  159.