06123f1e0fa51aca5b0e7bb7cb311501fd4bc1ca
[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   for my $path (@in) {
312     $path or next;
313     $path = _tilde_expand($path);
314
315     push @out, grep -d $_, split /\Q$Config{path_sep}/, $path;
316   }
317
318   return @out;
319 }
320
321 my $home;
322 sub _tilde_expand {
323   my ($path) = @_;
324
325   if ($path =~ m!^~[/\\]!) {
326     defined $home or $home = $ENV{HOME};
327     if (!defined $home && $^O eq 'MSWin32'
328        && defined $ENV{HOMEDRIVE} && defined $ENV{HOMEPATH}) {
329       $home = $ENV{HOMEDRIVE} . $ENV{HOMEPATH};
330     }
331     unless (defined $home) {
332       $home = eval { (getpwuid($<))[7] };
333     }
334     defined $home or die "You supplied $path, but I can't find your home directory\n";
335     $path =~ s/^~//;
336     $path = File::Spec->catdir($home, $path);
337   }
338
339   return $path;
340 }
341
342 1;
343
344 __END__
345
346 =head1 NAME
347
348 Imager::Probe - hot needle of inquiry for libraries
349
350 =head1 SYNOPSIS
351
352   require Imager::Probe;
353
354   my %probe = 
355     (
356      # short name of what we're looking for (displayed to user)
357      name => "FOO",
358      # pkg-config lookup
359      pkg => [ qw/name1 name2 name3/ ],
360      # perl subs that probe for the library
361      code => [ \&foo_probe1, \&foo_probe2 ],
362      # or just: code => \&foo_probe,
363      inccheck => sub { ... },
364      libcheck => sub { ... },
365      # search for this library if libcheck not supplied
366      libbase => "foo",
367      # library link time options, uses libbase to build options otherwise
368      libopts => "-lfoo",
369      # C code to check the library is sane
370      testcode => "...",
371      # header files needed
372      testcodeheaders => [ "stdio.h", "foo.h" ],
373     );
374   my $result = Imager::Probe->probe(\%probe)
375     or print "Foo library not found: ",Imager::Probe->error;
376
377 =head1 DESCRIPTION
378
379 Does the probes that were hidden in Imager's F<Makefile.PL>, pulled
380 out so the file format libraries can be externalized.
381
382 The return value is either nothing if the probe fails, or a hash
383 containing:
384
385 =over
386
387 =item *
388
389 C<INC> - C<-I> and other C options
390
391 =item *
392
393 C<LIBS> - C<-L>, C<-l> and other link-time options
394
395 =back
396
397 The possible values for the hash supplied to the probe() method are:
398
399 =over
400
401 =item *
402
403 C<pkg> - an array of F<pkg-config> names to probe for.  If the
404 F<pkg-config> checks pass, C<inccheck> and C<libcheck> aren't used.
405
406 =item *
407
408 C<inccheck> - a code reference that checks if the supplied include
409 directory contains the required header files.
410
411 =item *
412
413 C<libcheck> - a code reference that checks if the supplied library
414 directory contains the required library files.  Note: the
415 F<Makefile.PL> version of this was supplied all of the library file
416 names instead.
417
418 =item *
419
420 C<libbase> - if C<inccheck> is supplied, but C<libcheck> isn't, then a
421 C<libcheck> that checks for C<lib>I<libbase>I<$Config{_a}> and
422 C<lib>I<libbase>.I<$Config{so}> is created.  If C<libopts> isn't
423 supplied then that can be synthesized as C<-l>C<<I<libbase>>>.
424
425 =item *
426
427 C<libopts> - if the libraries are found via C<inccheck>/C<libcheck>,
428 these are the C<-l> options to supply during the link phase.
429
430 =item *
431
432 C<code> - a code reference to perform custom checks.  Returns the
433 probe result directly.  Can also be an array ref of functions to call.
434
435 =item *
436
437 C<testcode> - test C code that is run with Devel::CheckLib.  You also
438 need to set C<testcodeheaders>.
439
440 =item *
441
442 C<testcodeprologue> - C code to insert between the headers and the
443 main function.
444
445 =item *
446
447 C<incpath> - C<$Config{path_sep}> separated list of header file
448 directories to check.
449
450 =item *
451
452 C<libpath> - C<$Config{path_sep}> separated list of library file
453 directories to check.
454
455 =back
456
457 =cut