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