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