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->{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       my $defines = '';
 114       $cflags =~ s/(-D\S+)/$defines .= " $1"; ''/ge;
 115
 116       chomp $cflags;
 117       chomp $lflags;
 118       print "$req->{name}: Found via pkg-config $pkg\n";
 119       return
 120         {
 121          INC => $cflags,
 122          LIBS => $lflags,
 123          DEFINE => $defines,
 124         };
 125     }
 126   }
 127
 128   print "$req->{name}: Not found via pkg-config\n";
 129
 130   return;
 131 }
 132
 133 sub _probe_check {
 134   my ($req) = @_;
 135
 136   my $libcheck = $req->{libcheck};
 137   my $libbase = $req->{libbase};
 138   if (!$libcheck && $req->{libbase}) {
 139     # synthesize a libcheck
 140     my $lext=$Config{'so'};   # Get extensions of libraries
 141     my $aext=$Config{'_a'};
 142     $libcheck = sub {
 143       -e File::Spec->catfile($_[0], "lib$libbase$aext")
 144         || -e File::Spec->catfile($_[0], "lib$libbase.$lext")
 145       };
 146   }
 147
 148   my $found_libpath;
 149   my @lib_search = _lib_paths($req);
 150   print "$req->{name}: Searching directories for libraries:\n"
 151     if $req->{verbose};
 152   for my $path (@lib_search) {
 153     print "$req->{name}:   $path\n" if $req->{verbose};
 154     if ($libcheck->($path)) {
 155       print "$req->{name}: Found!\n" if $req->{verbose};
 156       $found_libpath = $path;
 157       last;
 158     }
 159   }
 160
 161   my $found_incpath;
 162   my $inccheck = $req->{inccheck};
 163   my @inc_search = _inc_paths($req);
 164   print "$req->{name}: Searching directories for headers:\n"
 165     if $req->{verbose};
 166   for my $path (@inc_search) {
 167     print "$req->{name}:   $path\n" if $req->{verbose};
 168     if ($inccheck->($path)) {
 169       print "$req->{name}: Found!\n" if $req->{verbose};
 170       $found_incpath = $path;
 171       last;
 172     }
 173   }
 174
 175   my $alt = "";
 176   if ($req->{altname}) {
 177     $alt = " $req->{altname}:";
 178   }
 179   print "$req->{name}:$alt includes ", $found_incpath ? "" : "not ",
 180     "found - libraries ", $found_libpath ? "" : "not ", "found\n";
 181
 182   $found_libpath && $found_incpath
 183     or return;
 184
 185   my @libs = "-L$found_libpath";
 186   if ($req->{libopts}) {
 187     push @libs, $req->{libopts};
 188   }
 189   elsif ($libbase) {
 190     push @libs, "-l$libbase";
 191   }
 192   else {
 193     die "$req->{altname}: inccheck but no libbase or libopts";
 194   }
 195
 196   return
 197     {
 198      INC => "-I$found_incpath",
 199      LIBS => "@libs",
 200      DEFINE => "",
 201     };
 202 }
 203
 204 sub _probe_fake {
 205   my ($req) = @_;
 206
 207   # the caller provided test code, and the compiler may look in
 208   # places we don't, see Imager-Screenshot ticket 56793,
 209   # so fake up a result so the test code can
 210   my $lopts;
 211   if ($req->{libopts}) {
 212     $lopts = $req->{libopts};
 213   }
 214   elsif (defined $req->{libbase}) {
 215     # might not need extra libraries, eg. Win32 perl already links
 216     # everything
 217     $lopts = $req->{libbase} ? "-l$req->{libbase}" : "";
 218   }
 219   if (defined $lopts) {
 220     print "$req->{name}: Checking if the compiler can find them on its own\n";
 221     return
 222       {
 223        INC => "",
 224        LIBS => $lopts,
 225        DEFINE => "",
 226       };
 227   }
 228   else {
 229     print "$req->{name}: Can't fake it - no libbase or libopts\n"
 230       if $req->{verbose};
 231     return;
 232   }
 233 }
 234
 235 sub _probe_test {
 236   my ($req, $result) = @_;
 237
 238   require Devel::CheckLib;
 239   # setup LD_RUN_PATH to match link time
 240   my ($extra, $bs_load, $ld_load, $ld_run_path) =
 241     ExtUtils::Liblist->ext($result->{LIBS}, $req->{verbose});
 242   local $ENV{LD_RUN_PATH};
 243
 244   if ($ld_run_path) {
 245     print "Setting LD_RUN_PATH=$ld_run_path for $req->{name} probe\n"
 246       if $req->{verbose};
 247     $ENV{LD_RUN_PATH} = $ld_run_path;
 248   }
 249   my $good =
 250     Devel::CheckLib::check_lib
 251         (
 252          debug => $req->{verbose},
 253          LIBS => [ $result->{LIBS} ],
 254          INC => $result->{INC},
 255          header => $req->{testcodeheaders},
 256          function => $req->{testcode},
 257          prologue => $req->{testcodeprologue},
 258         );
 259   unless ($good) {
 260     print "$req->{name}: Test code failed: $@";
 261     return;
 262   }
 263
 264   print "$req->{name}: Passed code check\n";
 265   return $result;
 266 }
 267
 268 sub _lib_paths {
 269   my ($req) = @_;
 270
 271   return _paths
 272     (
 273      $ENV{IM_LIBPATH},
 274      $req->{libpath},
 275      (
 276       map { split ' ' }
 277       grep $_,
 278       @Config{qw/loclibpth libpth libspath/}
 279      ),
 280      $^O eq "MSWin32" ? $ENV{LIB} : "",
 281      $^O eq "cygwin" ? "/usr/lib/w32api" : "",
 282      "/usr/lib",
 283      "/usr/local/lib",
 284     );
 285 }
 286
 287 sub _inc_paths {
 288   my ($req) = @_;
 289
 290   my @paths = _paths
 291     (
 292      $ENV{IM_INCPATH},
 293      $req->{incpath},
 294      $^O eq "MSWin32" ? $ENV{INCLUDE} : "",
 295      $^O eq "cygwin" ? "/usr/include/w32api" : "",
 296      (
 297       map { split ' ' }
 298       grep $_,
 299       @Config{qw/locincpth incpath/}
 300      ),
 301      "/usr/include",
 302      "/usr/local/include",
 303     );
 304
 305   if ($req->{incsuffix}) {
 306     @paths = map File::Spec->catdir($_, $req->{incsuffix}), @paths;
 307   }
 308
 309   return @paths;
 310 }
 311
 312 sub _paths {
 313   my (@in) = @_;
 314
 315   my @out;
 316
 317   # expand any array refs
 318   @in = map { ref() ? @$_ : $_ } @in;
 319
 320   for my $path (@in) {
 321     $path or next;
 322     $path = _tilde_expand($path);
 323
 324     push @out, grep -d $_, split /\Q$Config{path_sep}/, $path;
 325   }
 326
 327   return @out;
 328 }
 329
 330 my $home;
 331 sub _tilde_expand {
 332   my ($path) = @_;
 333
 334   if ($path =~ m!^~[/\\]!) {
 335     defined $home or $home = $ENV{HOME};
 336     if (!defined $home && $^O eq 'MSWin32'
 337        && defined $ENV{HOMEDRIVE} && defined $ENV{HOMEPATH}) {
 338       $home = $ENV{HOMEDRIVE} . $ENV{HOMEPATH};
 339     }
 340     unless (defined $home) {
 341       $home = eval { (getpwuid($<))[7] };
 342     }
 343     defined $home or die "You supplied $path, but I can't find your home directory\n";
 344     $path =~ s/^~//;
 345     $path = File::Spec->catdir($home, $path);
 346   }
 347
 348   return $path;
 349 }
 350
 351 1;
 352
 353 __END__
 354
 355 =head1 NAME
 356
 357 Imager::Probe - hot needle of inquiry for libraries
 358
 359 =head1 SYNOPSIS
 360
 361   require Imager::Probe;
 362
 363   my %probe =
 364     (
 365      # short name of what we're looking for (displayed to user)
 366      name => "FOO",
 367      # pkg-config lookup
 368      pkg => [ qw/name1 name2 name3/ ],
 369      # perl subs that probe for the library
 370      code => [ \&foo_probe1, \&foo_probe2 ],
 371      # or just: code => \&foo_probe,
 372      inccheck => sub { ... },
 373      libcheck => sub { ... },
 374      # search for this library if libcheck not supplied
 375      libbase => "foo",
 376      # library link time options, uses libbase to build options otherwise
 377      libopts => "-lfoo",
 378      # C code to check the library is sane
 379      testcode => "...",
 380      # header files needed
 381      testcodeheaders => [ "stdio.h", "foo.h" ],
 382     );
 383   my $result = Imager::Probe->probe(\%probe)
 384     or print "Foo library not found: ",Imager::Probe->error;
 385
 386 =head1 DESCRIPTION
 387
 388 Does the probes that were hidden in Imager's F<Makefile.PL>, pulled
 389 out so the file format libraries can be externalized.
 390
 391 The return value is either nothing if the probe fails, or a hash
 392 containing:
 393
 394 =over
 395
 396 =item *
 397
 398 C<INC> - C<-I> and other C options
 399
 400 =item *
 401
 402 C<LIBS> - C<-L>, C<-l> and other link-time options
 403
 404 =item *
 405
 406 C<DEFINE> - C<-D> options, if any.
 407
 408 =back
 409
 410 The possible values for the hash supplied to the probe() method are:
 411
 412 =over
 413
 414 =item *
 415
 416 C<pkg> - an array of F<pkg-config> names to probe for.  If the
 417 F<pkg-config> checks pass, C<inccheck> and C<libcheck> aren't used.
 418
 419 =item *
 420
 421 C<inccheck> - a code reference that checks if the supplied include
 422 directory contains the required header files.
 423
 424 =item *
 425
 426 C<libcheck> - a code reference that checks if the supplied library
 427 directory contains the required library files.  Note: the
 428 F<Makefile.PL> version of this was supplied all of the library file
 429 names instead.
 430
 431 =item *
 432
 433 C<libbase> - if C<inccheck> is supplied, but C<libcheck> isn't, then a
 434 C<libcheck> that checks for C<lib>I<libbase>I<$Config{_a}> and
 435 C<lib>I<libbase>.I<$Config{so}> is created.  If C<libopts> isn't
 436 supplied then that can be synthesized as C<-l>C<<I<libbase>>>.
 437
 438 =item *
 439
 440 C<libopts> - if the libraries are found via C<inccheck>/C<libcheck>,
 441 these are the C<-l> options to supply during the link phase.
 442
 443 =item *
 444
 445 C<code> - a code reference to perform custom checks.  Returns the
 446 probe result directly.  Can also be an array ref of functions to call.
 447
 448 =item *
 449
 450 C<testcode> - test C code that is run with Devel::CheckLib.  You also
 451 need to set C<testcodeheaders>.
 452
 453 =item *
 454
 455 C<testcodeprologue> - C code to insert between the headers and the
 456 main function.
 457
 458 =item *
 459
 460 C<incpath> - C<$Config{path_sep}> separated list of header file
 461 directories to check, or a reference to an array of such.
 462
 463 =item *
 464
 465 C<libpath> - C<$Config{path_sep}> separated list of library file
 466 directories to check, or a reference to an array of such.
 467
 468 =back
 469
 470 =cut