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