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