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