| 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 | ExtUtils::Liblist::Kid::BEGIN@8 |
| 1 | 1 | 1 | 6µs | 23µs | ExtUtils::Liblist::Kid::BEGIN@19 |
| 1 | 1 | 1 | 6µs | 6µs | ExtUtils::Liblist::Kid::BEGIN@20 |
| 1 | 1 | 1 | 4µs | 6µs | ExtUtils::Liblist::Kid::BEGIN@12 |
| 1 | 1 | 1 | 4µs | 19µs | ExtUtils::Liblist::Kid::BEGIN@18 |
| 1 | 1 | 1 | 3µs | 12µs | ExtUtils::Liblist::Kid::BEGIN@17 |
| 1 | 1 | 1 | 3µs | 14µs | ExtUtils::Liblist::Kid::BEGIN@13 |
| 1 | 1 | 1 | 300ns | 300ns | ExtUtils::Liblist::Kid::__ANON__ (xsub) |
| 0 | 0 | 0 | 0s | 0s | ExtUtils::Liblist::Kid::_debug |
| 0 | 0 | 0 | 0s | 0s | ExtUtils::Liblist::Kid::_unix_os2_ext |
| 0 | 0 | 0 | 0s | 0s | ExtUtils::Liblist::Kid::_vms_ext |
| 0 | 0 | 0 | 0s | 0s | ExtUtils::Liblist::Kid::_win32_attach_extensions |
| 0 | 0 | 0 | 0s | 0s | ExtUtils::Liblist::Kid::_win32_build_file_list |
| 0 | 0 | 0 | 0s | 0s | ExtUtils::Liblist::Kid::_win32_build_prefixed_list |
| 0 | 0 | 0 | 0s | 0s | ExtUtils::Liblist::Kid::_win32_default_search_paths |
| 0 | 0 | 0 | 0s | 0s | ExtUtils::Liblist::Kid::_win32_ext |
| 0 | 0 | 0 | 0s | 0s | ExtUtils::Liblist::Kid::_win32_lib_extensions |
| 0 | 0 | 0 | 0s | 0s | ExtUtils::Liblist::Kid::_win32_make_lib_search_list |
| 0 | 0 | 0 | 0s | 0s | ExtUtils::Liblist::Kid::_win32_search_file |
| 0 | 0 | 0 | 0s | 0s | ExtUtils::Liblist::Kid::_win32_try_attach_extension |
| 0 | 0 | 0 | 0s | 0s | ExtUtils::Liblist::Kid::ext |
| 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 |