This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
use &dl_error rather than &dl_load_file as the guard for calling
[perl5.git] / ext / DynaLoader / XSLoader_pm.PL
CommitLineData
9cf41c4d
GS
1use Config;
2
3sub to_string {
4 my ($value) = @_;
5 $value =~ s/\\/\\\\/g;
6 $value =~ s/'/\\'/g;
7 return "'$value'";
8}
9
10unlink "XSLoader.pm" if -f "XSLoader.pm";
11open OUT, ">XSLoader.pm" or die $!;
12print OUT <<'EOT';
13# Generated from XSLoader.pm.PL (resolved %Config::Config value)
14
15package 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
34EOT
35
36print OUT ' my $dl_dlext = ', to_string($Config::Config{'dlext'}), ";\n" ;
37
38print OUT <<'EOT';
39
9cf41c4d 40package DynaLoader;
b4cea227
GS
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
9cf41c4d 44boot_DynaLoader('DynaLoader') if defined(&boot_DynaLoader) &&
b4cea227 45 !defined(&dl_error);
9cf41c4d
GS
46package XSLoader;
47
481; # End of main code
49
50# The bootstrap function cannot be autoloaded (without complications)
51# so we define it here:
52
53sub 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
67EOT
68
69print 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
75EOT
76
77print 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 # Many dynamic extension loading problems will appear to come from
96 # this section of code: XYZ failed at line 123 of DynaLoader.pm.
97 # Often these errors are actually occurring in the initialisation
98 # C code of the extension XS file. Perl reports the error as being
99 # in this perl code simply because this was the last perl code
100 # it executed.
101
102 my $libref = dl_load_file($file, 0) or do {
103 require Carp;
104 Carp::croak("Can't load '$file' for module $module: " . dl_error());
105 };
106 push(@dl_librefs,$libref); # record loaded object
107
108 my @unresolved = dl_undef_symbols();
109 if (@unresolved) {
110 require Carp;
111 Carp::carp("Undefined symbols present after loading $file: @unresolved\n");
112 }
113
114 my $boot_symbol_ref = dl_find_symbol($libref, $bootname) or do {
115 require Carp;
116 Carp::croak("Can't find '$bootname' symbol in $file\n");
117 };
118
119 my $xs = dl_install_xsub("${module}::bootstrap", $boot_symbol_ref, $file);
120
121 push(@dl_modules, $module); # record loaded module
122
123 # See comment block above
124 return &$xs(@_);
125
126 retry:
127 require DynaLoader;
128 goto &DynaLoader::bootstrap_inherit;
129}
130
131__END__
132
133=head1 NAME
134
135XSLoader - Dynamically load C libraries into Perl code
136
137=head1 SYNOPSIS
138
139 package YourPackage;
140 use XSLoader;
141
142 XSLoader::load 'YourPackage', @args;
143
144=head1 DESCRIPTION
145
146This module defines a standard I<simplified> interface to the dynamic
147linking mechanisms available on many platforms. Its primary purpose is
148to implement cheap automatic dynamic loading of Perl modules.
149
150For more complicated interface see L<DynaLoader>.
151
152=head1 AUTHOR
153
154Ilya Zakharevich: extraction from DynaLoader.
155
156=cut
157EOT
158
159close OUT or die $!;
160