cygwin can use an empty extension for exes too
[imager.git] / lib / Imager / Probe.pm
CommitLineData
1d7e3124
TC
1package Imager::Probe;
2use strict;
3use File::Spec;
4use Config;
d2f87b00 5use Cwd ();
1d7e3124 6
2c28bd96 7our $VERSION = "1.006";
48a9761f 8
cac1147d
TC
9my @alt_transfer = qw/altname incsuffix libbase/;
10
1d7e3124
TC
11sub probe {
12 my ($class, $req) = @_;
13
14 $req->{verbose} ||= $ENV{IM_VERBOSE};
15
16 my $name = $req->{name};
17 my $result;
18 if ($req->{code}) {
19 $result = _probe_code($req);
20 }
21 if (!$result && $req->{pkg}) {
22 $result = _probe_pkg($req);
23 }
24 if (!$result && $req->{inccheck} && ($req->{libcheck} || $req->{libbase})) {
cac1147d 25 $req->{altname} ||= "main";
1d7e3124
TC
26 $result = _probe_check($req);
27 }
de50f459
TC
28
29 if ($result && $req->{testcode}) {
30 $result = _probe_test($req, $result);
31 }
32
cac1147d
TC
33 if (!$result && $req->{alternatives}) {
34 ALTCHECK:
35 my $index = 1;
36 for my $alt (@{$req->{alternatives}}) {
a9120a5e 37 $req->{altname} = $alt->{altname} || "alt $index";
cac1147d
TC
38 $req->{verbose}
39 and print "$req->{name}: Trying alternative $index\n";
40 my %work = %$req;
41 for my $key (@alt_transfer) {
42 exists $alt->{$key} and $work{$key} = $alt->{$key};
43 }
de50f459
TC
44 $result = _probe_check(\%work);
45
46 if ($result && $req->{testcode}) {
47 $result = _probe_test(\%work, $result);
48 }
49
50 $result
cac1147d 51 and last;
de50f459 52
cac1147d
TC
53 ++$index;
54 }
55 }
1d7e3124
TC
56
57 if (!$result && $req->{testcode}) {
58 $result = _probe_fake($req);
1d7e3124 59
de50f459
TC
60 $result or return;
61
1d7e3124
TC
62 $result = _probe_test($req, $result);
63 }
64
65 $result or return;
66
67 return $result;
68}
69
70sub _probe_code {
71 my ($req) = @_;
72
73 my $code = $req->{code};
74 my @probes = ref $code eq "ARRAY" ? @$code : $code;
75
76 my $result;
77 for my $probe (@probes) {
78 $result = $probe->($req)
79 and return $result;
80 }
81
82 return;
83}
84
85sub is_exe {
86 my ($name) = @_;
87
88 my @exe_suffix = $Config{_exe};
89 if ($^O eq 'MSWin32') {
90 push @exe_suffix, qw/.bat .cmd/;
91 }
1fcb0a94
TC
92 elsif ($^O eq 'cygwin') {
93 push @exe_suffix, "";
94 }
1d7e3124
TC
95
96 for my $dir (File::Spec->path) {
97 for my $suffix (@exe_suffix) {
98 -x File::Spec->catfile($dir, "$name$suffix")
99 and return 1;
100 }
101 }
102
103 return;
104}
105
106sub _probe_pkg {
107 my ($req) = @_;
108
82f14556
TC
109 # Setup pkg-config's environment variable to search non-standard paths
110 # which may be provided by --libdirs.
111 my @pkgcfg_paths = map { "$_/pkgconfig" } _lib_paths( $req );
112 push @pkgcfg_paths, $ENV{ 'PKG_CONFIG_PATH' } if $ENV{ 'PKG_CONFIG_PATH' };
113
e17b7029 114 local $ENV{ 'PKG_CONFIG_PATH' } = join $Config{path_sep}, @pkgcfg_paths;
82f14556 115
1d7e3124
TC
116 is_exe('pkg-config') or return;
117 my $redir = $^O eq 'MSWin32' ? '' : '2>/dev/null';
118
119 my @pkgs = @{$req->{pkg}};
120 for my $pkg (@pkgs) {
121 if (!system("pkg-config $pkg --exists $redir")) {
122 # if we find it, but the following fail, then pkg-config is too
123 # broken to be useful
124 my $cflags = `pkg-config $pkg --cflags`
125 and !$? or return;
126
127 my $lflags = `pkg-config $pkg --libs`
128 and !$? or return;
129
a9120a5e
TC
130 my $defines = '';
131 $cflags =~ s/(-D\S+)/$defines .= " $1"; ''/ge;
132
1d7e3124
TC
133 chomp $cflags;
134 chomp $lflags;
135 print "$req->{name}: Found via pkg-config $pkg\n";
c3f05aa8
TC
136 print <<EOS if $req->{verbose};
137 cflags: $cflags
138 defines: $defines
139 lflags: $lflags
140EOS
535921f9
TC
141 # rt 75869
142 # if Win32 doesn't provide this information, too bad
143 if (!grep(/^-L/, split " ", $lflags)
144 && $^O ne 'MSWin32') {
145 # pkg-config told us about the library, make sure it's
146 # somewhere EU::MM can find it
147 print "Checking if EU::MM can find $lflags\n" if $req->{verbose};
148 my ($extra, $bs_load, $ld_load, $ld_run_path) =
149 ExtUtils::Liblist->ext($lflags, $req->{verbose});
150 unless ($ld_run_path) {
151 # search our standard places
152 $lflags = _resolve_libs($req, $lflags);
153 }
154 }
155
1d7e3124
TC
156 return
157 {
158 INC => $cflags,
159 LIBS => $lflags,
5cbee95a 160 DEFINE => $defines,
1d7e3124
TC
161 };
162 }
163 }
164
165 print "$req->{name}: Not found via pkg-config\n";
166
167 return;
168}
169
ae394c13
TC
170sub _is_msvc {
171 return $Config{cc} eq "cl";
172}
173
174sub _lib_basename {
175 my ($base) = @_;
176
177 if (_is_msvc()) {
178 return $base;
179 }
180 else {
181 return "lib$base";
182 }
183}
184
185sub _lib_option {
186 my ($base) = @_;
187
188 if (_is_msvc()) {
189 return $base . $Config{_a};
190 }
191 else {
192 return "-l$base";
193 }
194}
195
196sub _quotearg {
197 my ($opt) = @_;
198
199 return $opt =~ /\s/ ? qq("$opt") : $opt;
200}
201
1d7e3124
TC
202sub _probe_check {
203 my ($req) = @_;
204
de50f459
TC
205 my @libcheck;
206 my @libbase;
207 if ($req->{libcheck}) {
208 if (ref $req->{libcheck} eq "ARRAY") {
209 push @libcheck, @{$req->{libcheck}};
210 }
211 else {
212 push @libcheck, $req->{libcheck};
213 }
214 }
215 elsif ($req->{libbase}) {
216 @libbase = ref $req->{libbase} ? @{$req->{libbase}} : $req->{libbase};
217
1d7e3124
TC
218 my $lext=$Config{'so'}; # Get extensions of libraries
219 my $aext=$Config{'_a'};
de50f459
TC
220
221 for my $libbase (@libbase) {
222 my $basename = _lib_basename($libbase);
223 push @libcheck, sub {
224 -e File::Spec->catfile($_[0], "$basename$aext")
225 || -e File::Spec->catfile($_[0], "$basename.$lext")
226 };
227 }
228 }
229 else {
230 print "$req->{name}: No libcheck or libbase, nothing to search for\n"
231 if $req->{verbose};
232 return;
1d7e3124
TC
233 }
234
de50f459 235 my @found_libpath;
1d7e3124
TC
236 my @lib_search = _lib_paths($req);
237 print "$req->{name}: Searching directories for libraries:\n"
238 if $req->{verbose};
de50f459
TC
239 for my $libcheck (@libcheck) {
240 for my $path (@lib_search) {
241 print "$req->{name}: $path\n" if $req->{verbose};
242 if ($libcheck->($path)) {
243 print "$req->{name}: Found!\n" if $req->{verbose};
244 push @found_libpath, $path;
245 last;
246 }
1d7e3124
TC
247 }
248 }
249
250 my $found_incpath;
251 my $inccheck = $req->{inccheck};
252 my @inc_search = _inc_paths($req);
253 print "$req->{name}: Searching directories for headers:\n"
254 if $req->{verbose};
255 for my $path (@inc_search) {
256 print "$req->{name}: $path\n" if $req->{verbose};
257 if ($inccheck->($path)) {
258 print "$req->{name}: Found!\n" if $req->{verbose};
259 $found_incpath = $path;
260 last;
261 }
262 }
263
cac1147d 264 my $alt = "";
a9120a5e 265 if ($req->{altname}) {
cac1147d
TC
266 $alt = " $req->{altname}:";
267 }
268 print "$req->{name}:$alt includes ", $found_incpath ? "" : "not ",
de50f459 269 "found - libraries ", @found_libpath == @libcheck ? "" : "not ", "found\n";
1d7e3124 270
de50f459 271 @found_libpath == @libcheck && $found_incpath
1d7e3124
TC
272 or return;
273
de50f459 274 my @libs = map "-L$_", @found_libpath;
1d7e3124
TC
275 if ($req->{libopts}) {
276 push @libs, $req->{libopts};
277 }
de50f459
TC
278 elsif (@libbase) {
279 push @libs, map _lib_option($_), @libbase;
1d7e3124
TC
280 }
281 else {
a9120a5e 282 die "$req->{altname}: inccheck but no libbase or libopts";
1d7e3124
TC
283 }
284
285 return
286 {
ae394c13
TC
287 INC => _quotearg("-I$found_incpath"),
288 LIBS => join(" ", map _quotearg($_), @libs),
5cbee95a 289 DEFINE => "",
1d7e3124
TC
290 };
291}
292
293sub _probe_fake {
294 my ($req) = @_;
295
296 # the caller provided test code, and the compiler may look in
297 # places we don't, see Imager-Screenshot ticket 56793,
298 # so fake up a result so the test code can
299 my $lopts;
300 if ($req->{libopts}) {
301 $lopts = $req->{libopts};
302 }
303 elsif (defined $req->{libbase}) {
304 # might not need extra libraries, eg. Win32 perl already links
305 # everything
2c28bd96 306 my @libs = $req->{libbase}
d39e7aca 307 ? ( ref $req->{libbase} ? @{$req->{libbase}} : $req->{libbase} )
2c28bd96
TC
308 : ();
309 $lopts = join " ", map _lib_option($_), @libs;
1d7e3124
TC
310 }
311 if (defined $lopts) {
fdc9346d 312 print "$req->{name}: Checking if the compiler can find them on its own\n";
1d7e3124
TC
313 return
314 {
315 INC => "",
316 LIBS => $lopts,
5cbee95a 317 DEFINE => "",
1d7e3124
TC
318 };
319 }
320 else {
321 print "$req->{name}: Can't fake it - no libbase or libopts\n"
322 if $req->{verbose};
323 return;
324 }
325}
326
327sub _probe_test {
328 my ($req, $result) = @_;
329
330 require Devel::CheckLib;
331 # setup LD_RUN_PATH to match link time
c3f05aa8 332 print "Asking liblist for LD_RUN_PATH:\n" if $req->{verbose};
1d7e3124 333 my ($extra, $bs_load, $ld_load, $ld_run_path) =
82f14556 334 ExtUtils::Liblist->ext($result->{LIBS}, $req->{verbose});
1d7e3124
TC
335 local $ENV{LD_RUN_PATH};
336
337 if ($ld_run_path) {
82f14556 338 print "Setting LD_RUN_PATH=$ld_run_path for $req->{name} probe\n"
1d7e3124
TC
339 if $req->{verbose};
340 $ENV{LD_RUN_PATH} = $ld_run_path;
ba751dab
TC
341 if ($Config{lddlflags} =~ /([^ ]*-(?:rpath|R)[,=]?)([^ ]+)/
342 && -d $2) {
343 # hackety, hackety
344 # LD_RUN_PATH is ignored when there's already an -rpath option
345 # so provide one
346 my $prefix = $1;
347 $result->{LDDLFLAGS} = $Config{lddlflags} . " " .
348 join " ", map "$prefix$_", split $Config{path_sep}, $ld_run_path;
349 }
1d7e3124
TC
350 }
351 my $good =
352 Devel::CheckLib::check_lib
353 (
354 debug => $req->{verbose},
177f9b37 355 LIBS => [ $result->{LIBS} ],
1d7e3124
TC
356 INC => $result->{INC},
357 header => $req->{testcodeheaders},
358 function => $req->{testcode},
b73378f5 359 prologue => $req->{testcodeprologue},
1d7e3124
TC
360 );
361 unless ($good) {
5fbba567 362 print "$req->{name}: Test code failed: $@";
1d7e3124
TC
363 return;
364 }
365
366 print "$req->{name}: Passed code check\n";
367 return $result;
368}
369
535921f9
TC
370sub _resolve_libs {
371 my ($req, $lflags) = @_;
372
373 my @libs = grep /^-l/, split ' ', $lflags;
374 my %paths;
375 my @paths = _lib_paths($req);
376 my $so = $Config{so};
377 my $libext = $Config{_a};
378 for my $lib (@libs) {
379 $lib =~ s/^-l/lib/;
380
381 for my $path (@paths) {
382 if (-e "$path/$lib.$so" || -e "$path/$lib$libext") {
383 $paths{$path} = 1;
384 }
385 }
386 }
387
388 return join(" ", ( map "-L$_", keys %paths ), $lflags );
389}
390
1d7e3124
TC
391sub _lib_paths {
392 my ($req) = @_;
393
7e72e6a4
TC
394 print "$req->{name} IM_LIBPATH: $ENV{IM_LIBPATH}\n"
395 if $req->{verbose} && defined $ENV{IM_LIBPATH};
396 print "$req->{name} LIB: $ENV{IM_LIBPATH}\n"
397 if $req->{verbose} && defined $ENV{LIB} && $^O eq "MSWin32";
398 my $lp = $req->{libpath};
399 print "$req->{name} libpath: ", ref $lp ? join($Config{path_sep}, @$lp) : $lp, "\n"
400 if $req->{verbose} && defined $lp;
401
1d7e3124
TC
402 return _paths
403 (
404 $ENV{IM_LIBPATH},
405 $req->{libpath},
406 (
407 map { split ' ' }
408 grep $_,
6725cca4 409 @Config{qw/loclibpth libpth libspath/}
1d7e3124
TC
410 ),
411 $^O eq "MSWin32" ? $ENV{LIB} : "",
412 $^O eq "cygwin" ? "/usr/lib/w32api" : "",
6725cca4
TC
413 "/usr/lib",
414 "/usr/local/lib",
d2f87b00 415 _gcc_lib_paths(),
306618c3 416 _dyn_lib_paths(),
1d7e3124
TC
417 );
418}
419
d2f87b00
TC
420sub _gcc_lib_paths {
421 $Config{gccversion}
422 or return;
423
424 my ($base_version) = $Config{gccversion} =~ /^([0-9]+)/
425 or return;
426
427 $base_version >= 4
428 or return;
429
48a9761f
TC
430 local $ENV{LANG} = "C";
431 local $ENV{LC_ALL} = "C";
d2f87b00
TC
432 my ($lib_line) = grep /^libraries:/, `$Config{cc} -print-search-dirs`
433 or return;
434 $lib_line =~ s/^libraries: =//;
435 chomp $lib_line;
436
437 return grep !/gcc/ && -d, split /:/, $lib_line;
438}
439
306618c3
TC
440sub _dyn_lib_paths {
441 return map { defined() ? split /\Q$Config{path_sep}/ : () }
442 map $ENV{$_},
443 qw(LD_RUN_PATH LD_LIBRARY_PATH DYLD_LIBRARY_PATH LIBRARY_PATH);
444}
445
1d7e3124
TC
446sub _inc_paths {
447 my ($req) = @_;
448
7e72e6a4
TC
449 print "$req->{name} IM_INCPATH: $ENV{IM_INCPATH}\n"
450 if $req->{verbose} && defined $ENV{IM_INCPATH};
451 print "$req->{name} INCLUDE: $ENV{INCLUDE}\n"
452 if $req->{verbose} && defined $ENV{INCLUDE} && $^O eq "MSWin32";
453 my $ip = $req->{incpath};
454 print "$req->{name} incpath: ", ref $ip ? join($Config{path_sep}, @$ip) : $ip, "\n"
455 if $req->{verbose} && defined $req->{incpath};
456
cac1147d 457 my @paths = _paths
1d7e3124
TC
458 (
459 $ENV{IM_INCPATH},
460 $req->{incpath},
461 $^O eq "MSWin32" ? $ENV{INCLUDE} : "",
462 $^O eq "cygwin" ? "/usr/include/w32api" : "",
463 (
464 map { split ' ' }
465 grep $_,
6725cca4 466 @Config{qw/locincpth incpath/}
1d7e3124
TC
467 ),
468 "/usr/include",
469 "/usr/local/include",
0a095db9 470 _gcc_inc_paths(),
306618c3 471 _dyn_inc_paths(),
1d7e3124 472 );
cac1147d
TC
473
474 if ($req->{incsuffix}) {
475 @paths = map File::Spec->catdir($_, $req->{incsuffix}), @paths;
476 }
477
478 return @paths;
1d7e3124
TC
479}
480
0a095db9
TC
481sub _gcc_inc_paths {
482 $Config{gccversion}
483 or return;
484
485 my ($base_version) = $Config{gccversion} =~ /^([0-9]+)/
486 or return;
487
488 $base_version >= 4
489 or return;
490
491 local $ENV{LANG} = "C";
492 local $ENV{LC_ALL} = "C";
493 my $devnull = File::Spec->devnull;
494 my @spam = `$Config{cc} -E -v - <$devnull 2>&1`;
495 # output includes lines like:
496 # ...
497 # ignoring nonexistent directory "/usr/lib/gcc/x86_64-linux-gnu/4.9/../../../../x86_64-linux-gnu/include"
498 # #include "..." search starts here:
499 # #include <...> search starts here:
500 # /usr/lib/gcc/x86_64-linux-gnu/4.9/include
501 # /usr/local/include
502 # /usr/lib/gcc/x86_64-linux-gnu/4.9/include-fixed
503 # /usr/include/x86_64-linux-gnu
504 # /usr/include
505 # End of search list.
506 # # 1 "<stdin>"
507 # # 1 "<built-in>"
508 # ...
509
510 while (@spam && $spam[0] !~ /^#include /) {
511 shift @spam;
512 }
513 my @inc;
514 while (@spam && $spam[0] !~ /^End of search/) {
515 my $line = shift @spam;
516 chomp $line;
517 next if $line =~ /^#include /;
518 next unless $line =~ s/^\s+//;
519 push @inc, $line;
520 }
521 return @inc;
522}
523
306618c3
TC
524sub _dyn_inc_paths {
525 return map {
526 my $tmp = $_;
527 $tmp =~ s/\blib$/include/ ? $tmp : ()
528 } _dyn_lib_paths();
529}
530
1d7e3124
TC
531sub _paths {
532 my (@in) = @_;
533
534 my @out;
535
0c3c1180
TC
536 # expand any array refs
537 @in = map { ref() ? @$_ : $_ } @in;
538
1d7e3124
TC
539 for my $path (@in) {
540 $path or next;
541 $path = _tilde_expand($path);
542
543 push @out, grep -d $_, split /\Q$Config{path_sep}/, $path;
544 }
545
d2f87b00
TC
546 @out = map Cwd::realpath($_), @out;
547
548 my %seen;
549 @out = grep !$seen{$_}++, @out;
550
1d7e3124
TC
551 return @out;
552}
553
554my $home;
555sub _tilde_expand {
556 my ($path) = @_;
557
558 if ($path =~ m!^~[/\\]!) {
559 defined $home or $home = $ENV{HOME};
560 if (!defined $home && $^O eq 'MSWin32'
561 && defined $ENV{HOMEDRIVE} && defined $ENV{HOMEPATH}) {
562 $home = $ENV{HOMEDRIVE} . $ENV{HOMEPATH};
563 }
564 unless (defined $home) {
565 $home = eval { (getpwuid($<))[7] };
566 }
567 defined $home or die "You supplied $path, but I can't find your home directory\n";
568 $path =~ s/^~//;
569 $path = File::Spec->catdir($home, $path);
570 }
571
572 return $path;
573}
574
5751;
576
577__END__
578
579=head1 NAME
580
581Imager::Probe - hot needle of inquiry for libraries
582
583=head1 SYNOPSIS
584
585 require Imager::Probe;
586
587 my %probe =
588 (
589 # short name of what we're looking for (displayed to user)
590 name => "FOO",
591 # pkg-config lookup
592 pkg => [ qw/name1 name2 name3/ ],
593 # perl subs that probe for the library
594 code => [ \&foo_probe1, \&foo_probe2 ],
595 # or just: code => \&foo_probe,
596 inccheck => sub { ... },
597 libcheck => sub { ... },
598 # search for this library if libcheck not supplied
599 libbase => "foo",
600 # library link time options, uses libbase to build options otherwise
601 libopts => "-lfoo",
602 # C code to check the library is sane
603 testcode => "...",
604 # header files needed
605 testcodeheaders => [ "stdio.h", "foo.h" ],
606 );
607 my $result = Imager::Probe->probe(\%probe)
608 or print "Foo library not found: ",Imager::Probe->error;
609
610=head1 DESCRIPTION
611
612Does the probes that were hidden in Imager's F<Makefile.PL>, pulled
613out so the file format libraries can be externalized.
614
615The return value is either nothing if the probe fails, or a hash
616containing:
617
618=over
619
620=item *
621
622C<INC> - C<-I> and other C options
623
624=item *
625
626C<LIBS> - C<-L>, C<-l> and other link-time options
627
5dc99e19
TC
628=item *
629
630C<DEFINE> - C<-D> options, if any.
631
1d7e3124
TC
632=back
633
634The possible values for the hash supplied to the probe() method are:
635
636=over
637
638=item *
639
640C<pkg> - an array of F<pkg-config> names to probe for. If the
641F<pkg-config> checks pass, C<inccheck> and C<libcheck> aren't used.
642
643=item *
644
645C<inccheck> - a code reference that checks if the supplied include
646directory contains the required header files.
647
648=item *
649
650C<libcheck> - a code reference that checks if the supplied library
651directory contains the required library files. Note: the
652F<Makefile.PL> version of this was supplied all of the library file
de50f459
TC
653names instead. C<libcheck> can also be an arrayref of library check
654code references, all of which must find a match for the library to be
655considered "found".
1d7e3124
TC
656
657=item *
658
659C<libbase> - if C<inccheck> is supplied, but C<libcheck> isn't, then a
660C<libcheck> that checks for C<lib>I<libbase>I<$Config{_a}> and
661C<lib>I<libbase>.I<$Config{so}> is created. If C<libopts> isn't
de50f459
TC
662supplied then that can be synthesized as C<< -lI<libbase>
663>>. C<libbase> can also be an arrayref of library base names to search
664for, in which case all of the libraries mentioned must be found for
665the probe to succeed.
1d7e3124
TC
666
667=item *
668
669C<libopts> - if the libraries are found via C<inccheck>/C<libcheck>,
670these are the C<-l> options to supply during the link phase.
671
672=item *
673
674C<code> - a code reference to perform custom checks. Returns the
675probe result directly. Can also be an array ref of functions to call.
676
677=item *
678
679C<testcode> - test C code that is run with Devel::CheckLib. You also
680need to set C<testcodeheaders>.
681
682=item *
683
b73378f5
TC
684C<testcodeprologue> - C code to insert between the headers and the
685main function.
686
687=item *
688
1d7e3124 689C<incpath> - C<$Config{path_sep}> separated list of header file
0c3c1180 690directories to check, or a reference to an array of such.
1d7e3124
TC
691
692=item *
693
694C<libpath> - C<$Config{path_sep}> separated list of library file
0c3c1180 695directories to check, or a reference to an array of such.
1d7e3124 696
de50f459
TC
697=item *
698
699C<alternatives> - an optional array reference of alternate
c2545c80 700configurations (as hash references) to test if the primary
de50f459
TC
701configuration isn't successful. Each alternative should include an
702C<altname> key describing the alternative. Any key not mentioned in
703an alternative defaults to the value from the main configuration.
704
1d7e3124
TC
705=back
706
8ba1b8a6
TC
707=head1 AUTHOR
708
709Tony Cook <tonyc@cpan.org>, Arnar M. Hrafnkelsson
710
1d7e3124 711=cut