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