allow Imager::Probe to accept arrayrefs for incpath and libpath, and
[imager.git] / lib / Imager / Probe.pm
1 package Imager::Probe;
2 use strict;
3 use File::Spec;
4 use Config;
5
6 my @alt_transfer = qw/altname incsuffix libbase/;
7
8 sub probe {
9   my ($class, $req) = @_;
10
11   $req->{verbose} ||= $ENV{IM_VERBOSE};
12
13   my $name = $req->{name};
14   my $result;
15   if ($req->{code}) {
16     $result = _probe_code($req);
17   }
18   if (!$result && $req->{pkg}) {
19     $result = _probe_pkg($req);
20   }
21   if (!$result && $req->{inccheck} && ($req->{libcheck} || $req->{libbase})) {
22     $req->{altname} ||= "main";
23     $result = _probe_check($req);
24   }
25   if (!$result && $req->{alternatives}) {
26   ALTCHECK:
27     my $index = 1;
28     for my $alt (@{$req->{alternatives}}) {
29       $req->{altname} ||= "alt $index";
30       $req->{verbose}
31         and print "$req->{name}: Trying alternative $index\n";
32       my %work = %$req;
33       for my $key (@alt_transfer) {
34         exists $alt->{$key} and $work{$key} = $alt->{$key};
35       }
36       $result = _probe_check(\%work)
37         and last;
38       ++$index;
39     }
40   }
41
42   if (!$result && $req->{testcode}) {
43     $result = _probe_fake($req);
44   }
45   $result or return;
46
47   if ($req->{testcode}) {
48     $result = _probe_test($req, $result);
49   }
50
51   $result or return;
52
53   return $result;
54 }
55
56 sub _probe_code {
57   my ($req) = @_;
58
59   my $code = $req->{code};
60   my @probes = ref $code eq "ARRAY" ? @$code : $code;
61
62   my $result;
63   for my $probe (@probes) {
64     $result = $probe->($req)
65       and return $result;
66   }
67
68   return;
69 }
70
71 sub is_exe {
72   my ($name) = @_;
73
74   my @exe_suffix = $Config{_exe};
75   if ($^O eq 'MSWin32') {
76     push @exe_suffix, qw/.bat .cmd/;
77   }
78
79   for my $dir (File::Spec->path) {
80     for my $suffix (@exe_suffix) {
81       -x File::Spec->catfile($dir, "$name$suffix")
82         and return 1;
83     }
84   }
85
86   return;
87 }
88
89 sub _probe_pkg {
90   my ($req) = @_;
91
92   # Setup pkg-config's environment variable to search non-standard paths
93   # which may be provided by --libdirs.
94   my @pkgcfg_paths = map { "$_/pkgconfig" } _lib_paths( $req );
95   push @pkgcfg_paths, $ENV{ 'PKG_CONFIG_PATH' } if $ENV{ 'PKG_CONFIG_PATH' };
96
97   local $ENV{ 'PKG_CONFIG_PATH' } = join $Config{path_sep}, @pkgcfg_paths;
98
99   is_exe('pkg-config') or return;
100   my $redir = $^O eq 'MSWin32' ? '' : '2>/dev/null';
101
102   my @pkgs = @{$req->{pkg}};
103   for my $pkg (@pkgs) {
104     if (!system("pkg-config $pkg --exists $redir")) {
105       # if we find it, but the following fail, then pkg-config is too
106       # broken to be useful
107       my $cflags = `pkg-config $pkg --cflags`
108         and !$? or return;
109
110       my $lflags = `pkg-config $pkg --libs`
111         and !$? or return;
112
113       chomp $cflags;
114       chomp $lflags;
115       print "$req->{name}: Found via pkg-config $pkg\n";
116       return
117         {
118          INC => $cflags,
119          LIBS => $lflags,
120         };
121     }
122   }
123
124   print "$req->{name}: Not found via pkg-config\n";
125
126   return;
127 }
128
129 sub _probe_check {
130   my ($req) = @_;
131
132   my $libcheck = $req->{libcheck};
133   my $libbase = $req->{libbase};
134   if (!$libcheck && $req->{libbase}) {
135     # synthesize a libcheck
136     my $lext=$Config{'so'};   # Get extensions of libraries
137     my $aext=$Config{'_a'};
138     $libcheck = sub {
139       -e File::Spec->catfile($_[0], "lib$libbase$aext")
140         || -e File::Spec->catfile($_[0], "lib$libbase.$lext")
141       };
142   }
143
144   my $found_libpath;
145   my @lib_search = _lib_paths($req);
146   print "$req->{name}: Searching directories for libraries:\n"
147     if $req->{verbose};
148   for my $path (@lib_search) {
149     print "$req->{name}:   $path\n" if $req->{verbose};
150     if ($libcheck->($path)) {
151       print "$req->{name}: Found!\n" if $req->{verbose};
152       $found_libpath = $path;
153       last;
154     }
155   }
156
157   my $found_incpath;
158   my $inccheck = $req->{inccheck};
159   my @inc_search = _inc_paths($req);
160   print "$req->{name}: Searching directories for headers:\n"
161     if $req->{verbose};
162   for my $path (@inc_search) {
163     print "$req->{name}:   $path\n" if $req->{verbose};
164     if ($inccheck->($path)) {
165       print "$req->{name}: Found!\n" if $req->{verbose};
166       $found_incpath = $path;
167       last;
168     }
169   }
170
171   my $alt = "";
172   if ($req->{alternatives}) {
173     $alt = " $req->{altname}:";
174   }
175   print "$req->{name}:$alt includes ", $found_incpath ? "" : "not ",
176     "found - libraries ", $found_libpath ? "" : "not ", "found\n";
177
178   $found_libpath && $found_incpath
179     or return;
180
181   my @libs = "-L$found_libpath";
182   if ($req->{libopts}) {
183     push @libs, $req->{libopts};
184   }
185   elsif ($libbase) {
186     push @libs, "-l$libbase";
187   }
188   else {
189     die "$req->{name}: inccheck but no libbase or libopts";
190   }
191
192   return
193     {
194      INC => "-I$found_incpath",
195      LIBS => "@libs",
196     };
197 }
198
199 sub _probe_fake {
200   my ($req) = @_;
201
202   # the caller provided test code, and the compiler may look in
203   # places we don't, see Imager-Screenshot ticket 56793,
204   # so fake up a result so the test code can 
205   my $lopts;
206   if ($req->{libopts}) {
207     $lopts = $req->{libopts};
208   }
209   elsif (defined $req->{libbase}) {
210     # might not need extra libraries, eg. Win32 perl already links
211     # everything
212     $lopts = $req->{libbase} ? "-l$req->{libbase}" : "";
213   }
214   if (defined $lopts) {
215     print "$req->{name}: Checking if the compiler can find them on its own\n";
216     return
217       {
218        INC => "",
219        LIBS => $lopts,
220       };
221   }
222   else {
223     print "$req->{name}: Can't fake it - no libbase or libopts\n"
224       if $req->{verbose};
225     return;
226   }
227 }
228
229 sub _probe_test {
230   my ($req, $result) = @_;
231
232   require Devel::CheckLib;
233   # setup LD_RUN_PATH to match link time
234   my ($extra, $bs_load, $ld_load, $ld_run_path) =
235     ExtUtils::Liblist->ext($result->{LIBS}, $req->{verbose});
236   local $ENV{LD_RUN_PATH};
237
238   if ($ld_run_path) {
239     print "Setting LD_RUN_PATH=$ld_run_path for $req->{name} probe\n"
240       if $req->{verbose};
241     $ENV{LD_RUN_PATH} = $ld_run_path;
242   }
243   my $good =
244     Devel::CheckLib::check_lib
245         (
246          debug => $req->{verbose},
247          LIBS => [ $result->{LIBS} ],
248          INC => $result->{INC},
249          header => $req->{testcodeheaders},
250          function => $req->{testcode},
251          prologue => $req->{testcodeprologue},
252         );
253   unless ($good) {
254     print "$req->{name}: Test code failed: $@";
255     return;
256   }
257
258   print "$req->{name}: Passed code check\n";
259   return $result;
260 }
261
262 sub _lib_paths {
263   my ($req) = @_;
264
265   return _paths
266     (
267      $ENV{IM_LIBPATH},
268      $req->{libpath},
269      (
270       map { split ' ' }
271       grep $_,
272       @Config{qw/loclibpth libpth libspath/}
273      ),
274      $^O eq "MSWin32" ? $ENV{LIB} : "",
275      $^O eq "cygwin" ? "/usr/lib/w32api" : "",
276      "/usr/lib",
277      "/usr/local/lib",
278     );
279 }
280
281 sub _inc_paths {
282   my ($req) = @_;
283
284   my @paths = _paths
285     (
286      $ENV{IM_INCPATH},
287      $req->{incpath},
288      $^O eq "MSWin32" ? $ENV{INCLUDE} : "",
289      $^O eq "cygwin" ? "/usr/include/w32api" : "",
290      (
291       map { split ' ' }
292       grep $_,
293       @Config{qw/locincpth incpath/}
294      ),
295      "/usr/include",
296      "/usr/local/include",
297     );
298
299   if ($req->{incsuffix}) {
300     @paths = map File::Spec->catdir($_, $req->{incsuffix}), @paths;
301   }
302
303   return @paths;
304 }
305
306 sub _paths {
307   my (@in) = @_;
308
309   my @out;
310
311   # expand any array refs
312   @in = map { ref() ? @$_ : $_ } @in;
313
314   for my $path (@in) {
315     $path or next;
316     $path = _tilde_expand($path);
317
318     push @out, grep -d $_, split /\Q$Config{path_sep}/, $path;
319   }
320
321   return @out;
322 }
323
324 my $home;
325 sub _tilde_expand {
326   my ($path) = @_;
327
328   if ($path =~ m!^~[/\\]!) {
329     defined $home or $home = $ENV{HOME};
330     if (!defined $home && $^O eq 'MSWin32'
331        && defined $ENV{HOMEDRIVE} && defined $ENV{HOMEPATH}) {
332       $home = $ENV{HOMEDRIVE} . $ENV{HOMEPATH};
333     }
334     unless (defined $home) {
335       $home = eval { (getpwuid($<))[7] };
336     }
337     defined $home or die "You supplied $path, but I can't find your home directory\n";
338     $path =~ s/^~//;
339     $path = File::Spec->catdir($home, $path);
340   }
341
342   return $path;
343 }
344
345 1;
346
347 __END__
348
349 =head1 NAME
350
351 Imager::Probe - hot needle of inquiry for libraries
352
353 =head1 SYNOPSIS
354
355   require Imager::Probe;
356
357   my %probe = 
358     (
359      # short name of what we're looking for (displayed to user)
360      name => "FOO",
361      # pkg-config lookup
362      pkg => [ qw/name1 name2 name3/ ],
363      # perl subs that probe for the library
364      code => [ \&foo_probe1, \&foo_probe2 ],
365      # or just: code => \&foo_probe,
366      inccheck => sub { ... },
367      libcheck => sub { ... },
368      # search for this library if libcheck not supplied
369      libbase => "foo",
370      # library link time options, uses libbase to build options otherwise
371      libopts => "-lfoo",
372      # C code to check the library is sane
373      testcode => "...",
374      # header files needed
375      testcodeheaders => [ "stdio.h", "foo.h" ],
376     );
377   my $result = Imager::Probe->probe(\%probe)
378     or print "Foo library not found: ",Imager::Probe->error;
379
380 =head1 DESCRIPTION
381
382 Does the probes that were hidden in Imager's F<Makefile.PL>, pulled
383 out so the file format libraries can be externalized.
384
385 The return value is either nothing if the probe fails, or a hash
386 containing:
387
388 =over
389
390 =item *
391
392 C<INC> - C<-I> and other C options
393
394 =item *
395
396 C<LIBS> - C<-L>, C<-l> and other link-time options
397
398 =back
399
400 The possible values for the hash supplied to the probe() method are:
401
402 =over
403
404 =item *
405
406 C<pkg> - an array of F<pkg-config> names to probe for.  If the
407 F<pkg-config> checks pass, C<inccheck> and C<libcheck> aren't used.
408
409 =item *
410
411 C<inccheck> - a code reference that checks if the supplied include
412 directory contains the required header files.
413
414 =item *
415
416 C<libcheck> - a code reference that checks if the supplied library
417 directory contains the required library files.  Note: the
418 F<Makefile.PL> version of this was supplied all of the library file
419 names instead.
420
421 =item *
422
423 C<libbase> - if C<inccheck> is supplied, but C<libcheck> isn't, then a
424 C<libcheck> that checks for C<lib>I<libbase>I<$Config{_a}> and
425 C<lib>I<libbase>.I<$Config{so}> is created.  If C<libopts> isn't
426 supplied then that can be synthesized as C<-l>C<<I<libbase>>>.
427
428 =item *
429
430 C<libopts> - if the libraries are found via C<inccheck>/C<libcheck>,
431 these are the C<-l> options to supply during the link phase.
432
433 =item *
434
435 C<code> - a code reference to perform custom checks.  Returns the
436 probe result directly.  Can also be an array ref of functions to call.
437
438 =item *
439
440 C<testcode> - test C code that is run with Devel::CheckLib.  You also
441 need to set C<testcodeheaders>.
442
443 =item *
444
445 C<testcodeprologue> - C code to insert between the headers and the
446 main function.
447
448 =item *
449
450 C<incpath> - C<$Config{path_sep}> separated list of header file
451 directories to check, or a reference to an array of such.
452
453 =item *
454
455 C<libpath> - C<$Config{path_sep}> separated list of library file
456 directories to check, or a reference to an array of such.
457
458 =back
459
460 =cut