Commit | Line | Data |
a0d0e21e |
1 | package 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 | |
17 | use Config; |
18 | use Carp; |
19 | use AutoLoader; |
20 | |
fec02dd3 |
21 | @ISA=qw(AutoLoader); |
a0d0e21e |
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 |
47 | push(@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. |
52 | push(@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 |
57 | boot_DynaLoader() if defined(&boot_DynaLoader); |
a0d0e21e |
58 | |
a0d0e21e |
59 | |
75f92628 |
60 | if ($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 |
64 | } |
65 | |
66 | 1; # End of main code |
67 | |
68 | |
69 | # The bootstrap function cannot be autoloaded (without complications) |
70 | # so we define it here: |
71 | |
72 | sub 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 |
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 |
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 |
116 | print STDERR "BS: $bs ($osname, $dlsrc)\n" if $dl_debug; |
117 | eval { do $bs; }; |
a0d0e21e |
118 | warn "$bs: $@\n" if $@; |
119 | } |
120 | |
75f92628 |
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 |
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 |
139 | |
140 | # See comment block above |
a0d0e21e |
141 | &{"${module}::bootstrap"}(@args); |
142 | } |
143 | |
144 | |
145 | sub _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 | |
157 | sub 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 | |
225 | sub 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 | } |