This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
This is my patch patch.1g for perl5.001.
[perl5.git] / ext / DynaLoader / DynaLoader.pm
CommitLineData
a0d0e21e
LW
1package DynaLoader;
2
3#
4# And Gandalf said: 'Many folk like to know beforehand what is to
5# be set on the table; but those who have laboured to prepare the
6# feast like to keep their secret; for wonder makes the words of
7# praise louder.'
8#
9
10# Quote from Tolkien sugested by Anno Siegel.
11#
12# Read ext/DynaLoader/README and DynaLoader.doc for
13# detailed information.
14#
15# Tim.Bunce@ig.co.uk, August 1994
16
17use Config;
18use Carp;
19use AutoLoader;
20
fec02dd3 21@ISA=qw(AutoLoader);
a0d0e21e
LW
22
23
24# enable messages from DynaLoader perl code
25$dl_debug = 0 unless $dl_debug;
26$dl_debug = $ENV{'PERL_DL_DEBUG'} if $ENV{'PERL_DL_DEBUG'};
27
28$dl_so = $dl_dlext = ""; # avoid typo warnings
29$dl_so = $Config{'so'}; # suffix for shared libraries
30$dl_dlext = $Config{'dlext'}; # suffix for dynamic modules
31
32# Some systems need special handling to expand file specifications
33# (VMS support by Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU>)
34# See dl_expandspec() for more details. Should be harmless but
35# inefficient to define on systems that don't need it.
36$do_expand = ($Config{'osname'} eq 'VMS');
37
38@dl_require_symbols = (); # names of symbols we need
39@dl_resolve_using = (); # names of files to link with
40@dl_library_path = (); # path to look for files
41
42# This is a fix to support DLD's unfortunate desire to relink -lc
43@dl_resolve_using = dl_findfile('-lc') if $Config{'dlsrc'} eq "dl_dld.xs";
44
45# Initialise @dl_library_path with the 'standard' library path
46# for this platform as determined by Configure
47push(@dl_library_path, split(' ',$Config{'libpth'}));
48
49# Add to @dl_library_path any extra directories we can gather from
50# environment variables. So far LD_LIBRARY_PATH is the only known
51# variable used for this purpose. Others may be added later.
52push(@dl_library_path, split(/:/, $ENV{'LD_LIBRARY_PATH'}))
53 if $ENV{'LD_LIBRARY_PATH'};
54
55
56# No prizes for guessing why we don't say 'bootstrap DynaLoader;' here.
75f92628 57boot_DynaLoader() if defined(&boot_DynaLoader);
a0d0e21e 58
a0d0e21e 59
75f92628
AD
60if ($dl_debug){
61 print STDERR "DynaLoader.pm loaded (@dl_library_path)\n";
62 print STDERR "DynaLoader not linked into this perl\n"
63 unless defined(&boot_DynaLoader);
a0d0e21e
LW
64}
65
661; # End of main code
67
68
69# The bootstrap function cannot be autoloaded (without complications)
70# so we define it here:
71
72sub bootstrap {
73 # use local vars to enable $module.bs script to edit values
74 local(@args) = @_;
75 local($module) = $args[0];
76 local(@dirs, $file);
77
78 croak "Usage: DynaLoader::bootstrap(module)"
79 unless ($module);
80
e1666bf5 81 croak "Can't load module $module, dynamic loading not available in this perl"
a0d0e21e
LW
82 unless defined(&dl_load_file);
83
84 print STDERR "DynaLoader::bootstrap($module)\n" if $dl_debug;
85
86 my(@modparts) = split(/::/,$module);
87 my($modfname) = $modparts[-1];
88 my($modpname) = join('/',@modparts);
89 foreach (@INC) {
90 my $dir = "$_/auto/$modpname";
91 next unless -d $dir; # skip over uninteresting directories
92
93 # check for common cases to avoid autoload of dl_findfile
94 last if ($file=_check_file("$dir/$modfname.$dl_dlext"));
95
96 # no luck here, save dir for possible later dl_findfile search
97 push(@dirs, "-L$dir");
98 }
99 # last resort, let dl_findfile have a go in all known locations
100 $file = dl_findfile(@dirs, map("-L$_",@INC), $modfname) unless $file;
101
102 croak "Can't find loadable object for module $module in \@INC"
103 unless $file;
104
105 my($bootname) = "boot_$module";
106 $bootname =~ s/\W/_/g;
107 @dl_require_symbols = ($bootname);
108
109 # Execute optional '.bootstrap' perl script for this module.
110 # The .bs file can be used to configure @dl_resolve_using etc to
111 # match the needs of the individual module on this architecture.
112 my $bs = $file;
42793c05
TB
113 $bs =~ s/(\.\w+)?$/\.bs/; # look for .bs 'beside' the library
114 if (-s $bs) { # only read file if it's not empty
a0d0e21e 115 local($osname, $dlsrc) = @Config{'osname','dlsrc'};
42793c05
TB
116 print STDERR "BS: $bs ($osname, $dlsrc)\n" if $dl_debug;
117 eval { do $bs; };
a0d0e21e
LW
118 warn "$bs: $@\n" if $@;
119 }
120
75f92628
AD
121 # Many dynamic extension loading problems will appear to come from
122 # this section of code: XYZ failed at line 123 of DynaLoader.pm.
123 # Often these errors are actually occurring in the initialisation
124 # C code of the extension XS file. Perl reports the error as being
125 # in this perl code simply because this was the last perl code
126 # it executed.
127
128 my $libref = dl_load_file($file) or
129 croak "Can't load '$file' for module $module: ".dl_error()."\n";
a0d0e21e
LW
130
131 my(@unresolved) = dl_undef_symbols();
132 carp "Undefined symbols present after loading $file: @unresolved\n"
133 if (@unresolved);
134
135 my $boot_symbol_ref = dl_find_symbol($libref, $bootname) or
136 croak "Can't find '$bootname' symbol in $file\n";
137
138 dl_install_xsub("${module}::bootstrap", $boot_symbol_ref, $file);
75f92628
AD
139
140 # See comment block above
a0d0e21e
LW
141 &{"${module}::bootstrap"}(@args);
142}
143
144
145sub _check_file{ # private utility to handle dl_expandspec vs -f tests
146 my($file) = @_;
147 return $file if (!$do_expand && -f $file); # the common case
148 return $file if ( $do_expand && ($file=dl_expandspec($file)));
149 return undef;
150}
151
152
153# Let autosplit and the autoloader deal with these functions:
154__END__
155
156
157sub dl_findfile {
158 # Read ext/DynaLoader/DynaLoader.doc for detailed information.
159 # This function does not automatically consider the architecture
160 # or the perl library auto directories.
161 my (@args) = @_;
162 my (@dirs, $dir); # which directories to search
163 my (@found); # full paths to real files we have found
164 my ($vms) = ($Config{'osname'} eq 'VMS');
165
166 print STDERR "dl_findfile(@args)\n" if $dl_debug;
167
168 # accumulate directories but process files as they appear
169 arg: foreach(@args) {
170 # Special fast case: full filepath requires no search
171 if (m:/: && -f $_ && !$do_expand){
172 push(@found,$_);
173 last arg unless wantarray;
174 next;
175 }
176
177 # Deal with directories first:
178 # Using a -L prefix is the preferred option (faster and more robust)
179 if (m:^-L:){ s/^-L//; push(@dirs, $_); next; }
180 # Otherwise we try to try to spot directories by a heuristic
181 # (this is a more complicated issue than it first appears)
182 if (m:/: && -d $_){ push(@dirs, $_); next; }
183 # VMS: we may be using native VMS directry syntax instead of
184 # Unix emulation, so check this as well
185 if ($vms && /[:>\]]/ && -d $_){ push(@dirs, $_); next; }
186
187 # Only files should get this far...
188 my(@names, $name); # what filenames to look for
189 if (m:-l: ){ # convert -lname to appropriate library name
190 s/-l//;
191 push(@names,"lib$_.$dl_so");
192 push(@names,"lib$_.a");
193 }else{ # Umm, a bare name. Try various alternatives:
194 # these should be ordered with the most likely first
195 push(@names,"$_.$dl_so") unless m/\.$dl_so$/o;
196 push(@names,"lib$_.$dl_so") unless m:/:;
197 push(@names,"$_.o") unless m/\.(o|$dl_so)$/o;
198 push(@names,"$_.a") unless m/\.a$/;
199 push(@names, $_);
200 }
201 foreach $dir (@dirs, @dl_library_path) {
202 next unless -d $dir;
203 foreach $name (@names) {
204 my($file) = "$dir/$name";
205 print STDERR " checking in $dir for $name\n" if $dl_debug;
206 $file = _check_file($file);
207 if ($file){
208 push(@found, $file);
209 next arg; # no need to look any further
210 }
211 }
212 }
213 }
214 if ($dl_debug) {
215 foreach(@dirs) {
216 print STDERR " dl_findfile ignored non-existent directory: $_\n" unless -d $_;
217 }
218 print STDERR "dl_findfile found: @found\n";
219 }
220 return $found[0] unless wantarray;
221 @found;
222}
223
224
225sub dl_expandspec{
226 my($spec) = @_;
227 # Optional function invoked if DynaLoader.pm sets $do_expand.
228 # Most systems do not require or use this function.
229 # Some systems may implement it in the dl_*.xs file in which case
230 # this autoload version will not be called but is harmless.
231
232 # This function is designed to deal with systems which treat some
233 # 'filenames' in a special way. For example VMS 'Logical Names'
234 # (something like unix environment variables - but different).
235 # This function should recognise such names and expand them into
236 # full file paths.
237 # Must return undef if $spec is invalid or file does not exist.
238
239 my($file) = $spec; # default output to input
240 my($osname) = $Config{'osname'};
241
242 if ($osname eq 'VMS'){ # dl_expandspec should be defined in dl_vms.xs
243 croak "dl_expandspec: should be defined in XS file!\n";
244 }else{
245 return undef unless -f $file;
246 }
247 print STDERR "dl_expandspec($spec) => $file\n" if $dl_debug;
248 $file;
249}