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