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
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     # 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
135 XSLoader - 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
146 This module defines a standard I<simplified> interface to the dynamic
147 linking mechanisms available on many platforms.  Its primary purpose is
148 to implement cheap automatic dynamic loading of Perl modules.
149
150 For more complicated interface see L<DynaLoader>.
151
152 =head1 AUTHOR
153
154 Ilya Zakharevich: extraction from DynaLoader.
155
156 =cut
157 EOT
158
159 close OUT or die $!;
160