eliminate use vars
[imager.git] / lib / Imager / Probe.pm
1 package Imager::Probe;
2 use 5.006;
3 use strict;
4 use File::Spec;
5 use Config;
6 use Cwd ();
7
8 our $VERSION = "1.007";
9
10 my @alt_transfer = qw/altname incsuffix libbase/;
11
12 sub 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})) {
26     $req->{altname} ||= "main";
27     $result = _probe_check($req);
28   }
29
30   if ($result && $req->{testcode}) {
31     $result = _probe_test($req, $result);
32   }
33
34   if (!$result && $req->{alternatives}) {
35   ALTCHECK:
36     my $index = 1;
37     for my $alt (@{$req->{alternatives}}) {
38       $req->{altname} = $alt->{altname} || "alt $index";
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       }
45       $result = _probe_check(\%work);
46
47       if ($result && $req->{testcode}) {
48         $result = _probe_test(\%work, $result);
49       }
50
51       $result
52         and last;
53
54       ++$index;
55     }
56   }
57
58   if (!$result && $req->{testcode}) {
59     $result = _probe_fake($req);
60
61     $result or return;
62
63     $result = _probe_test($req, $result);
64   }
65
66   $result or return;
67
68   return $result;
69 }
70
71 sub _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
86 sub 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   }
93   elsif ($^O eq 'cygwin') {
94     push @exe_suffix, "";
95   }
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
107 sub _probe_pkg {
108   my ($req) = @_;
109
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
115   local $ENV{ 'PKG_CONFIG_PATH' } = join $Config{path_sep}, @pkgcfg_paths;
116
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
131       my $defines = '';
132       $cflags =~ s/(-D\S+)/$defines .= " $1"; ''/ge;
133
134       chomp $cflags;
135       chomp $lflags;
136       print "$req->{name}: Found via pkg-config $pkg\n";
137       print <<EOS if $req->{verbose};
138   cflags: $cflags
139   defines: $defines
140   lflags: $lflags
141 EOS
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
157       return
158         {
159          INC => $cflags,
160          LIBS => $lflags,
161          DEFINE => $defines,
162         };
163     }
164   }
165
166   print "$req->{name}: Not found via pkg-config\n";
167
168   return;
169 }
170
171 sub _is_msvc {
172   return $Config{cc} eq "cl";
173 }
174
175 sub _lib_basename {
176   my ($base) = @_;
177
178   if (_is_msvc()) {
179     return $base;
180   }
181   else {
182     return "lib$base";
183   }
184 }
185
186 sub _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
197 sub _quotearg {
198   my ($opt) = @_;
199
200   return $opt =~ /\s/ ? qq("$opt") : $opt;
201 }
202
203 sub _probe_check {
204   my ($req) = @_;
205
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
219     my $lext=$Config{'so'};   # Get extensions of libraries
220     my $aext=$Config{'_a'};
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;
234   }
235
236   my @found_libpath;
237   my @lib_search = _lib_paths($req);
238   print "$req->{name}: Searching directories for libraries:\n"
239     if $req->{verbose};
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       }
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
265   my $alt = "";
266   if ($req->{altname}) {
267     $alt = " $req->{altname}:";
268   }
269   print "$req->{name}:$alt includes ", $found_incpath ? "" : "not ",
270     "found - libraries ", @found_libpath == @libcheck ? "" : "not ", "found\n";
271
272   @found_libpath == @libcheck && $found_incpath
273     or return;
274
275   my @libs = map "-L$_", @found_libpath;
276   if ($req->{libopts}) {
277     push @libs, $req->{libopts};
278   }
279   elsif (@libbase) {
280     push @libs, map _lib_option($_), @libbase;
281   }
282   else {
283     die "$req->{altname}: inccheck but no libbase or libopts";
284   }
285
286   return
287     {
288      INC => _quotearg("-I$found_incpath"),
289      LIBS => join(" ", map _quotearg($_), @libs),
290      DEFINE => "",
291     };
292 }
293
294 sub _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
307     my @libs = $req->{libbase}
308       ? ( ref $req->{libbase} ? @{$req->{libbase}} : $req->{libbase} )
309       : ();
310     $lopts = join " ", map _lib_option($_), @libs;
311   }
312   if (defined $lopts) {
313     print "$req->{name}: Checking if the compiler can find them on its own\n";
314     return
315       {
316        INC => "",
317        LIBS => $lopts,
318        DEFINE => "",
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
328 sub _probe_test {
329   my ($req, $result) = @_;
330
331   require Devel::CheckLib;
332   # setup LD_RUN_PATH to match link time
333   print "Asking liblist for LD_RUN_PATH:\n" if $req->{verbose};
334   my ($extra, $bs_load, $ld_load, $ld_run_path) =
335     ExtUtils::Liblist->ext($result->{LIBS}, $req->{verbose});
336   local $ENV{LD_RUN_PATH};
337
338   if ($ld_run_path) {
339     print "Setting LD_RUN_PATH=$ld_run_path for $req->{name} probe\n"
340       if $req->{verbose};
341     $ENV{LD_RUN_PATH} = $ld_run_path;
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     }
351   }
352   my $good =
353     Devel::CheckLib::check_lib
354         (
355          debug => $req->{verbose},
356          LIBS => [ $result->{LIBS} ],
357          INC => $result->{INC},
358          header => $req->{testcodeheaders},
359          function => $req->{testcode},
360          prologue => $req->{testcodeprologue},
361         );
362   unless ($good) {
363     print "$req->{name}: Test code failed: $@";
364     return;
365   }
366
367   print "$req->{name}: Passed code check\n";
368   return $result;
369 }
370
371 sub _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
392 sub _lib_paths {
393   my ($req) = @_;
394
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
403   return _paths
404     (
405      $ENV{IM_LIBPATH},
406      $req->{libpath},
407      (
408       map { split ' ' }
409       grep $_,
410       @Config{qw/loclibpth libpth libspath/}
411      ),
412      $^O eq "MSWin32" ? $ENV{LIB} : "",
413      $^O eq "cygwin" ? "/usr/lib/w32api" : "",
414      "/usr/lib",
415      "/usr/local/lib",
416      _gcc_lib_paths(),
417      _dyn_lib_paths(),
418     );
419 }
420
421 sub _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
431   local $ENV{LANG} = "C";
432   local $ENV{LC_ALL} = "C";
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
441 sub _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
447 sub _inc_paths {
448   my ($req) = @_;
449
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
458   my @paths = _paths
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 $_,
467       @Config{qw/locincpth incpath/}
468      ),
469      "/usr/include",
470      "/usr/local/include",
471      _gcc_inc_paths(),
472      _dyn_inc_paths(),
473     );
474
475   if ($req->{incsuffix}) {
476     @paths = map File::Spec->catdir($_, $req->{incsuffix}), @paths;
477   }
478
479   return @paths;
480 }
481
482 sub _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
525 sub _dyn_inc_paths {
526   return map {
527     my $tmp = $_;
528     $tmp =~ s/\blib$/include/ ? $tmp : ()
529   } _dyn_lib_paths();
530 }
531
532 sub _paths {
533   my (@in) = @_;
534
535   my @out;
536
537   # expand any array refs
538   @in = map { ref() ? @$_ : $_ } @in;
539
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
547   @out = map Cwd::realpath($_), @out;
548
549   my %seen;
550   @out = grep !$seen{$_}++, @out;
551
552   return @out;
553 }
554
555 my $home;
556 sub _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
576 1;
577
578 __END__
579
580 =head1 NAME
581
582 Imager::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
613 Does the probes that were hidden in Imager's F<Makefile.PL>, pulled
614 out so the file format libraries can be externalized.
615
616 The return value is either nothing if the probe fails, or a hash
617 containing:
618
619 =over
620
621 =item *
622
623 C<INC> - C<-I> and other C options
624
625 =item *
626
627 C<LIBS> - C<-L>, C<-l> and other link-time options
628
629 =item *
630
631 C<DEFINE> - C<-D> options, if any.
632
633 =back
634
635 The possible values for the hash supplied to the probe() method are:
636
637 =over
638
639 =item *
640
641 C<pkg> - an array of F<pkg-config> names to probe for.  If the
642 F<pkg-config> checks pass, C<inccheck> and C<libcheck> aren't used.
643
644 =item *
645
646 C<inccheck> - a code reference that checks if the supplied include
647 directory contains the required header files.
648
649 =item *
650
651 C<libcheck> - a code reference that checks if the supplied library
652 directory contains the required library files.  Note: the
653 F<Makefile.PL> version of this was supplied all of the library file
654 names instead.  C<libcheck> can also be an arrayref of library check
655 code references, all of which must find a match for the library to be
656 considered "found".
657
658 =item *
659
660 C<libbase> - if C<inccheck> is supplied, but C<libcheck> isn't, then a
661 C<libcheck> that checks for C<lib>I<libbase>I<$Config{_a}> and
662 C<lib>I<libbase>.I<$Config{so}> is created.  If C<libopts> isn't
663 supplied then that can be synthesized as C<< -lI<libbase>
664 >>. C<libbase> can also be an arrayref of library base names to search
665 for, in which case all of the libraries mentioned must be found for
666 the probe to succeed.
667
668 =item *
669
670 C<libopts> - if the libraries are found via C<inccheck>/C<libcheck>,
671 these are the C<-l> options to supply during the link phase.
672
673 =item *
674
675 C<code> - a code reference to perform custom checks.  Returns the
676 probe result directly.  Can also be an array ref of functions to call.
677
678 =item *
679
680 C<testcode> - test C code that is run with Devel::CheckLib.  You also
681 need to set C<testcodeheaders>.
682
683 =item *
684
685 C<testcodeprologue> - C code to insert between the headers and the
686 main function.
687
688 =item *
689
690 C<incpath> - C<$Config{path_sep}> separated list of header file
691 directories to check, or a reference to an array of such.
692
693 =item *
694
695 C<libpath> - C<$Config{path_sep}> separated list of library file
696 directories to check, or a reference to an array of such.
697
698 =item *
699
700 C<alternatives> - an optional array reference of alternate
701 configurations (as hash references) to test if the primary
702 configuration isn't successful.  Each alternative should include an
703 C<altname> key describing the alternative.  Any key not mentioned in
704 an alternative defaults to the value from the main configuration.
705
706 =back
707
708 =head1 AUTHOR
709
710 Tony Cook <tonyc@cpan.org>, Arnar M. Hrafnkelsson
711
712 =cut