Filename | /usr/share/perl/5.36/ExtUtils/Liblist/Kid.pm |
Statements | Executed 17 statements in 2.65ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 12µs | 12µs | BEGIN@8 | ExtUtils::Liblist::Kid::
1 | 1 | 1 | 6µs | 23µs | BEGIN@19 | ExtUtils::Liblist::Kid::
1 | 1 | 1 | 6µs | 6µs | BEGIN@20 | ExtUtils::Liblist::Kid::
1 | 1 | 1 | 4µs | 6µs | BEGIN@12 | ExtUtils::Liblist::Kid::
1 | 1 | 1 | 4µs | 19µs | BEGIN@18 | ExtUtils::Liblist::Kid::
1 | 1 | 1 | 3µs | 12µs | BEGIN@17 | ExtUtils::Liblist::Kid::
1 | 1 | 1 | 3µs | 14µs | BEGIN@13 | ExtUtils::Liblist::Kid::
1 | 1 | 1 | 300ns | 300ns | __ANON__ (xsub) | ExtUtils::Liblist::Kid::
0 | 0 | 0 | 0s | 0s | _debug | ExtUtils::Liblist::Kid::
0 | 0 | 0 | 0s | 0s | _unix_os2_ext | ExtUtils::Liblist::Kid::
0 | 0 | 0 | 0s | 0s | _vms_ext | ExtUtils::Liblist::Kid::
0 | 0 | 0 | 0s | 0s | _win32_attach_extensions | ExtUtils::Liblist::Kid::
0 | 0 | 0 | 0s | 0s | _win32_build_file_list | ExtUtils::Liblist::Kid::
0 | 0 | 0 | 0s | 0s | _win32_build_prefixed_list | ExtUtils::Liblist::Kid::
0 | 0 | 0 | 0s | 0s | _win32_default_search_paths | ExtUtils::Liblist::Kid::
0 | 0 | 0 | 0s | 0s | _win32_ext | ExtUtils::Liblist::Kid::
0 | 0 | 0 | 0s | 0s | _win32_lib_extensions | ExtUtils::Liblist::Kid::
0 | 0 | 0 | 0s | 0s | _win32_make_lib_search_list | ExtUtils::Liblist::Kid::
0 | 0 | 0 | 0s | 0s | _win32_search_file | ExtUtils::Liblist::Kid::
0 | 0 | 0 | 0s | 0s | _win32_try_attach_extension | ExtUtils::Liblist::Kid::
0 | 0 | 0 | 0s | 0s | ext | ExtUtils::Liblist::Kid::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package ExtUtils::Liblist::Kid; | ||||
2 | |||||
3 | # XXX Splitting this out into its own .pm is a temporary solution. | ||||
4 | |||||
5 | # This kid package is to be used by MakeMaker. It will not work if | ||||
6 | # $self is not a Makemaker. | ||||
7 | |||||
8 | 2 | 29µs | 1 | 12µs | # spent 12µs within ExtUtils::Liblist::Kid::BEGIN@8 which was called:
# once (12µs+0s) by IPC::Cmd::can_run at line 8 # spent 12µs making 1 call to ExtUtils::Liblist::Kid::BEGIN@8 |
9 | |||||
10 | # Broken out of MakeMaker from version 4.11 | ||||
11 | |||||
12 | 2 | 14µs | 2 | 7µs | # spent 6µs (4+1) within ExtUtils::Liblist::Kid::BEGIN@12 which was called:
# once (4µs+1µs) by IPC::Cmd::can_run at line 12 # spent 6µs making 1 call to ExtUtils::Liblist::Kid::BEGIN@12
# spent 1µs making 1 call to strict::import |
13 | 2 | 28µs | 2 | 25µs | # spent 14µs (3+11) within ExtUtils::Liblist::Kid::BEGIN@13 which was called:
# once (3µs+11µs) by IPC::Cmd::can_run at line 13 # spent 14µs making 1 call to ExtUtils::Liblist::Kid::BEGIN@13
# spent 11µs making 1 call to warnings::import |
14 | 1 | 300ns | our $VERSION = '7.64'; | ||
15 | 1 | 800ns | $VERSION =~ tr/_//d; | ||
16 | |||||
17 | 2 | 14µs | 2 | 20µs | # spent 12µs (3+8) within ExtUtils::Liblist::Kid::BEGIN@17 which was called:
# once (3µs+8µs) by IPC::Cmd::can_run at line 17 # spent 12µs making 1 call to ExtUtils::Liblist::Kid::BEGIN@17
# spent 8µs making 1 call to ExtUtils::MakeMaker::Config::import |
18 | 2 | 14µs | 2 | 34µs | # spent 19µs (4+15) within ExtUtils::Liblist::Kid::BEGIN@18 which was called:
# once (4µs+15µs) by IPC::Cmd::can_run at line 18 # spent 19µs making 1 call to ExtUtils::Liblist::Kid::BEGIN@18
# spent 15µs making 1 call to Exporter::import |
19 | 2 | 18µs | 2 | 39µs | # spent 23µs (6+16) within ExtUtils::Liblist::Kid::BEGIN@19 which was called:
# once (6µs+16µs) by IPC::Cmd::can_run at line 19 # spent 23µs making 1 call to ExtUtils::Liblist::Kid::BEGIN@19
# spent 16µs making 1 call to Exporter::import |
20 | 2 | 2.53ms | 2 | 6µs | # spent 6µs (6+300ns) within ExtUtils::Liblist::Kid::BEGIN@20 which was called:
# once (6µs+300ns) by IPC::Cmd::can_run at line 20 # spent 6µs making 1 call to ExtUtils::Liblist::Kid::BEGIN@20
# spent 300ns making 1 call to ExtUtils::Liblist::Kid::__ANON__ |
21 | |||||
22 | sub ext { | ||||
23 | if ( $^O eq 'VMS' ) { return &_vms_ext; } | ||||
24 | elsif ( $^O eq 'MSWin32' ) { return &_win32_ext; } | ||||
25 | else { return &_unix_os2_ext; } | ||||
26 | } | ||||
27 | |||||
28 | sub _unix_os2_ext { | ||||
29 | my ( $self, $potential_libs, $verbose, $give_libs ) = @_; | ||||
30 | $verbose ||= 0; | ||||
31 | |||||
32 | if ( $^O =~ /os2|android/ and $Config{perllibs} ) { | ||||
33 | |||||
34 | # Dynamic libraries are not transitive, so we may need including | ||||
35 | # the libraries linked against perl.dll/libperl.so again. | ||||
36 | |||||
37 | $potential_libs .= " " if $potential_libs; | ||||
38 | $potential_libs .= $Config{perllibs}; | ||||
39 | } | ||||
40 | return ( "", "", "", "", ( $give_libs ? [] : () ) ) unless $potential_libs; | ||||
41 | warn "Potential libraries are '$potential_libs':\n" if $verbose; | ||||
42 | |||||
43 | my ( $so ) = $Config{so}; | ||||
44 | my ( $libs ) = defined $Config{perllibs} ? $Config{perllibs} : $Config{libs}; | ||||
45 | my $Config_libext = $Config{lib_ext} || ".a"; | ||||
46 | my $Config_dlext = $Config{dlext}; | ||||
47 | |||||
48 | # compute $extralibs, $bsloadlibs and $ldloadlibs from | ||||
49 | # $potential_libs | ||||
50 | # this is a rewrite of Andy Dougherty's extliblist in perl | ||||
51 | |||||
52 | require Text::ParseWords; | ||||
53 | |||||
54 | my ( @searchpath ); # from "-L/path" entries in $potential_libs | ||||
55 | my ( @libpath ) = Text::ParseWords::shellwords( $Config{'libpth'} || '' ); | ||||
56 | my ( @ldloadlibs, @bsloadlibs, @extralibs, @ld_run_path, %ld_run_path_seen ); | ||||
57 | my ( @libs, %libs_seen ); | ||||
58 | my ( $fullname, @fullname ); | ||||
59 | my ( $pwd ) = cwd(); # from Cwd.pm | ||||
60 | my ( $found ) = 0; | ||||
61 | if ($Config{gccversion}) { | ||||
62 | chomp(my @incpath = grep s/^ //, grep { /^#include </ .. /^End of search / } `$Config{cc} -E -v - </dev/null 2>&1 >/dev/null`); | ||||
63 | unshift @libpath, map { s{/include[^/]*}{/lib}; $_ } @incpath | ||||
64 | } | ||||
65 | |||||
66 | if ( $^O eq 'darwin' or $^O eq 'next' ) { | ||||
67 | # 'escape' Mach-O ld -framework and -F flags, so they aren't dropped later on | ||||
68 | $potential_libs =~ s/(^|\s)(-(?:weak_|reexport_|lazy_)?framework)\s+(\S+)/$1-Wl,$2 -Wl,$3/g; | ||||
69 | $potential_libs =~ s/(^|\s)(-F)\s*(\S+)/$1-Wl,$2 -Wl,$3/g; | ||||
70 | } | ||||
71 | # Debian-specific: don't use LD_RUN_PATH for standard dirs | ||||
72 | $ld_run_path_seen{$_}++ for @libpath; | ||||
73 | |||||
74 | foreach my $thislib ( Text::ParseWords::shellwords($potential_libs) ) { | ||||
75 | my ( $custom_name ) = ''; | ||||
76 | |||||
77 | # Handle possible linker path arguments. | ||||
78 | if ( $thislib =~ s/^(-[LR]|-Wl,-R|-Wl,-rpath,)// ) { # save path flag type | ||||
79 | my ( $ptype ) = $1; | ||||
80 | unless ( -d $thislib ) { | ||||
81 | warn "$ptype$thislib ignored, directory does not exist\n" | ||||
82 | if $verbose; | ||||
83 | next; | ||||
84 | } | ||||
85 | my ( $rtype ) = $ptype; | ||||
86 | if ( ( $ptype eq '-R' ) or ( $ptype =~ m!^-Wl,-[Rr]! ) ) { | ||||
87 | if ( $Config{'lddlflags'} =~ /-Wl,-[Rr]/ ) { | ||||
88 | $rtype = '-Wl,-R'; | ||||
89 | } | ||||
90 | elsif ( $Config{'lddlflags'} =~ /-R/ ) { | ||||
91 | $rtype = '-R'; | ||||
92 | } | ||||
93 | } | ||||
94 | unless ( File::Spec->file_name_is_absolute( $thislib ) ) { | ||||
95 | warn "Warning: $ptype$thislib changed to $ptype$pwd/$thislib\n"; | ||||
96 | $thislib = $self->catdir( $pwd, $thislib ); | ||||
97 | } | ||||
98 | push( @searchpath, $thislib ); | ||||
99 | $thislib = qq{"$thislib"} if $thislib =~ / /; # protect spaces if there | ||||
100 | push( @extralibs, "$ptype$thislib" ); | ||||
101 | push( @ldloadlibs, "$rtype$thislib" ); | ||||
102 | next; | ||||
103 | } | ||||
104 | |||||
105 | if ( $thislib =~ m!^-Wl,! ) { | ||||
106 | push( @extralibs, $thislib ); | ||||
107 | push( @ldloadlibs, $thislib ); | ||||
108 | next; | ||||
109 | } | ||||
110 | |||||
111 | # Handle possible library arguments. | ||||
112 | if ( $thislib =~ s/^-l(:)?// ) { | ||||
113 | # Handle -l:foo.so, which means that the library will | ||||
114 | # actually be called foo.so, not libfoo.so. This | ||||
115 | # is used in Android by ExtUtils::Depends to allow one XS | ||||
116 | # module to link to another. | ||||
117 | $custom_name = $1 || ''; | ||||
118 | } | ||||
119 | else { | ||||
120 | warn "Unrecognized argument in LIBS ignored: '$thislib'\n"; | ||||
121 | next; | ||||
122 | } | ||||
123 | |||||
124 | my ( $found_lib ) = 0; | ||||
125 | foreach my $thispth ( @searchpath, @libpath ) { | ||||
126 | |||||
127 | # Try to find the full name of the library. We need this to | ||||
128 | # determine whether it's a dynamically-loadable library or not. | ||||
129 | # This tends to be subject to various os-specific quirks. | ||||
130 | # For gcc-2.6.2 on linux (March 1995), DLD can not load | ||||
131 | # .sa libraries, with the exception of libm.sa, so we | ||||
132 | # deliberately skip them. | ||||
133 | if ((@fullname = | ||||
134 | $self->lsdir($thispth, "^\Qlib$thislib.$so.\E[0-9]+")) || | ||||
135 | (@fullname = | ||||
136 | $self->lsdir($thispth, "^\Qlib$thislib.\E[0-9]+\Q\.$so"))) { | ||||
137 | # Take care that libfoo.so.10 wins against libfoo.so.9. | ||||
138 | # Compare two libraries to find the most recent version | ||||
139 | # number. E.g. if you have libfoo.so.9.0.7 and | ||||
140 | # libfoo.so.10.1, first convert all digits into two | ||||
141 | # decimal places. Then we'll add ".00" to the shorter | ||||
142 | # strings so that we're comparing strings of equal length | ||||
143 | # Thus we'll compare libfoo.so.09.07.00 with | ||||
144 | # libfoo.so.10.01.00. Some libraries might have letters | ||||
145 | # in the version. We don't know what they mean, but will | ||||
146 | # try to skip them gracefully -- we'll set any letter to | ||||
147 | # '0'. Finally, sort in reverse so we can take the | ||||
148 | # first element. | ||||
149 | |||||
150 | #TODO: iterate through the directory instead of sorting | ||||
151 | |||||
152 | $fullname = "$thispth/" . ( | ||||
153 | sort { | ||||
154 | my ( $ma ) = $a; | ||||
155 | my ( $mb ) = $b; | ||||
156 | $ma =~ tr/A-Za-z/0/s; | ||||
157 | $ma =~ s/\b(\d)\b/0$1/g; | ||||
158 | $mb =~ tr/A-Za-z/0/s; | ||||
159 | $mb =~ s/\b(\d)\b/0$1/g; | ||||
160 | while ( length( $ma ) < length( $mb ) ) { $ma .= ".00"; } | ||||
161 | while ( length( $mb ) < length( $ma ) ) { $mb .= ".00"; } | ||||
162 | |||||
163 | # Comparison deliberately backwards | ||||
164 | $mb cmp $ma; | ||||
165 | } @fullname | ||||
166 | )[0]; | ||||
167 | } | ||||
168 | elsif ( -f ( $fullname = "$thispth/lib$thislib.$so" ) | ||||
169 | && ( ( $Config{'dlsrc'} ne "dl_dld.xs" ) || ( $thislib eq "m" ) ) ) | ||||
170 | { | ||||
171 | } | ||||
172 | elsif (-f ( $fullname = "$thispth/lib${thislib}_s$Config_libext" ) | ||||
173 | && ( $Config{'archname'} !~ /RM\d\d\d-svr4/ ) | ||||
174 | && ( $thislib .= "_s" ) ) | ||||
175 | { # we must explicitly use _s version | ||||
176 | } | ||||
177 | elsif ( -f ( $fullname = "$thispth/lib$thislib$Config_libext" ) ) { | ||||
178 | } | ||||
179 | elsif ( defined( $Config_dlext ) | ||||
180 | && -f ( $fullname = "$thispth/lib$thislib.$Config_dlext" ) ) | ||||
181 | { | ||||
182 | } | ||||
183 | elsif ( $^O eq 'darwin' && require DynaLoader && defined &DynaLoader::dl_load_file | ||||
184 | && DynaLoader::dl_load_file( $fullname = "$thispth/lib$thislib.$so", 0 ) ) | ||||
185 | { | ||||
186 | } | ||||
187 | elsif ( -f ( $fullname = "$thispth/$thislib$Config_libext" ) ) { | ||||
188 | } | ||||
189 | elsif ( -f ( $fullname = "$thispth/lib$thislib.dll$Config_libext" ) ) { | ||||
190 | } | ||||
191 | elsif ( $^O eq 'cygwin' && -f ( $fullname = "$thispth/$thislib.dll" ) ) { | ||||
192 | } | ||||
193 | elsif ( -f ( $fullname = "$thispth/Slib$thislib$Config_libext" ) ) { | ||||
194 | } | ||||
195 | elsif ($^O eq 'dgux' | ||||
196 | && -l ( $fullname = "$thispth/lib$thislib$Config_libext" ) | ||||
197 | && readlink( $fullname ) =~ /^elink:/s ) | ||||
198 | { | ||||
199 | |||||
200 | # Some of DG's libraries look like misconnected symbolic | ||||
201 | # links, but development tools can follow them. (They | ||||
202 | # look like this: | ||||
203 | # | ||||
204 | # libm.a -> elink:${SDE_PATH:-/usr}/sde/\ | ||||
205 | # ${TARGET_BINARY_INTERFACE:-m88kdgux}/usr/lib/libm.a | ||||
206 | # | ||||
207 | # , the compilation tools expand the environment variables.) | ||||
208 | } | ||||
209 | elsif ( $custom_name && -f ( $fullname = "$thispth/$thislib" ) ) { | ||||
210 | } | ||||
211 | else { | ||||
212 | warn "$thislib not found in $thispth\n" if $verbose; | ||||
213 | next; | ||||
214 | } | ||||
215 | warn "'-l$thislib' found at $fullname\n" if $verbose; | ||||
216 | push @libs, $fullname unless $libs_seen{$fullname}++; | ||||
217 | $found++; | ||||
218 | $found_lib++; | ||||
219 | |||||
220 | # Now update library lists | ||||
221 | |||||
222 | # what do we know about this library... | ||||
223 | # "Sounds like we should always assume it's a dynamic library on AIX." | ||||
224 | my $is_dyna = $^O eq 'aix' ? 1 : ( $fullname !~ /\Q$Config_libext\E\z/ ); | ||||
225 | my $in_perl = ( $libs =~ /\B-l:?\Q${thislib}\E\b/s ); | ||||
226 | |||||
227 | # include the path to the lib once in the dynamic linker path | ||||
228 | # but only if it is a dynamic lib and not in Perl itself | ||||
229 | my ( $fullnamedir ) = dirname( $fullname ); | ||||
230 | push @ld_run_path, $fullnamedir | ||||
231 | if $is_dyna | ||||
232 | && !$in_perl | ||||
233 | && !$ld_run_path_seen{$fullnamedir}++; | ||||
234 | |||||
235 | # Do not add it into the list if it is already linked in | ||||
236 | # with the main perl executable. | ||||
237 | # We have to special-case the NeXT, because math and ndbm | ||||
238 | # are both in libsys_s | ||||
239 | unless ( | ||||
240 | $in_perl | ||||
241 | || ( $Config{'osname'} eq 'next' | ||||
242 | && ( $thislib eq 'm' || $thislib eq 'ndbm' ) ) | ||||
243 | ) | ||||
244 | { | ||||
245 | push( @extralibs, "-l$custom_name$thislib" ); | ||||
246 | } | ||||
247 | |||||
248 | # We might be able to load this archive file dynamically | ||||
249 | if ( ( $Config{'dlsrc'} =~ /dl_next/ && $Config{'osvers'} lt '4_0' ) | ||||
250 | || ( $Config{'dlsrc'} =~ /dl_dld/ ) ) | ||||
251 | { | ||||
252 | |||||
253 | # We push -l$thislib instead of $fullname because | ||||
254 | # it avoids hardwiring a fixed path into the .bs file. | ||||
255 | # Mkbootstrap will automatically add dl_findfile() to | ||||
256 | # the .bs file if it sees a name in the -l format. | ||||
257 | # USE THIS, when dl_findfile() is fixed: | ||||
258 | # push(@bsloadlibs, "-l$thislib"); | ||||
259 | # OLD USE WAS while checking results against old_extliblist | ||||
260 | push( @bsloadlibs, "$fullname" ); | ||||
261 | } | ||||
262 | else { | ||||
263 | if ( $is_dyna ) { | ||||
264 | |||||
265 | # For SunOS4, do not add in this shared library if | ||||
266 | # it is already linked in the main perl executable | ||||
267 | push( @ldloadlibs, "-l$custom_name$thislib" ) | ||||
268 | unless ( $in_perl and $^O eq 'sunos' ); | ||||
269 | } | ||||
270 | else { | ||||
271 | push( @ldloadlibs, "-l$custom_name$thislib" ); | ||||
272 | } | ||||
273 | } | ||||
274 | last; # found one here so don't bother looking further | ||||
275 | } | ||||
276 | warn "Warning (mostly harmless): " . "No library found for -l$thislib\n" | ||||
277 | unless $found_lib > 0; | ||||
278 | } | ||||
279 | |||||
280 | unless ( $found ) { | ||||
281 | return ( '', '', '', '', ( $give_libs ? \@libs : () ) ); | ||||
282 | } | ||||
283 | else { | ||||
284 | return ( "@extralibs", "@bsloadlibs", "@ldloadlibs", join( ":", @ld_run_path ), ( $give_libs ? \@libs : () ) ); | ||||
285 | } | ||||
286 | } | ||||
287 | |||||
288 | sub _win32_ext { | ||||
289 | |||||
290 | require Text::ParseWords; | ||||
291 | |||||
292 | my ( $self, $potential_libs, $verbose, $give_libs ) = @_; | ||||
293 | $verbose ||= 0; | ||||
294 | |||||
295 | # If user did not supply a list, we punt. | ||||
296 | # (caller should probably use the list in $Config{libs}) | ||||
297 | return ( "", "", "", "", ( $give_libs ? [] : () ) ) unless $potential_libs; | ||||
298 | |||||
299 | # TODO: make this use MM_Win32.pm's compiler detection | ||||
300 | my %libs_seen; | ||||
301 | my @extralibs; | ||||
302 | my $cc = $Config{cc} || ''; | ||||
303 | my $VC = $cc =~ /\bcl\b/i; | ||||
304 | my $GC = $cc =~ /\bgcc\b/i; | ||||
305 | |||||
306 | my $libext = _win32_lib_extensions(); | ||||
307 | my @searchpath = ( '' ); # from "-L/path" entries in $potential_libs | ||||
308 | my @libpath = _win32_default_search_paths( $VC, $GC ); | ||||
309 | my $pwd = cwd(); # from Cwd.pm | ||||
310 | my $search = 1; | ||||
311 | |||||
312 | # compute @extralibs from $potential_libs | ||||
313 | my @lib_search_list = _win32_make_lib_search_list( $potential_libs, $verbose ); | ||||
314 | for ( @lib_search_list ) { | ||||
315 | |||||
316 | my $thislib = $_; | ||||
317 | |||||
318 | # see if entry is a flag | ||||
319 | if ( /^:\w+$/ ) { | ||||
320 | $search = 0 if lc eq ':nosearch'; | ||||
321 | $search = 1 if lc eq ':search'; | ||||
322 | _debug( "Ignoring unknown flag '$thislib'\n", $verbose ) if !/^:(no)?(search|default)$/i; | ||||
323 | next; | ||||
324 | } | ||||
325 | |||||
326 | # if searching is disabled, do compiler-specific translations | ||||
327 | unless ( $search ) { | ||||
328 | s/^-l(.+)$/$1.lib/ unless $GC; | ||||
329 | s/^-L/-libpath:/ if $VC; | ||||
330 | push( @extralibs, $_ ); | ||||
331 | next; | ||||
332 | } | ||||
333 | |||||
334 | # handle possible linker path arguments | ||||
335 | if ( s/^-L// and not -d ) { | ||||
336 | _debug( "$thislib ignored, directory does not exist\n", $verbose ); | ||||
337 | next; | ||||
338 | } | ||||
339 | elsif ( -d ) { | ||||
340 | unless ( File::Spec->file_name_is_absolute( $_ ) ) { | ||||
341 | warn "Warning: '$thislib' changed to '-L$pwd/$_'\n"; | ||||
342 | $_ = $self->catdir( $pwd, $_ ); | ||||
343 | } | ||||
344 | push( @searchpath, $_ ); | ||||
345 | next; | ||||
346 | } | ||||
347 | |||||
348 | my @paths = ( @searchpath, @libpath ); | ||||
349 | my ( $fullname, $path ) = _win32_search_file( $thislib, $libext, \@paths, $verbose, $GC ); | ||||
350 | |||||
351 | if ( !$fullname ) { | ||||
352 | warn "Warning (mostly harmless): No library found for $thislib\n"; | ||||
353 | next; | ||||
354 | } | ||||
355 | |||||
356 | _debug( "'$thislib' found as '$fullname'\n", $verbose ); | ||||
357 | push( @extralibs, $fullname ); | ||||
358 | $libs_seen{$fullname} = 1 if $path; # why is this a special case? | ||||
359 | } | ||||
360 | |||||
361 | my @libs = sort keys %libs_seen; | ||||
362 | |||||
363 | return ( '', '', '', '', ( $give_libs ? \@libs : () ) ) unless @extralibs; | ||||
364 | |||||
365 | # make sure paths with spaces are properly quoted | ||||
366 | @extralibs = map { qq["$_"] } @extralibs; | ||||
367 | @libs = map { qq["$_"] } @libs; | ||||
368 | |||||
369 | my $lib = join( ' ', @extralibs ); | ||||
370 | |||||
371 | # normalize back to backward slashes (to help braindead tools) | ||||
372 | # XXX this may break equally braindead GNU tools that don't understand | ||||
373 | # backslashes, either. Seems like one can't win here. Cursed be CP/M. | ||||
374 | $lib =~ s,/,\\,g; | ||||
375 | |||||
376 | _debug( "Result: $lib\n", $verbose ); | ||||
377 | wantarray ? ( $lib, '', $lib, '', ( $give_libs ? \@libs : () ) ) : $lib; | ||||
378 | } | ||||
379 | |||||
380 | sub _win32_make_lib_search_list { | ||||
381 | my ( $potential_libs, $verbose ) = @_; | ||||
382 | |||||
383 | # If Config.pm defines a set of default libs, we always | ||||
384 | # tack them on to the user-supplied list, unless the user | ||||
385 | # specified :nodefault | ||||
386 | my $libs = $Config{'perllibs'}; | ||||
387 | $potential_libs = join( ' ', $potential_libs, $libs ) if $libs and $potential_libs !~ /:nodefault/i; | ||||
388 | _debug( "Potential libraries are '$potential_libs':\n", $verbose ); | ||||
389 | |||||
390 | $potential_libs =~ s,\\,/,g; # normalize to forward slashes | ||||
391 | |||||
392 | my @list = Text::ParseWords::quotewords( '\s+', 0, $potential_libs ); | ||||
393 | |||||
394 | return @list; | ||||
395 | } | ||||
396 | |||||
397 | sub _win32_default_search_paths { | ||||
398 | my ( $VC, $GC ) = @_; | ||||
399 | |||||
400 | my $libpth = $Config{'libpth'} || ''; | ||||
401 | $libpth =~ s,\\,/,g; # normalize to forward slashes | ||||
402 | |||||
403 | my @libpath = Text::ParseWords::quotewords( '\s+', 0, $libpth ); | ||||
404 | push @libpath, "$Config{installarchlib}/CORE"; # add "$Config{installarchlib}/CORE" to default search path | ||||
405 | |||||
406 | push @libpath, split /;/, $ENV{LIB} if $VC and $ENV{LIB}; | ||||
407 | push @libpath, split /;/, $ENV{LIBRARY_PATH} if $GC and $ENV{LIBRARY_PATH}; | ||||
408 | |||||
409 | return @libpath; | ||||
410 | } | ||||
411 | |||||
412 | sub _win32_search_file { | ||||
413 | my ( $thislib, $libext, $paths, $verbose, $GC ) = @_; | ||||
414 | |||||
415 | my @file_list = _win32_build_file_list( $thislib, $GC, $libext ); | ||||
416 | |||||
417 | for my $lib_file ( @file_list ) { | ||||
418 | for my $path ( @{$paths} ) { | ||||
419 | my $fullname = $lib_file; | ||||
420 | $fullname = "$path\\$fullname" if $path; | ||||
421 | |||||
422 | return ( $fullname, $path ) if -f $fullname; | ||||
423 | |||||
424 | _debug( "'$thislib' not found as '$fullname'\n", $verbose ); | ||||
425 | } | ||||
426 | } | ||||
427 | |||||
428 | return; | ||||
429 | } | ||||
430 | |||||
431 | sub _win32_build_file_list { | ||||
432 | my ( $lib, $GC, $extensions ) = @_; | ||||
433 | |||||
434 | my @pre_fixed = _win32_build_prefixed_list( $lib, $GC ); | ||||
435 | return map _win32_attach_extensions( $_, $extensions ), @pre_fixed; | ||||
436 | } | ||||
437 | |||||
438 | sub _win32_build_prefixed_list { | ||||
439 | my ( $lib, $GC ) = @_; | ||||
440 | |||||
441 | return $lib if $lib !~ s/^-l//; | ||||
442 | return $lib if $lib =~ /^lib/ and !$GC; | ||||
443 | |||||
444 | ( my $no_prefix = $lib ) =~ s/^lib//i; | ||||
445 | $lib = "lib$lib" if $no_prefix eq $lib; | ||||
446 | |||||
447 | return ( $lib, $no_prefix ) if $GC; | ||||
448 | return ( $no_prefix, $lib ); | ||||
449 | } | ||||
450 | |||||
451 | sub _win32_attach_extensions { | ||||
452 | my ( $lib, $extensions ) = @_; | ||||
453 | return map _win32_try_attach_extension( $lib, $_ ), @{$extensions}; | ||||
454 | } | ||||
455 | |||||
456 | sub _win32_try_attach_extension { | ||||
457 | my ( $lib, $extension ) = @_; | ||||
458 | |||||
459 | return $lib if $lib =~ /\Q$extension\E$/i; | ||||
460 | return "$lib$extension"; | ||||
461 | } | ||||
462 | |||||
463 | sub _win32_lib_extensions { | ||||
464 | my @extensions; | ||||
465 | push @extensions, $Config{'lib_ext'} if $Config{'lib_ext'}; | ||||
466 | push @extensions, '.dll.a' if grep { m!^\.a$! } @extensions; | ||||
467 | push @extensions, '.lib' unless grep { m!^\.lib$! } @extensions; | ||||
468 | return \@extensions; | ||||
469 | } | ||||
470 | |||||
471 | sub _debug { | ||||
472 | my ( $message, $verbose ) = @_; | ||||
473 | return if !$verbose; | ||||
474 | warn $message; | ||||
475 | return; | ||||
476 | } | ||||
477 | |||||
478 | sub _vms_ext { | ||||
479 | my ( $self, $potential_libs, $verbose, $give_libs ) = @_; | ||||
480 | $verbose ||= 0; | ||||
481 | |||||
482 | my ( @crtls, $crtlstr ); | ||||
483 | @crtls = ( ( $Config{'ldflags'} =~ m-/Debug-i ? $Config{'dbgprefix'} : '' ) . 'PerlShr/Share' ); | ||||
484 | push( @crtls, grep { not /\(/ } split /\s+/, $Config{'perllibs'} ); | ||||
485 | push( @crtls, grep { not /\(/ } split /\s+/, $Config{'libc'} ); | ||||
486 | |||||
487 | # In general, we pass through the basic libraries from %Config unchanged. | ||||
488 | # The one exception is that if we're building in the Perl source tree, and | ||||
489 | # a library spec could be resolved via a logical name, we go to some trouble | ||||
490 | # to insure that the copy in the local tree is used, rather than one to | ||||
491 | # which a system-wide logical may point. | ||||
492 | if ( $self->{PERL_SRC} ) { | ||||
493 | my ( $locspec, $type ); | ||||
494 | foreach my $lib ( @crtls ) { | ||||
495 | if ( ( $locspec, $type ) = $lib =~ m{^([\w\$-]+)(/\w+)?} and $locspec =~ /perl/i ) { | ||||
496 | if ( lc $type eq '/share' ) { $locspec .= $Config{'exe_ext'}; } | ||||
497 | elsif ( lc $type eq '/library' ) { $locspec .= $Config{'lib_ext'}; } | ||||
498 | else { $locspec .= $Config{'obj_ext'}; } | ||||
499 | $locspec = $self->catfile( $self->{PERL_SRC}, $locspec ); | ||||
500 | $lib = "$locspec$type" if -e $locspec; | ||||
501 | } | ||||
502 | } | ||||
503 | } | ||||
504 | $crtlstr = @crtls ? join( ' ', @crtls ) : ''; | ||||
505 | |||||
506 | unless ( $potential_libs ) { | ||||
507 | warn "Result:\n\tEXTRALIBS: \n\tLDLOADLIBS: $crtlstr\n" if $verbose; | ||||
508 | return ( '', '', $crtlstr, '', ( $give_libs ? [] : () ) ); | ||||
509 | } | ||||
510 | |||||
511 | my ( %found, @fndlibs, $ldlib ); | ||||
512 | my $cwd = cwd(); | ||||
513 | my ( $so, $lib_ext, $obj_ext ) = @Config{ 'so', 'lib_ext', 'obj_ext' }; | ||||
514 | |||||
515 | # List of common Unix library names and their VMS equivalents | ||||
516 | # (VMS equivalent of '' indicates that the library is automatically | ||||
517 | # searched by the linker, and should be skipped here.) | ||||
518 | my ( @flibs, %libs_seen ); | ||||
519 | my %libmap = ( | ||||
520 | 'm' => '', | ||||
521 | 'f77' => '', | ||||
522 | 'F77' => '', | ||||
523 | 'V77' => '', | ||||
524 | 'c' => '', | ||||
525 | 'malloc' => '', | ||||
526 | 'crypt' => '', | ||||
527 | 'resolv' => '', | ||||
528 | 'c_s' => '', | ||||
529 | 'socket' => '', | ||||
530 | 'X11' => 'DECW$XLIBSHR', | ||||
531 | 'Xt' => 'DECW$XTSHR', | ||||
532 | 'Xm' => 'DECW$XMLIBSHR', | ||||
533 | 'Xmu' => 'DECW$XMULIBSHR' | ||||
534 | ); | ||||
535 | |||||
536 | warn "Potential libraries are '$potential_libs'\n" if $verbose; | ||||
537 | |||||
538 | # First, sort out directories and library names in the input | ||||
539 | my ( @dirs, @libs ); | ||||
540 | foreach my $lib ( split ' ', $potential_libs ) { | ||||
541 | push( @dirs, $1 ), next if $lib =~ /^-L(.*)/; | ||||
542 | push( @dirs, $lib ), next if $lib =~ /[:>\]]$/; | ||||
543 | push( @dirs, $lib ), next if -d $lib; | ||||
544 | push( @libs, $1 ), next if $lib =~ /^-l(.*)/; | ||||
545 | push( @libs, $lib ); | ||||
546 | } | ||||
547 | push( @dirs, split( ' ', $Config{'libpth'} ) ); | ||||
548 | |||||
549 | # Now make sure we've got VMS-syntax absolute directory specs | ||||
550 | # (We don't, however, check whether someone's hidden a relative | ||||
551 | # path in a logical name.) | ||||
552 | foreach my $dir ( @dirs ) { | ||||
553 | unless ( -d $dir ) { | ||||
554 | warn "Skipping nonexistent Directory $dir\n" if $verbose > 1; | ||||
555 | $dir = ''; | ||||
556 | next; | ||||
557 | } | ||||
558 | warn "Resolving directory $dir\n" if $verbose; | ||||
559 | if ( File::Spec->file_name_is_absolute( $dir ) ) { | ||||
560 | $dir = VMS::Filespec::vmspath( $dir ); | ||||
561 | } | ||||
562 | else { | ||||
563 | $dir = $self->catdir( $cwd, $dir ); | ||||
564 | } | ||||
565 | } | ||||
566 | @dirs = grep { length( $_ ) } @dirs; | ||||
567 | unshift( @dirs, '' ); # Check each $lib without additions first | ||||
568 | |||||
569 | LIB: foreach my $lib ( @libs ) { | ||||
570 | if ( exists $libmap{$lib} ) { | ||||
571 | next unless length $libmap{$lib}; | ||||
572 | $lib = $libmap{$lib}; | ||||
573 | } | ||||
574 | |||||
575 | my ( @variants, $cand ); | ||||
576 | my ( $ctype ) = ''; | ||||
577 | |||||
578 | # If we don't have a file type, consider it a possibly abbreviated name and | ||||
579 | # check for common variants. We try these first to grab libraries before | ||||
580 | # a like-named executable image (e.g. -lperl resolves to perlshr.exe | ||||
581 | # before perl.exe). | ||||
582 | if ( $lib !~ /\.[^:>\]]*$/ ) { | ||||
583 | push( @variants, "${lib}shr", "${lib}rtl", "${lib}lib" ); | ||||
584 | push( @variants, "lib$lib" ) if $lib !~ /[:>\]]/; | ||||
585 | } | ||||
586 | push( @variants, $lib ); | ||||
587 | warn "Looking for $lib\n" if $verbose; | ||||
588 | foreach my $variant ( @variants ) { | ||||
589 | my ( $fullname, $name ); | ||||
590 | |||||
591 | foreach my $dir ( @dirs ) { | ||||
592 | my ( $type ); | ||||
593 | |||||
594 | $name = "$dir$variant"; | ||||
595 | warn "\tChecking $name\n" if $verbose > 2; | ||||
596 | $fullname = VMS::Filespec::rmsexpand( $name ); | ||||
597 | if ( defined $fullname and -f $fullname ) { | ||||
598 | |||||
599 | # It's got its own suffix, so we'll have to figure out the type | ||||
600 | if ( $fullname =~ /(?:$so|exe)$/i ) { $type = 'SHR'; } | ||||
601 | elsif ( $fullname =~ /(?:$lib_ext|olb)$/i ) { $type = 'OLB'; } | ||||
602 | elsif ( $fullname =~ /(?:$obj_ext|obj)$/i ) { | ||||
603 | warn "Warning (mostly harmless): " . "Plain object file $fullname found in library list\n"; | ||||
604 | $type = 'OBJ'; | ||||
605 | } | ||||
606 | else { | ||||
607 | warn "Warning (mostly harmless): " . "Unknown library type for $fullname; assuming shared\n"; | ||||
608 | $type = 'SHR'; | ||||
609 | } | ||||
610 | } | ||||
611 | elsif (-f ( $fullname = VMS::Filespec::rmsexpand( $name, $so ) ) | ||||
612 | or -f ( $fullname = VMS::Filespec::rmsexpand( $name, '.exe' ) ) ) | ||||
613 | { | ||||
614 | $type = 'SHR'; | ||||
615 | $name = $fullname unless $fullname =~ /exe;?\d*$/i; | ||||
616 | } | ||||
617 | elsif ( | ||||
618 | not length( $ctype ) and # If we've got a lib already, | ||||
619 | ( -f ( $fullname = VMS::Filespec::rmsexpand( $name, $lib_ext ) ) or -f ( $fullname = VMS::Filespec::rmsexpand( $name, '.olb' ) ) ) | ||||
620 | |||||
621 | ) | ||||
622 | { | ||||
623 | $type = 'OLB'; | ||||
624 | $name = $fullname unless $fullname =~ /olb;?\d*$/i; | ||||
625 | } | ||||
626 | elsif ( | ||||
627 | not length( $ctype ) and # If we've got a lib already, | ||||
628 | ( -f ( $fullname = VMS::Filespec::rmsexpand( $name, $obj_ext ) ) or -f ( $fullname = VMS::Filespec::rmsexpand( $name, '.obj' ) ) ) | ||||
629 | |||||
630 | ) | ||||
631 | { | ||||
632 | warn "Warning (mostly harmless): " . "Plain object file $fullname found in library list\n"; | ||||
633 | $type = 'OBJ'; | ||||
634 | $name = $fullname unless $fullname =~ /obj;?\d*$/i; | ||||
635 | } | ||||
636 | if ( defined $type ) { | ||||
637 | $ctype = $type; | ||||
638 | $cand = $name; | ||||
639 | last if $ctype eq 'SHR'; | ||||
640 | } | ||||
641 | } | ||||
642 | if ( $ctype ) { | ||||
643 | |||||
644 | push @{ $found{$ctype} }, $cand; | ||||
645 | warn "\tFound as $cand (really $fullname), type $ctype\n" | ||||
646 | if $verbose > 1; | ||||
647 | push @flibs, $name unless $libs_seen{$fullname}++; | ||||
648 | next LIB; | ||||
649 | } | ||||
650 | } | ||||
651 | warn "Warning (mostly harmless): " . "No library found for $lib\n"; | ||||
652 | } | ||||
653 | |||||
654 | push @fndlibs, @{ $found{OBJ} } if exists $found{OBJ}; | ||||
655 | push @fndlibs, map { "$_/Library" } @{ $found{OLB} } if exists $found{OLB}; | ||||
656 | push @fndlibs, map { "$_/Share" } @{ $found{SHR} } if exists $found{SHR}; | ||||
657 | my $lib = join( ' ', @fndlibs ); | ||||
658 | |||||
659 | $ldlib = $crtlstr ? "$lib $crtlstr" : $lib; | ||||
660 | $ldlib =~ s/^\s+|\s+$//g; | ||||
661 | warn "Result:\n\tEXTRALIBS: $lib\n\tLDLOADLIBS: $ldlib\n" if $verbose; | ||||
662 | wantarray ? ( $lib, '', $ldlib, '', ( $give_libs ? \@flibs : () ) ) : $lib; | ||||
663 | } | ||||
664 | |||||
665 | 1 | 3µs | 1; | ||
# spent 300ns within ExtUtils::Liblist::Kid::__ANON__ which was called:
# once (300ns+0s) by ExtUtils::Liblist::Kid::BEGIN@20 at line 20 |