ac6d49bee37f5df53690539474071a728afdef0a
[imager.git] / lib / Imager / Probe.pm
1 package Imager::Probe;
2 use strict;
3 use File::Spec;
4 use Config;
5 use Cwd ();
6
7 our $VERSION = "1.006";
8
9 my @alt_transfer = qw/altname incsuffix libbase/;
10
11 sub 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})) {
25     $req->{altname} ||= "main";
26     $result = _probe_check($req);
27   }
28
29   if ($result && $req->{testcode}) {
30     $result = _probe_test($req, $result);
31   }
32
33   if (!$result && $req->{alternatives}) {
34   ALTCHECK:
35     my $index = 1;
36     for my $alt (@{$req->{alternatives}}) {
37       $req->{altname} = $alt->{altname} || "alt $index";
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       }
44       $result = _probe_check(\%work);
45
46       if ($result && $req->{testcode}) {
47         $result = _probe_test(\%work, $result);
48       }
49
50       $result
51         and last;
52
53       ++$index;
54     }
55   }
56
57   if (!$result && $req->{testcode}) {
58     $result = _probe_fake($req);
59
60     $result or return;
61
62     $result = _probe_test($req, $result);
63   }
64
65   $result or return;
66
67   return $result;
68 }
69
70 sub _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
85 sub 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
103 sub _probe_pkg {
104   my ($req) = @_;
105
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
111   local $ENV{ 'PKG_CONFIG_PATH' } = join $Config{path_sep}, @pkgcfg_paths;
112
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
127       my $defines = '';
128       $cflags =~ s/(-D\S+)/$defines .= " $1"; ''/ge;
129
130       chomp $cflags;
131       chomp $lflags;
132       print "$req->{name}: Found via pkg-config $pkg\n";
133       print <<EOS if $req->{verbose};
134   cflags: $cflags
135   defines: $defines
136   lflags: $lflags
137 EOS
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
153       return
154         {
155          INC => $cflags,
156          LIBS => $lflags,
157          DEFINE => $defines,
158         };
159     }
160   }
161
162   print "$req->{name}: Not found via pkg-config\n";
163
164   return;
165 }
166
167 sub _is_msvc {
168   return $Config{cc} eq "cl";
169 }
170
171 sub _lib_basename {
172   my ($base) = @_;
173
174   if (_is_msvc()) {
175     return $base;
176   }
177   else {
178     return "lib$base";
179   }
180 }
181
182 sub _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
193 sub _quotearg {
194   my ($opt) = @_;
195
196   return $opt =~ /\s/ ? qq("$opt") : $opt;
197 }
198
199 sub _probe_check {
200   my ($req) = @_;
201
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
215     my $lext=$Config{'so'};   # Get extensions of libraries
216     my $aext=$Config{'_a'};
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;
230   }
231
232   my @found_libpath;
233   my @lib_search = _lib_paths($req);
234   print "$req->{name}: Searching directories for libraries:\n"
235     if $req->{verbose};
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       }
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
261   my $alt = "";
262   if ($req->{altname}) {
263     $alt = " $req->{altname}:";
264   }
265   print "$req->{name}:$alt includes ", $found_incpath ? "" : "not ",
266     "found - libraries ", @found_libpath == @libcheck ? "" : "not ", "found\n";
267
268   @found_libpath == @libcheck && $found_incpath
269     or return;
270
271   my @libs = map "-L$_", @found_libpath;
272   if ($req->{libopts}) {
273     push @libs, $req->{libopts};
274   }
275   elsif (@libbase) {
276     push @libs, map _lib_option($_), @libbase;
277   }
278   else {
279     die "$req->{altname}: inccheck but no libbase or libopts";
280   }
281
282   return
283     {
284      INC => _quotearg("-I$found_incpath"),
285      LIBS => join(" ", map _quotearg($_), @libs),
286      DEFINE => "",
287     };
288 }
289
290 sub _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     my @libs = $req->{libbase}
304       ? ( ref $req->{libbase} ? @{$req->{libbase}} : $req->{libbase} )
305       : ();
306     $lopts = join " ", map _lib_option($_), @libs;
307   }
308   if (defined $lopts) {
309     print "$req->{name}: Checking if the compiler can find them on its own\n";
310     return
311       {
312        INC => "",
313        LIBS => $lopts,
314        DEFINE => "",
315       };
316   }
317   else {
318     print "$req->{name}: Can't fake it - no libbase or libopts\n"
319       if $req->{verbose};
320     return;
321   }
322 }
323
324 sub _probe_test {
325   my ($req, $result) = @_;
326
327   require Devel::CheckLib;
328   # setup LD_RUN_PATH to match link time
329   print "Asking liblist for LD_RUN_PATH:\n" if $req->{verbose};
330   my ($extra, $bs_load, $ld_load, $ld_run_path) =
331     ExtUtils::Liblist->ext($result->{LIBS}, $req->{verbose});
332   local $ENV{LD_RUN_PATH};
333
334   if ($ld_run_path) {
335     print "Setting LD_RUN_PATH=$ld_run_path for $req->{name} probe\n"
336       if $req->{verbose};
337     $ENV{LD_RUN_PATH} = $ld_run_path;
338     if ($Config{lddlflags} =~ /([^ ]*-(?:rpath|R)[,=]?)([^ ]+)/
339         && -d $2) {
340       # hackety, hackety
341       # LD_RUN_PATH is ignored when there's already an -rpath option
342       # so provide one
343       my $prefix = $1;
344       $result->{LDDLFLAGS} = $Config{lddlflags} . " " .
345         join " ", map "$prefix$_", split $Config{path_sep}, $ld_run_path;
346     }
347   }
348   my $good =
349     Devel::CheckLib::check_lib
350         (
351          debug => $req->{verbose},
352          LIBS => [ $result->{LIBS} ],
353          INC => $result->{INC},
354          header => $req->{testcodeheaders},
355          function => $req->{testcode},
356          prologue => $req->{testcodeprologue},
357         );
358   unless ($good) {
359     print "$req->{name}: Test code failed: $@";
360     return;
361   }
362
363   print "$req->{name}: Passed code check\n";
364   return $result;
365 }
366
367 sub _resolve_libs {
368   my ($req, $lflags) = @_;
369
370   my @libs = grep /^-l/, split ' ', $lflags;
371   my %paths;
372   my @paths = _lib_paths($req);
373   my $so = $Config{so};
374   my $libext = $Config{_a};
375   for my $lib (@libs) {
376     $lib =~ s/^-l/lib/;
377
378     for my $path (@paths) {
379       if (-e "$path/$lib.$so" || -e "$path/$lib$libext") {
380         $paths{$path} = 1;
381       }
382     }
383   }
384
385   return join(" ", ( map "-L$_", keys %paths ), $lflags );
386 }
387
388 sub _lib_paths {
389   my ($req) = @_;
390
391   print "$req->{name} IM_LIBPATH: $ENV{IM_LIBPATH}\n"
392     if $req->{verbose} && defined $ENV{IM_LIBPATH};
393   print "$req->{name} LIB: $ENV{IM_LIBPATH}\n"
394     if $req->{verbose} && defined $ENV{LIB} && $^O eq "MSWin32";
395   my $lp = $req->{libpath};
396   print "$req->{name} libpath: ", ref $lp ? join($Config{path_sep}, @$lp) : $lp, "\n"
397     if $req->{verbose} && defined $lp;
398
399   return _paths
400     (
401      $ENV{IM_LIBPATH},
402      $req->{libpath},
403      (
404       map { split ' ' }
405       grep $_,
406       @Config{qw/loclibpth libpth libspath/}
407      ),
408      $^O eq "MSWin32" ? $ENV{LIB} : "",
409      $^O eq "cygwin" ? "/usr/lib/w32api" : "",
410      "/usr/lib",
411      "/usr/local/lib",
412      _gcc_lib_paths(),
413      _dyn_lib_paths(),
414     );
415 }
416
417 sub _gcc_lib_paths {
418   $Config{gccversion}
419     or return;
420
421   my ($base_version) = $Config{gccversion} =~ /^([0-9]+)/
422     or return;
423
424   $base_version >= 4
425     or return;
426
427   local $ENV{LANG} = "C";
428   local $ENV{LC_ALL} = "C";
429   my ($lib_line) = grep /^libraries:/, `$Config{cc} -print-search-dirs`
430     or return;
431   $lib_line =~ s/^libraries: =//;
432   chomp $lib_line;
433
434   return grep !/gcc/ && -d, split /:/, $lib_line;
435 }
436
437 sub _dyn_lib_paths {
438   return map { defined() ? split /\Q$Config{path_sep}/ : () }
439     map $ENV{$_},
440       qw(LD_RUN_PATH LD_LIBRARY_PATH DYLD_LIBRARY_PATH LIBRARY_PATH);
441 }
442
443 sub _inc_paths {
444   my ($req) = @_;
445
446   print "$req->{name} IM_INCPATH: $ENV{IM_INCPATH}\n"
447     if $req->{verbose} && defined $ENV{IM_INCPATH};
448   print "$req->{name} INCLUDE: $ENV{INCLUDE}\n"
449     if $req->{verbose} && defined $ENV{INCLUDE} && $^O eq "MSWin32";
450   my $ip = $req->{incpath};
451   print "$req->{name} incpath: ", ref $ip ? join($Config{path_sep}, @$ip) : $ip, "\n"
452     if $req->{verbose} && defined $req->{incpath};
453
454   my @paths = _paths
455     (
456      $ENV{IM_INCPATH},
457      $req->{incpath},
458      $^O eq "MSWin32" ? $ENV{INCLUDE} : "",
459      $^O eq "cygwin" ? "/usr/include/w32api" : "",
460      (
461       map { split ' ' }
462       grep $_,
463       @Config{qw/locincpth incpath/}
464      ),
465      "/usr/include",
466      "/usr/local/include",
467      _gcc_inc_paths(),
468      _dyn_inc_paths(),
469     );
470
471   if ($req->{incsuffix}) {
472     @paths = map File::Spec->catdir($_, $req->{incsuffix}), @paths;
473   }
474
475   return @paths;
476 }
477
478 sub _gcc_inc_paths {
479   $Config{gccversion}
480     or return;
481
482   my ($base_version) = $Config{gccversion} =~ /^([0-9]+)/
483     or return;
484
485   $base_version >= 4
486     or return;
487
488   local $ENV{LANG} = "C";
489   local $ENV{LC_ALL} = "C";
490   my $devnull = File::Spec->devnull;
491   my @spam = `$Config{cc} -E -v - <$devnull 2>&1`;
492   # output includes lines like:
493   # ...
494   # ignoring nonexistent directory "/usr/lib/gcc/x86_64-linux-gnu/4.9/../../../../x86_64-linux-gnu/include"
495   # #include "..." search starts here:
496   # #include <...> search starts here:
497   #  /usr/lib/gcc/x86_64-linux-gnu/4.9/include
498   #  /usr/local/include
499   #  /usr/lib/gcc/x86_64-linux-gnu/4.9/include-fixed
500   #  /usr/include/x86_64-linux-gnu
501   #  /usr/include
502   # End of search list.
503   # # 1 "<stdin>"
504   # # 1 "<built-in>"
505   # ...
506
507   while (@spam && $spam[0] !~ /^#include /) {
508     shift @spam;
509   }
510   my @inc;
511   while (@spam && $spam[0] !~ /^End of search/) {
512     my $line = shift @spam;
513     chomp $line;
514     next if $line =~ /^#include /;
515     next unless $line =~ s/^\s+//;
516     push @inc, $line;
517   }
518   return @inc;
519 }
520
521 sub _dyn_inc_paths {
522   return map {
523     my $tmp = $_;
524     $tmp =~ s/\blib$/include/ ? $tmp : ()
525   } _dyn_lib_paths();
526 }
527
528 sub _paths {
529   my (@in) = @_;
530
531   my @out;
532
533   # expand any array refs
534   @in = map { ref() ? @$_ : $_ } @in;
535
536   for my $path (@in) {
537     $path or next;
538     $path = _tilde_expand($path);
539
540     push @out, grep -d $_, split /\Q$Config{path_sep}/, $path;
541   }
542
543   @out = map Cwd::realpath($_), @out;
544
545   my %seen;
546   @out = grep !$seen{$_}++, @out;
547
548   return @out;
549 }
550
551 my $home;
552 sub _tilde_expand {
553   my ($path) = @_;
554
555   if ($path =~ m!^~[/\\]!) {
556     defined $home or $home = $ENV{HOME};
557     if (!defined $home && $^O eq 'MSWin32'
558        && defined $ENV{HOMEDRIVE} && defined $ENV{HOMEPATH}) {
559       $home = $ENV{HOMEDRIVE} . $ENV{HOMEPATH};
560     }
561     unless (defined $home) {
562       $home = eval { (getpwuid($<))[7] };
563     }
564     defined $home or die "You supplied $path, but I can't find your home directory\n";
565     $path =~ s/^~//;
566     $path = File::Spec->catdir($home, $path);
567   }
568
569   return $path;
570 }
571
572 1;
573
574 __END__
575
576 =head1 NAME
577
578 Imager::Probe - hot needle of inquiry for libraries
579
580 =head1 SYNOPSIS
581
582   require Imager::Probe;
583
584   my %probe = 
585     (
586      # short name of what we're looking for (displayed to user)
587      name => "FOO",
588      # pkg-config lookup
589      pkg => [ qw/name1 name2 name3/ ],
590      # perl subs that probe for the library
591      code => [ \&foo_probe1, \&foo_probe2 ],
592      # or just: code => \&foo_probe,
593      inccheck => sub { ... },
594      libcheck => sub { ... },
595      # search for this library if libcheck not supplied
596      libbase => "foo",
597      # library link time options, uses libbase to build options otherwise
598      libopts => "-lfoo",
599      # C code to check the library is sane
600      testcode => "...",
601      # header files needed
602      testcodeheaders => [ "stdio.h", "foo.h" ],
603     );
604   my $result = Imager::Probe->probe(\%probe)
605     or print "Foo library not found: ",Imager::Probe->error;
606
607 =head1 DESCRIPTION
608
609 Does the probes that were hidden in Imager's F<Makefile.PL>, pulled
610 out so the file format libraries can be externalized.
611
612 The return value is either nothing if the probe fails, or a hash
613 containing:
614
615 =over
616
617 =item *
618
619 C<INC> - C<-I> and other C options
620
621 =item *
622
623 C<LIBS> - C<-L>, C<-l> and other link-time options
624
625 =item *
626
627 C<DEFINE> - C<-D> options, if any.
628
629 =back
630
631 The possible values for the hash supplied to the probe() method are:
632
633 =over
634
635 =item *
636
637 C<pkg> - an array of F<pkg-config> names to probe for.  If the
638 F<pkg-config> checks pass, C<inccheck> and C<libcheck> aren't used.
639
640 =item *
641
642 C<inccheck> - a code reference that checks if the supplied include
643 directory contains the required header files.
644
645 =item *
646
647 C<libcheck> - a code reference that checks if the supplied library
648 directory contains the required library files.  Note: the
649 F<Makefile.PL> version of this was supplied all of the library file
650 names instead.  C<libcheck> can also be an arrayref of library check
651 code references, all of which must find a match for the library to be
652 considered "found".
653
654 =item *
655
656 C<libbase> - if C<inccheck> is supplied, but C<libcheck> isn't, then a
657 C<libcheck> that checks for C<lib>I<libbase>I<$Config{_a}> and
658 C<lib>I<libbase>.I<$Config{so}> is created.  If C<libopts> isn't
659 supplied then that can be synthesized as C<< -lI<libbase>
660 >>. C<libbase> can also be an arrayref of library base names to search
661 for, in which case all of the libraries mentioned must be found for
662 the probe to succeed.
663
664 =item *
665
666 C<libopts> - if the libraries are found via C<inccheck>/C<libcheck>,
667 these are the C<-l> options to supply during the link phase.
668
669 =item *
670
671 C<code> - a code reference to perform custom checks.  Returns the
672 probe result directly.  Can also be an array ref of functions to call.
673
674 =item *
675
676 C<testcode> - test C code that is run with Devel::CheckLib.  You also
677 need to set C<testcodeheaders>.
678
679 =item *
680
681 C<testcodeprologue> - C code to insert between the headers and the
682 main function.
683
684 =item *
685
686 C<incpath> - C<$Config{path_sep}> separated list of header file
687 directories to check, or a reference to an array of such.
688
689 =item *
690
691 C<libpath> - C<$Config{path_sep}> separated list of library file
692 directories to check, or a reference to an array of such.
693
694 =item *
695
696 C<alternatives> - an optional array reference of alternate
697 configurations (as hash references) to test if the primary
698 configuration isn't successful.  Each alternative should include an
699 C<altname> key describing the alternative.  Any key not mentioned in
700 an alternative defaults to the value from the main configuration.
701
702 =back
703
704 =head1 AUTHOR
705
706 Tony Cook <tonyc@cpan.org>, Arnar M. Hrafnkelsson
707
708 =cut