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 # 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