lib/Imager/Probe.pm

   1 package Imager::Probe;
   2 use strict;
   3 use File::Spec;
   4 use Config;
   5 use Cwd ();
   6
   7 our $VERSION = "1.005";
   8
   9 my @alt_transfer = qw/altname incsuffix libbase/;
  10
  11 sub probe {
  12   my ($class, $req) = @_;
  13
  14   $req->{verbose} ||= $ENV{IM_VERBOSE};
  15
  16   my $name = $req->{name};
  17   my $result;
  18   if ($req->{code}) {
  19     $result = _probe_code($req);
  20   }
  21   if (!$result && $req->{pkg}) {
  22     $result = _probe_pkg($req);
  23   }
  24   if (!$result && $req->{inccheck} && ($req->{libcheck} || $req->{libbase})) {
  25     $req->{altname} ||= "main";
  26     $result = _probe_check($req);
  27   }
  28
  29   if ($result && $req->{testcode}) {
  30     $result = _probe_test($req, $result);
  31   }
  32
  33   if (!$result && $req->{alternatives}) {
  34   ALTCHECK:
  35     my $index = 1;
  36     for my $alt (@{$req->{alternatives}}) {
  37       $req->{altname} = $alt->{altname} || "alt $index";
  38       $req->{verbose}
  39         and print "$req->{name}: Trying alternative $index\n";
  40       my %work = %$req;
  41       for my $key (@alt_transfer) {
  42         exists $alt->{$key} and $work{$key} = $alt->{$key};
  43       }
  44       $result = _probe_check(\%work);
  45
  46       if ($result && $req->{testcode}) {
  47         $result = _probe_test(\%work, $result);
  48       }
  49
  50       $result
  51         and last;
  52
  53       ++$index;
  54     }
  55   }
  56
  57   if (!$result && $req->{testcode}) {
  58     $result = _probe_fake($req);
  59
  60     $result or return;
  61
  62     $result = _probe_test($req, $result);
  63   }
  64
  65   $result or return;
  66
  67   return $result;
  68 }
  69
  70 sub _probe_code {
  71   my ($req) = @_;
  72
  73   my $code = $req->{code};
  74   my @probes = ref $code eq "ARRAY" ? @$code : $code;
  75
  76   my $result;
  77   for my $probe (@probes) {
  78     $result = $probe->($req)
  79       and return $result;
  80   }
  81
  82   return;
  83 }
  84
  85 sub is_exe {
  86   my ($name) = @_;
  87
  88   my @exe_suffix = $Config{_exe};
  89   if ($^O eq 'MSWin32') {
  90     push @exe_suffix, qw/.bat .cmd/;
  91   }
  92
  93   for my $dir (File::Spec->path) {
  94     for my $suffix (@exe_suffix) {
  95       -x File::Spec->catfile($dir, "$name$suffix")
  96         and return 1;
  97     }
  98   }
  99
 100   return;
 101 }
 102
 103 sub _probe_pkg {
 104   my ($req) = @_;
 105
 106   # Setup pkg-config's environment variable to search non-standard paths
 107   # which may be provided by --libdirs.
 108   my @pkgcfg_paths = map { "$_/pkgconfig" } _lib_paths( $req );
 109   push @pkgcfg_paths, $ENV{ 'PKG_CONFIG_PATH' } if $ENV{ 'PKG_CONFIG_PATH' };
 110
 111   local $ENV{ 'PKG_CONFIG_PATH' } = join $Config{path_sep}, @pkgcfg_paths;
 112
 113   is_exe('pkg-config') or return;
 114   my $redir = $^O eq 'MSWin32' ? '' : '2>/dev/null';
 115
 116   my @pkgs = @{$req->{pkg}};
 117   for my $pkg (@pkgs) {
 118     if (!system("pkg-config $pkg --exists $redir")) {
 119       # if we find it, but the following fail, then pkg-config is too
 120       # broken to be useful
 121       my $cflags = `pkg-config $pkg --cflags`
 122         and !$? or return;
 123
 124       my $lflags = `pkg-config $pkg --libs`
 125         and !$? or return;
 126
 127       my $defines = '';
 128       $cflags =~ s/(-D\S+)/$defines .= " $1"; ''/ge;
 129
 130       chomp $cflags;
 131       chomp $lflags;
 132       print "$req->{name}: Found via pkg-config $pkg\n";
 133       print <<EOS if $req->{verbose};
 134   cflags: $cflags
 135   defines: $defines
 136   lflags: $lflags
 137 EOS
 138       # rt 75869
 139       # if Win32 doesn't provide this information, too bad
 140       if (!grep(/^-L/, split " ", $lflags)
 141           && $^O ne 'MSWin32') {
 142         # pkg-config told us about the library, make sure it's
 143         # somewhere EU::MM can find it
 144         print "Checking if EU::MM can find $lflags\n" if $req->{verbose};
 145         my ($extra, $bs_load, $ld_load, $ld_run_path) =
 146           ExtUtils::Liblist->ext($lflags, $req->{verbose});
 147         unless ($ld_run_path) {
 148           # search our standard places
 149           $lflags = _resolve_libs($req, $lflags);
 150         }
 151       }
 152
 153       return
 154         {
 155          INC => $cflags,
 156          LIBS => $lflags,
 157          DEFINE => $defines,
 158         };
 159     }
 160   }
 161
 162   print "$req->{name}: Not found via pkg-config\n";
 163
 164   return;
 165 }
 166
 167 sub _is_msvc {
 168   return $Config{cc} eq "cl";
 169 }
 170
 171 sub _lib_basename {
 172   my ($base) = @_;
 173
 174   if (_is_msvc()) {
 175     return $base;
 176   }
 177   else {
 178     return "lib$base";
 179   }
 180 }
 181
 182 sub _lib_option {
 183   my ($base) = @_;
 184
 185   if (_is_msvc()) {
 186     return $base . $Config{_a};
 187   }
 188   else {
 189     return "-l$base";
 190   }
 191 }
 192
 193 sub _quotearg {
 194   my ($opt) = @_;
 195
 196   return $opt =~ /\s/ ? qq("$opt") : $opt;
 197 }
 198
 199 sub _probe_check {
 200   my ($req) = @_;
 201
 202   my @libcheck;
 203   my @libbase;
 204   if ($req->{libcheck}) {
 205     if (ref $req->{libcheck} eq "ARRAY") {
 206       push @libcheck, @{$req->{libcheck}};
 207     }
 208     else {
 209       push @libcheck, $req->{libcheck};
 210     }
 211   }
 212   elsif ($req->{libbase}) {
 213     @libbase = ref $req->{libbase} ? @{$req->{libbase}} : $req->{libbase};
 214
 215     my $lext=$Config{'so'};   # Get extensions of libraries
 216     my $aext=$Config{'_a'};
 217
 218     for my $libbase (@libbase) {
 219       my $basename = _lib_basename($libbase);
 220       push @libcheck, sub {
 221         -e File::Spec->catfile($_[0], "$basename$aext")
 222           || -e File::Spec->catfile($_[0], "$basename.$lext")
 223         };
 224     }
 225   }
 226   else {
 227     print "$req->{name}: No libcheck or libbase, nothing to search for\n"
 228       if $req->{verbose};
 229     return;
 230   }
 231
 232   my @found_libpath;
 233   my @lib_search = _lib_paths($req);
 234   print "$req->{name}: Searching directories for libraries:\n"
 235     if $req->{verbose};
 236   for my $libcheck (@libcheck) {
 237     for my $path (@lib_search) {
 238       print "$req->{name}:   $path\n" if $req->{verbose};
 239       if ($libcheck->($path)) {
 240         print "$req->{name}: Found!\n" if $req->{verbose};
 241         push @found_libpath, $path;
 242         last;
 243       }
 244     }
 245   }
 246
 247   my $found_incpath;
 248   my $inccheck = $req->{inccheck};
 249   my @inc_search = _inc_paths($req);
 250   print "$req->{name}: Searching directories for headers:\n"
 251     if $req->{verbose};
 252   for my $path (@inc_search) {
 253     print "$req->{name}:   $path\n" if $req->{verbose};
 254     if ($inccheck->($path)) {
 255       print "$req->{name}: Found!\n" if $req->{verbose};
 256       $found_incpath = $path;
 257       last;
 258     }
 259   }
 260
 261   my $alt = "";
 262   if ($req->{altname}) {
 263     $alt = " $req->{altname}:";
 264   }
 265   print "$req->{name}:$alt includes ", $found_incpath ? "" : "not ",
 266     "found - libraries ", @found_libpath == @libcheck ? "" : "not ", "found\n";
 267
 268   @found_libpath == @libcheck && $found_incpath
 269     or return;
 270
 271   my @libs = map "-L$_", @found_libpath;
 272   if ($req->{libopts}) {
 273     push @libs, $req->{libopts};
 274   }
 275   elsif (@libbase) {
 276     push @libs, map _lib_option($_), @libbase;
 277   }
 278   else {
 279     die "$req->{altname}: inccheck but no libbase or libopts";
 280   }
 281
 282   return
 283     {
 284      INC => _quotearg("-I$found_incpath"),
 285      LIBS => join(" ", map _quotearg($_), @libs),
 286      DEFINE => "",
 287     };
 288 }
 289
 290 sub _probe_fake {
 291   my ($req) = @_;
 292
 293   # the caller provided test code, and the compiler may look in
 294   # places we don't, see Imager-Screenshot ticket 56793,
 295   # so fake up a result so the test code can
 296   my $lopts;
 297   if ($req->{libopts}) {
 298     $lopts = $req->{libopts};
 299   }
 300   elsif (defined $req->{libbase}) {
 301     # might not need extra libraries, eg. Win32 perl already links
 302     # everything
 303     $lopts = $req->{libbase} ? "-l$req->{libbase}" : "";
 304   }
 305   if (defined $lopts) {
 306     print "$req->{name}: Checking if the compiler can find them on its own\n";
 307     return
 308       {
 309        INC => "",
 310        LIBS => $lopts,
 311        DEFINE => "",
 312       };
 313   }
 314   else {
 315     print "$req->{name}: Can't fake it - no libbase or libopts\n"
 316       if $req->{verbose};
 317     return;
 318   }
 319 }
 320
 321 sub _probe_test {
 322   my ($req, $result) = @_;
 323
 324   require Devel::CheckLib;
 325   # setup LD_RUN_PATH to match link time
 326   print "Asking liblist for LD_RUN_PATH:\n" if $req->{verbose};
 327   my ($extra, $bs_load, $ld_load, $ld_run_path) =
 328     ExtUtils::Liblist->ext($result->{LIBS}, $req->{verbose});
 329   local $ENV{LD_RUN_PATH};
 330
 331   if ($ld_run_path) {
 332     print "Setting LD_RUN_PATH=$ld_run_path for $req->{name} probe\n"
 333       if $req->{verbose};
 334     $ENV{LD_RUN_PATH} = $ld_run_path;
 335     if ($Config{lddlflags} =~ /([^ ]*-(?:rpath|R)[,=]?)([^ ]+)/
 336         && -d $2) {
 337       # hackety, hackety
 338       # LD_RUN_PATH is ignored when there's already an -rpath option
 339       # so provide one
 340       my $prefix = $1;
 341       $result->{LDDLFLAGS} = $Config{lddlflags} . " " .
 342         join " ", map "$prefix$_", split $Config{path_sep}, $ld_run_path;
 343     }
 344   }
 345   my $good =
 346     Devel::CheckLib::check_lib
 347         (
 348          debug => $req->{verbose},
 349          LIBS => [ $result->{LIBS} ],
 350          INC => $result->{INC},
 351          header => $req->{testcodeheaders},
 352          function => $req->{testcode},
 353          prologue => $req->{testcodeprologue},
 354         );
 355   unless ($good) {
 356     print "$req->{name}: Test code failed: $@";
 357     return;
 358   }
 359
 360   print "$req->{name}: Passed code check\n";
 361   return $result;
 362 }
 363
 364 sub _resolve_libs {
 365   my ($req, $lflags) = @_;
 366
 367   my @libs = grep /^-l/, split ' ', $lflags;
 368   my %paths;
 369   my @paths = _lib_paths($req);
 370   my $so = $Config{so};
 371   my $libext = $Config{_a};
 372   for my $lib (@libs) {
 373     $lib =~ s/^-l/lib/;
 374
 375     for my $path (@paths) {
 376       if (-e "$path/$lib.$so" || -e "$path/$lib$libext") {
 377         $paths{$path} = 1;
 378       }
 379     }
 380   }
 381
 382   return join(" ", ( map "-L$_", keys %paths ), $lflags );
 383 }
 384
 385 sub _lib_paths {
 386   my ($req) = @_;
 387
 388   print "$req->{name} IM_LIBPATH: $ENV{IM_LIBPATH}\n"
 389     if $req->{verbose} && defined $ENV{IM_LIBPATH};
 390   print "$req->{name} LIB: $ENV{IM_LIBPATH}\n"
 391     if $req->{verbose} && defined $ENV{LIB} && $^O eq "MSWin32";
 392   my $lp = $req->{libpath};
 393   print "$req->{name} libpath: ", ref $lp ? join($Config{path_sep}, @$lp) : $lp, "\n"
 394     if $req->{verbose} && defined $lp;
 395
 396   return _paths
 397     (
 398      $ENV{IM_LIBPATH},
 399      $req->{libpath},
 400      (
 401       map { split ' ' }
 402       grep $_,
 403       @Config{qw/loclibpth libpth libspath/}
 404      ),
 405      $^O eq "MSWin32" ? $ENV{LIB} : "",
 406      $^O eq "cygwin" ? "/usr/lib/w32api" : "",
 407      "/usr/lib",
 408      "/usr/local/lib",
 409      _gcc_lib_paths(),
 410      _dyn_lib_paths(),
 411     );
 412 }
 413
 414 sub _gcc_lib_paths {
 415   $Config{gccversion}
 416     or return;
 417
 418   my ($base_version) = $Config{gccversion} =~ /^([0-9]+)/
 419     or return;
 420
 421   $base_version >= 4
 422     or return;
 423
 424   local $ENV{LANG} = "C";
 425   local $ENV{LC_ALL} = "C";
 426   my ($lib_line) = grep /^libraries:/, `$Config{cc} -print-search-dirs`
 427     or return;
 428   $lib_line =~ s/^libraries: =//;
 429   chomp $lib_line;
 430
 431   return grep !/gcc/ && -d, split /:/, $lib_line;
 432 }
 433
 434 sub _dyn_lib_paths {
 435   return map { defined() ? split /\Q$Config{path_sep}/ : () }
 436     map $ENV{$_},
 437       qw(LD_RUN_PATH LD_LIBRARY_PATH DYLD_LIBRARY_PATH LIBRARY_PATH);
 438 }
 439
 440 sub _inc_paths {
 441   my ($req) = @_;
 442
 443   print "$req->{name} IM_INCPATH: $ENV{IM_INCPATH}\n"
 444     if $req->{verbose} && defined $ENV{IM_INCPATH};
 445   print "$req->{name} INCLUDE: $ENV{INCLUDE}\n"
 446     if $req->{verbose} && defined $ENV{INCLUDE} && $^O eq "MSWin32";
 447   my $ip = $req->{incpath};
 448   print "$req->{name} incpath: ", ref $ip ? join($Config{path_sep}, @$ip) : $ip, "\n"
 449     if $req->{verbose} && defined $req->{incpath};
 450
 451   my @paths = _paths
 452     (
 453      $ENV{IM_INCPATH},
 454      $req->{incpath},
 455      $^O eq "MSWin32" ? $ENV{INCLUDE} : "",
 456      $^O eq "cygwin" ? "/usr/include/w32api" : "",
 457      (
 458       map { split ' ' }
 459       grep $_,
 460       @Config{qw/locincpth incpath/}
 461      ),
 462      "/usr/include",
 463      "/usr/local/include",
 464      _gcc_inc_paths(),
 465      _dyn_inc_paths(),
 466     );
 467
 468   if ($req->{incsuffix}) {
 469     @paths = map File::Spec->catdir($_, $req->{incsuffix}), @paths;
 470   }
 471
 472   return @paths;
 473 }
 474
 475 sub _gcc_inc_paths {
 476   $Config{gccversion}
 477     or return;
 478
 479   my ($base_version) = $Config{gccversion} =~ /^([0-9]+)/
 480     or return;
 481
 482   $base_version >= 4
 483     or return;
 484
 485   local $ENV{LANG} = "C";
 486   local $ENV{LC_ALL} = "C";
 487   my $devnull = File::Spec->devnull;
 488   my @spam = `$Config{cc} -E -v - <$devnull 2>&1`;
 489   # output includes lines like:
 490   # ...
 491   # ignoring nonexistent directory "/usr/lib/gcc/x86_64-linux-gnu/4.9/../../../../x86_64-linux-gnu/include"
 492   # #include "..." search starts here:
 493   # #include <...> search starts here:
 494   #  /usr/lib/gcc/x86_64-linux-gnu/4.9/include
 495   #  /usr/local/include
 496   #  /usr/lib/gcc/x86_64-linux-gnu/4.9/include-fixed
 497   #  /usr/include/x86_64-linux-gnu
 498   #  /usr/include
 499   # End of search list.
 500   # # 1 "<stdin>"
 501   # # 1 "<built-in>"
 502   # ...
 503
 504   while (@spam && $spam[0] !~ /^#include /) {
 505     shift @spam;
 506   }
 507   my @inc;
 508   while (@spam && $spam[0] !~ /^End of search/) {
 509     my $line = shift @spam;
 510     chomp $line;
 511     next if $line =~ /^#include /;
 512     next unless $line =~ s/^\s+//;
 513     push @inc, $line;
 514   }
 515   return @inc;
 516 }
 517
 518 sub _dyn_inc_paths {
 519   return map {
 520     my $tmp = $_;
 521     $tmp =~ s/\blib$/include/ ? $tmp : ()
 522   } _dyn_lib_paths();
 523 }
 524
 525 sub _paths {
 526   my (@in) = @_;
 527
 528   my @out;
 529
 530   # expand any array refs
 531   @in = map { ref() ? @$_ : $_ } @in;
 532
 533   for my $path (@in) {
 534     $path or next;
 535     $path = _tilde_expand($path);
 536
 537     push @out, grep -d $_, split /\Q$Config{path_sep}/, $path;
 538   }
 539
 540   @out = map Cwd::realpath($_), @out;
 541
 542   my %seen;
 543   @out = grep !$seen{$_}++, @out;
 544
 545   return @out;
 546 }
 547
 548 my $home;
 549 sub _tilde_expand {
 550   my ($path) = @_;
 551
 552   if ($path =~ m!^~[/\\]!) {
 553     defined $home or $home = $ENV{HOME};
 554     if (!defined $home && $^O eq 'MSWin32'
 555        && defined $ENV{HOMEDRIVE} && defined $ENV{HOMEPATH}) {
 556       $home = $ENV{HOMEDRIVE} . $ENV{HOMEPATH};
 557     }
 558     unless (defined $home) {
 559       $home = eval { (getpwuid($<))[7] };
 560     }
 561     defined $home or die "You supplied $path, but I can't find your home directory\n";
 562     $path =~ s/^~//;
 563     $path = File::Spec->catdir($home, $path);
 564   }
 565
 566   return $path;
 567 }
 568
 569 1;
 570
 571 __END__
 572
 573 =head1 NAME
 574
 575 Imager::Probe - hot needle of inquiry for libraries
 576
 577 =head1 SYNOPSIS
 578
 579   require Imager::Probe;
 580
 581   my %probe =
 582     (
 583      # short name of what we're looking for (displayed to user)
 584      name => "FOO",
 585      # pkg-config lookup
 586      pkg => [ qw/name1 name2 name3/ ],
 587      # perl subs that probe for the library
 588      code => [ \&foo_probe1, \&foo_probe2 ],
 589      # or just: code => \&foo_probe,
 590      inccheck => sub { ... },
 591      libcheck => sub { ... },
 592      # search for this library if libcheck not supplied
 593      libbase => "foo",
 594      # library link time options, uses libbase to build options otherwise
 595      libopts => "-lfoo",
 596      # C code to check the library is sane
 597      testcode => "...",
 598      # header files needed
 599      testcodeheaders => [ "stdio.h", "foo.h" ],
 600     );
 601   my $result = Imager::Probe->probe(\%probe)
 602     or print "Foo library not found: ",Imager::Probe->error;
 603
 604 =head1 DESCRIPTION
 605
 606 Does the probes that were hidden in Imager's F<Makefile.PL>, pulled
 607 out so the file format libraries can be externalized.
 608
 609 The return value is either nothing if the probe fails, or a hash
 610 containing:
 611
 612 =over
 613
 614 =item *
 615
 616 C<INC> - C<-I> and other C options
 617
 618 =item *
 619
 620 C<LIBS> - C<-L>, C<-l> and other link-time options
 621
 622 =item *
 623
 624 C<DEFINE> - C<-D> options, if any.
 625
 626 =back
 627
 628 The possible values for the hash supplied to the probe() method are:
 629
 630 =over
 631
 632 =item *
 633
 634 C<pkg> - an array of F<pkg-config> names to probe for.  If the
 635 F<pkg-config> checks pass, C<inccheck> and C<libcheck> aren't used.
 636
 637 =item *
 638
 639 C<inccheck> - a code reference that checks if the supplied include
 640 directory contains the required header files.
 641
 642 =item *
 643
 644 C<libcheck> - a code reference that checks if the supplied library
 645 directory contains the required library files.  Note: the
 646 F<Makefile.PL> version of this was supplied all of the library file
 647 names instead.  C<libcheck> can also be an arrayref of library check
 648 code references, all of which must find a match for the library to be
 649 considered "found".
 650
 651 =item *
 652
 653 C<libbase> - if C<inccheck> is supplied, but C<libcheck> isn't, then a
 654 C<libcheck> that checks for C<lib>I<libbase>I<$Config{_a}> and
 655 C<lib>I<libbase>.I<$Config{so}> is created.  If C<libopts> isn't
 656 supplied then that can be synthesized as C<< -lI<libbase>
 657 >>. C<libbase> can also be an arrayref of library base names to search
 658 for, in which case all of the libraries mentioned must be found for
 659 the probe to succeed.
 660
 661 =item *
 662
 663 C<libopts> - if the libraries are found via C<inccheck>/C<libcheck>,
 664 these are the C<-l> options to supply during the link phase.
 665
 666 =item *
 667
 668 C<code> - a code reference to perform custom checks.  Returns the
 669 probe result directly.  Can also be an array ref of functions to call.
 670
 671 =item *
 672
 673 C<testcode> - test C code that is run with Devel::CheckLib.  You also
 674 need to set C<testcodeheaders>.
 675
 676 =item *
 677
 678 C<testcodeprologue> - C code to insert between the headers and the
 679 main function.
 680
 681 =item *
 682
 683 C<incpath> - C<$Config{path_sep}> separated list of header file
 684 directories to check, or a reference to an array of such.
 685
 686 =item *
 687
 688 C<libpath> - C<$Config{path_sep}> separated list of library file
 689 directories to check, or a reference to an array of such.
 690
 691 =item *
 692
 693 C<alternatives> - an optional array reference of alternate
 694 configurations (as hash references) to test if the primary
 695 configuration isn't successful.  Each alternative should include an
 696 C<altname> key describing the alternative.  Any key not mentioned in
 697 an alternative defaults to the value from the main configuration.
 698
 699 =back
 700
 701 =head1 AUTHOR
 702
 703 Tony Cook <tonyc@cpan.org>, Arnar M. Hrafnkelsson
 704
 705 =cut