Changes updates
[imager.git] / lib / Imager / Probe.pm
CommitLineData
1d7e3124
TC
1package Imager::Probe;
2use strict;
3use File::Spec;
4use Config;
d2f87b00 5use Cwd ();
1d7e3124 6
306618c3 7our $VERSION = "1.003";
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(),
306618c3 402 _dyn_lib_paths(),
1d7e3124
TC
403 );
404}
405
d2f87b00
TC
406sub _gcc_lib_paths {
407 $Config{gccversion}
408 or return;
409
410 my ($base_version) = $Config{gccversion} =~ /^([0-9]+)/
411 or return;
412
413 $base_version >= 4
414 or return;
415
48a9761f
TC
416 local $ENV{LANG} = "C";
417 local $ENV{LC_ALL} = "C";
d2f87b00
TC
418 my ($lib_line) = grep /^libraries:/, `$Config{cc} -print-search-dirs`
419 or return;
420 $lib_line =~ s/^libraries: =//;
421 chomp $lib_line;
422
423 return grep !/gcc/ && -d, split /:/, $lib_line;
424}
425
306618c3
TC
426sub _dyn_lib_paths {
427 return map { defined() ? split /\Q$Config{path_sep}/ : () }
428 map $ENV{$_},
429 qw(LD_RUN_PATH LD_LIBRARY_PATH DYLD_LIBRARY_PATH LIBRARY_PATH);
430}
431
1d7e3124
TC
432sub _inc_paths {
433 my ($req) = @_;
434
cac1147d 435 my @paths = _paths
1d7e3124
TC
436 (
437 $ENV{IM_INCPATH},
438 $req->{incpath},
439 $^O eq "MSWin32" ? $ENV{INCLUDE} : "",
440 $^O eq "cygwin" ? "/usr/include/w32api" : "",
441 (
442 map { split ' ' }
443 grep $_,
6725cca4 444 @Config{qw/locincpth incpath/}
1d7e3124
TC
445 ),
446 "/usr/include",
447 "/usr/local/include",
306618c3 448 _dyn_inc_paths(),
1d7e3124 449 );
cac1147d
TC
450
451 if ($req->{incsuffix}) {
452 @paths = map File::Spec->catdir($_, $req->{incsuffix}), @paths;
453 }
454
455 return @paths;
1d7e3124
TC
456}
457
306618c3
TC
458sub _dyn_inc_paths {
459 return map {
460 my $tmp = $_;
461 $tmp =~ s/\blib$/include/ ? $tmp : ()
462 } _dyn_lib_paths();
463}
464
1d7e3124
TC
465sub _paths {
466 my (@in) = @_;
467
468 my @out;
469
0c3c1180
TC
470 # expand any array refs
471 @in = map { ref() ? @$_ : $_ } @in;
472
1d7e3124
TC
473 for my $path (@in) {
474 $path or next;
475 $path = _tilde_expand($path);
476
477 push @out, grep -d $_, split /\Q$Config{path_sep}/, $path;
478 }
479
d2f87b00
TC
480 @out = map Cwd::realpath($_), @out;
481
482 my %seen;
483 @out = grep !$seen{$_}++, @out;
484
1d7e3124
TC
485 return @out;
486}
487
488my $home;
489sub _tilde_expand {
490 my ($path) = @_;
491
492 if ($path =~ m!^~[/\\]!) {
493 defined $home or $home = $ENV{HOME};
494 if (!defined $home && $^O eq 'MSWin32'
495 && defined $ENV{HOMEDRIVE} && defined $ENV{HOMEPATH}) {
496 $home = $ENV{HOMEDRIVE} . $ENV{HOMEPATH};
497 }
498 unless (defined $home) {
499 $home = eval { (getpwuid($<))[7] };
500 }
501 defined $home or die "You supplied $path, but I can't find your home directory\n";
502 $path =~ s/^~//;
503 $path = File::Spec->catdir($home, $path);
504 }
505
506 return $path;
507}
508
5091;
510
511__END__
512
513=head1 NAME
514
515Imager::Probe - hot needle of inquiry for libraries
516
517=head1 SYNOPSIS
518
519 require Imager::Probe;
520
521 my %probe =
522 (
523 # short name of what we're looking for (displayed to user)
524 name => "FOO",
525 # pkg-config lookup
526 pkg => [ qw/name1 name2 name3/ ],
527 # perl subs that probe for the library
528 code => [ \&foo_probe1, \&foo_probe2 ],
529 # or just: code => \&foo_probe,
530 inccheck => sub { ... },
531 libcheck => sub { ... },
532 # search for this library if libcheck not supplied
533 libbase => "foo",
534 # library link time options, uses libbase to build options otherwise
535 libopts => "-lfoo",
536 # C code to check the library is sane
537 testcode => "...",
538 # header files needed
539 testcodeheaders => [ "stdio.h", "foo.h" ],
540 );
541 my $result = Imager::Probe->probe(\%probe)
542 or print "Foo library not found: ",Imager::Probe->error;
543
544=head1 DESCRIPTION
545
546Does the probes that were hidden in Imager's F<Makefile.PL>, pulled
547out so the file format libraries can be externalized.
548
549The return value is either nothing if the probe fails, or a hash
550containing:
551
552=over
553
554=item *
555
556C<INC> - C<-I> and other C options
557
558=item *
559
560C<LIBS> - C<-L>, C<-l> and other link-time options
561
5dc99e19
TC
562=item *
563
564C<DEFINE> - C<-D> options, if any.
565
1d7e3124
TC
566=back
567
568The possible values for the hash supplied to the probe() method are:
569
570=over
571
572=item *
573
574C<pkg> - an array of F<pkg-config> names to probe for. If the
575F<pkg-config> checks pass, C<inccheck> and C<libcheck> aren't used.
576
577=item *
578
579C<inccheck> - a code reference that checks if the supplied include
580directory contains the required header files.
581
582=item *
583
584C<libcheck> - a code reference that checks if the supplied library
585directory contains the required library files. Note: the
586F<Makefile.PL> version of this was supplied all of the library file
de50f459
TC
587names instead. C<libcheck> can also be an arrayref of library check
588code references, all of which must find a match for the library to be
589considered "found".
1d7e3124
TC
590
591=item *
592
593C<libbase> - if C<inccheck> is supplied, but C<libcheck> isn't, then a
594C<libcheck> that checks for C<lib>I<libbase>I<$Config{_a}> and
595C<lib>I<libbase>.I<$Config{so}> is created. If C<libopts> isn't
de50f459
TC
596supplied then that can be synthesized as C<< -lI<libbase>
597>>. C<libbase> can also be an arrayref of library base names to search
598for, in which case all of the libraries mentioned must be found for
599the probe to succeed.
1d7e3124
TC
600
601=item *
602
603C<libopts> - if the libraries are found via C<inccheck>/C<libcheck>,
604these are the C<-l> options to supply during the link phase.
605
606=item *
607
608C<code> - a code reference to perform custom checks. Returns the
609probe result directly. Can also be an array ref of functions to call.
610
611=item *
612
613C<testcode> - test C code that is run with Devel::CheckLib. You also
614need to set C<testcodeheaders>.
615
616=item *
617
b73378f5
TC
618C<testcodeprologue> - C code to insert between the headers and the
619main function.
620
621=item *
622
1d7e3124 623C<incpath> - C<$Config{path_sep}> separated list of header file
0c3c1180 624directories to check, or a reference to an array of such.
1d7e3124
TC
625
626=item *
627
628C<libpath> - C<$Config{path_sep}> separated list of library file
0c3c1180 629directories to check, or a reference to an array of such.
1d7e3124 630
de50f459
TC
631=item *
632
633C<alternatives> - an optional array reference of alternate
c2545c80 634configurations (as hash references) to test if the primary
de50f459
TC
635configuration isn't successful. Each alternative should include an
636C<altname> key describing the alternative. Any key not mentioned in
637an alternative defaults to the value from the main configuration.
638
1d7e3124
TC
639=back
640
8ba1b8a6
TC
641=head1 AUTHOR
642
643Tony Cook <tonyc@cpan.org>, Arnar M. Hrafnkelsson
644
1d7e3124 645=cut