ext/DynaLoader/XSLoader_pm.PL

   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 package DynaLoader;
  41
  42 # No prizes for guessing why we don't say 'bootstrap DynaLoader;' here.
  43 # NOTE: All dl_*.xs (including dl_none.xs) define a dl_error() XSUB
  44 boot_DynaLoader('DynaLoader') if defined(&boot_DynaLoader) &&
  45                                 !defined(&dl_error);
  46 package XSLoader;
  47
  48 1; # End of main code
  49
  50 # The bootstrap function cannot be autoloaded (without complications)
  51 # so we define it here:
  52
  53 sub load {
  54     package DynaLoader;
  55
  56     my($module) = $_[0];
  57
  58     # work with static linking too
  59     my $b = "$module\::bootstrap";
  60     goto &$b if defined &$b;
  61
  62     goto retry unless $module and defined &dl_load_file;
  63
  64     my @modparts = split(/::/,$module);
  65     my $modfname = $modparts[-1];
  66
  67 EOT
  68
  69 print OUT <<'EOT' if defined &DynaLoader::mod2fname;
  70     # Some systems have restrictions on files names for DLL's etc.
  71     # mod2fname returns appropriate file base name (typically truncated)
  72     # It may also edit @modparts if required.
  73     $modfname = &mod2fname(\@modparts) if defined &mod2fname;
  74
  75 EOT
  76
  77 print OUT <<'EOT';
  78     my $modpname = join('/',@modparts);
  79     my $modlibname = (caller())[1];
  80     my $c = @modparts;
  81     $modlibname =~ s,[\\/][^\\/]+$,, while $c--;        # Q&D basename
  82     my $file = "$modlibname/auto/$modpname/$modfname.$dl_dlext";
  83
  84 #   print STDERR "XSLoader::load for $module ($file)\n" if $dl_debug;
  85
  86     my $bs = $file;
  87     $bs =~ s/(\.\w+)?(;\d*)?$/\.bs/; # look for .bs 'beside' the library
  88
  89     goto retry if not -f $file or -s $bs;
  90
  91     my $bootname = "boot_$module";
  92     $bootname =~ s/\W/_/g;
  93     @dl_require_symbols = ($bootname);
  94
  95     my $boot_symbol_ref;
  96
  97     if ($^O eq 'darwin') {
  98         if ($boot_symbol_ref = dl_find_symbol(0, $bootname)) {
  99             goto boot; #extension library has already been loaded, e.g. darwin
 100         }
 101     }
 102
 103     # Many dynamic extension loading problems will appear to come from
 104     # this section of code: XYZ failed at line 123 of DynaLoader.pm.
 105     # Often these errors are actually occurring in the initialisation
 106     # C code of the extension XS file. Perl reports the error as being
 107     # in this perl code simply because this was the last perl code
 108     # it executed.
 109
 110     my $libref = dl_load_file($file, 0) or do {
 111         require Carp;
 112         Carp::croak("Can't load '$file' for module $module: " . dl_error());
 113     };
 114     push(@dl_librefs,$libref);  # record loaded object
 115
 116     my @unresolved = dl_undef_symbols();
 117     if (@unresolved) {
 118         require Carp;
 119         Carp::carp("Undefined symbols present after loading $file: @unresolved\n");
 120     }
 121
 122     $boot_symbol_ref = dl_find_symbol($libref, $bootname) or do {
 123         require Carp;
 124         Carp::croak("Can't find '$bootname' symbol in $file\n");
 125     };
 126
 127     push(@dl_modules, $module); # record loaded module
 128
 129   boot:
 130     my $xs = dl_install_xsub("${module}::bootstrap", $boot_symbol_ref, $file);
 131
 132     # See comment block above
 133     return &$xs(@_);
 134
 135   retry:
 136     require DynaLoader;
 137     goto &DynaLoader::bootstrap_inherit;
 138 }
 139
 140 __END__
 141
 142 =head1 NAME
 143
 144 XSLoader - Dynamically load C libraries into Perl code
 145
 146 =head1 SYNOPSIS
 147
 148     package YourPackage;
 149     use XSLoader;
 150
 151     XSLoader::load 'YourPackage', @args;
 152
 153 =head1 DESCRIPTION
 154
 155 This module defines a standard I<simplified> interface to the dynamic
 156 linking mechanisms available on many platforms.  Its primary purpose is
 157 to implement cheap automatic dynamic loading of Perl modules.
 158
 159 For more complicated interface see L<DynaLoader>.
 160
 161 =head1 AUTHOR
 162
 163 Ilya Zakharevich: extraction from DynaLoader.
 164
 165 =cut
 166 EOT
 167
 168 close OUT or die $!;
 169