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.006";
   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     my @libs = $req->{libbase}
 304       ? ( ref $req->{libbase} ? @{$req->{libbase}} : $req->{libbase} )
 305       : ();
 306     $lopts = join " ", map _lib_option($_), @libs;
 307   }
 308   if (defined $lopts) {
 309     print "$req->{name}: Checking if the compiler can find them on its own\n";
 310     return
 311       {
 312        INC => "",
 313        LIBS => $lopts,
 314        DEFINE => "",
 315       };
 316   }
 317   else {
 318     print "$req->{name}: Can't fake it - no libbase or libopts\n"
 319       if $req->{verbose};
 320     return;
 321   }
 322 }
 323
 324 sub _probe_test {
 325   my ($req, $result) = @_;
 326
 327   require Devel::CheckLib;
 328   # setup LD_RUN_PATH to match link time
 329   print "Asking liblist for LD_RUN_PATH:\n" if $req->{verbose};
 330   my ($extra, $bs_load, $ld_load, $ld_run_path) =
 331     ExtUtils::Liblist->ext($result->{LIBS}, $req->{verbose});
 332   local $ENV{LD_RUN_PATH};
 333
 334   if ($ld_run_path) {
 335     print "Setting LD_RUN_PATH=$ld_run_path for $req->{name} probe\n"
 336       if $req->{verbose};
 337     $ENV{LD_RUN_PATH} = $ld_run_path;
 338     if ($Config{lddlflags} =~ /([^ ]*-(?:rpath|R)[,=]?)([^ ]+)/
 339         && -d $2) {
 340       # hackety, hackety
 341       # LD_RUN_PATH is ignored when there's already an -rpath option
 342       # so provide one
 343       my $prefix = $1;
 344       $result->{LDDLFLAGS} = $Config{lddlflags} . " " .
 345         join " ", map "$prefix$_", split $Config{path_sep}, $ld_run_path;
 346     }
 347   }
 348   my $good =
 349     Devel::CheckLib::check_lib
 350         (
 351          debug => $req->{verbose},
 352          LIBS => [ $result->{LIBS} ],
 353          INC => $result->{INC},
 354          header => $req->{testcodeheaders},
 355          function => $req->{testcode},
 356          prologue => $req->{testcodeprologue},
 357         );
 358   unless ($good) {
 359     print "$req->{name}: Test code failed: $@";
 360     return;
 361   }
 362
 363   print "$req->{name}: Passed code check\n";
 364   return $result;
 365 }
 366
 367 sub _resolve_libs {
 368   my ($req, $lflags) = @_;
 369
 370   my @libs = grep /^-l/, split ' ', $lflags;
 371   my %paths;
 372   my @paths = _lib_paths($req);
 373   my $so = $Config{so};
 374   my $libext = $Config{_a};
 375   for my $lib (@libs) {
 376     $lib =~ s/^-l/lib/;
 377
 378     for my $path (@paths) {
 379       if (-e "$path/$lib.$so" || -e "$path/$lib$libext") {
 380         $paths{$path} = 1;
 381       }
 382     }
 383   }
 384
 385   return join(" ", ( map "-L$_", keys %paths ), $lflags );
 386 }
 387
 388 sub _lib_paths {
 389   my ($req) = @_;
 390
 391   print "$req->{name} IM_LIBPATH: $ENV{IM_LIBPATH}\n"
 392     if $req->{verbose} && defined $ENV{IM_LIBPATH};
 393   print "$req->{name} LIB: $ENV{IM_LIBPATH}\n"
 394     if $req->{verbose} && defined $ENV{LIB} && $^O eq "MSWin32";
 395   my $lp = $req->{libpath};
 396   print "$req->{name} libpath: ", ref $lp ? join($Config{path_sep}, @$lp) : $lp, "\n"
 397     if $req->{verbose} && defined $lp;
 398
 399   return _paths
 400     (
 401      $ENV{IM_LIBPATH},
 402      $req->{libpath},
 403      (
 404       map { split ' ' }
 405       grep $_,
 406       @Config{qw/loclibpth libpth libspath/}
 407      ),
 408      $^O eq "MSWin32" ? $ENV{LIB} : "",
 409      $^O eq "cygwin" ? "/usr/lib/w32api" : "",
 410      "/usr/lib",
 411      "/usr/local/lib",
 412      _gcc_lib_paths(),
 413      _dyn_lib_paths(),
 414     );
 415 }
 416
 417 sub _gcc_lib_paths {
 418   $Config{gccversion}
 419     or return;
 420
 421   my ($base_version) = $Config{gccversion} =~ /^([0-9]+)/
 422     or return;
 423
 424   $base_version >= 4
 425     or return;
 426
 427   local $ENV{LANG} = "C";
 428   local $ENV{LC_ALL} = "C";
 429   my ($lib_line) = grep /^libraries:/, `$Config{cc} -print-search-dirs`
 430     or return;
 431   $lib_line =~ s/^libraries: =//;
 432   chomp $lib_line;
 433
 434   return grep !/gcc/ && -d, split /:/, $lib_line;
 435 }
 436
 437 sub _dyn_lib_paths {
 438   return map { defined() ? split /\Q$Config{path_sep}/ : () }
 439     map $ENV{$_},
 440       qw(LD_RUN_PATH LD_LIBRARY_PATH DYLD_LIBRARY_PATH LIBRARY_PATH);
 441 }
 442
 443 sub _inc_paths {
 444   my ($req) = @_;
 445
 446   print "$req->{name} IM_INCPATH: $ENV{IM_INCPATH}\n"
 447     if $req->{verbose} && defined $ENV{IM_INCPATH};
 448   print "$req->{name} INCLUDE: $ENV{INCLUDE}\n"
 449     if $req->{verbose} && defined $ENV{INCLUDE} && $^O eq "MSWin32";
 450   my $ip = $req->{incpath};
 451   print "$req->{name} incpath: ", ref $ip ? join($Config{path_sep}, @$ip) : $ip, "\n"
 452     if $req->{verbose} && defined $req->{incpath};
 453
 454   my @paths = _paths
 455     (
 456      $ENV{IM_INCPATH},
 457      $req->{incpath},
 458      $^O eq "MSWin32" ? $ENV{INCLUDE} : "",
 459      $^O eq "cygwin" ? "/usr/include/w32api" : "",
 460      (
 461       map { split ' ' }
 462       grep $_,
 463       @Config{qw/locincpth incpath/}
 464      ),
 465      "/usr/include",
 466      "/usr/local/include",
 467      _gcc_inc_paths(),
 468      _dyn_inc_paths(),
 469     );
 470
 471   if ($req->{incsuffix}) {
 472     @paths = map File::Spec->catdir($_, $req->{incsuffix}), @paths;
 473   }
 474
 475   return @paths;
 476 }
 477
 478 sub _gcc_inc_paths {
 479   $Config{gccversion}
 480     or return;
 481
 482   my ($base_version) = $Config{gccversion} =~ /^([0-9]+)/
 483     or return;
 484
 485   $base_version >= 4
 486     or return;
 487
 488   local $ENV{LANG} = "C";
 489   local $ENV{LC_ALL} = "C";
 490   my $devnull = File::Spec->devnull;
 491   my @spam = `$Config{cc} -E -v - <$devnull 2>&1`;
 492   # output includes lines like:
 493   # ...
 494   # ignoring nonexistent directory "/usr/lib/gcc/x86_64-linux-gnu/4.9/../../../../x86_64-linux-gnu/include"
 495   # #include "..." search starts here:
 496   # #include <...> search starts here:
 497   #  /usr/lib/gcc/x86_64-linux-gnu/4.9/include
 498   #  /usr/local/include
 499   #  /usr/lib/gcc/x86_64-linux-gnu/4.9/include-fixed
 500   #  /usr/include/x86_64-linux-gnu
 501   #  /usr/include
 502   # End of search list.
 503   # # 1 "<stdin>"
 504   # # 1 "<built-in>"
 505   # ...
 506
 507   while (@spam && $spam[0] !~ /^#include /) {
 508     shift @spam;
 509   }
 510   my @inc;
 511   while (@spam && $spam[0] !~ /^End of search/) {
 512     my $line = shift @spam;
 513     chomp $line;
 514     next if $line =~ /^#include /;
 515     next unless $line =~ s/^\s+//;
 516     push @inc, $line;
 517   }
 518   return @inc;
 519 }
 520
 521 sub _dyn_inc_paths {
 522   return map {
 523     my $tmp = $_;
 524     $tmp =~ s/\blib$/include/ ? $tmp : ()
 525   } _dyn_lib_paths();
 526 }
 527
 528 sub _paths {
 529   my (@in) = @_;
 530
 531   my @out;
 532
 533   # expand any array refs
 534   @in = map { ref() ? @$_ : $_ } @in;
 535
 536   for my $path (@in) {
 537     $path or next;
 538     $path = _tilde_expand($path);
 539
 540     push @out, grep -d $_, split /\Q$Config{path_sep}/, $path;
 541   }
 542
 543   @out = map Cwd::realpath($_), @out;
 544
 545   my %seen;
 546   @out = grep !$seen{$_}++, @out;
 547
 548   return @out;
 549 }
 550
 551 my $home;
 552 sub _tilde_expand {
 553   my ($path) = @_;
 554
 555   if ($path =~ m!^~[/\\]!) {
 556     defined $home or $home = $ENV{HOME};
 557     if (!defined $home && $^O eq 'MSWin32'
 558        && defined $ENV{HOMEDRIVE} && defined $ENV{HOMEPATH}) {
 559       $home = $ENV{HOMEDRIVE} . $ENV{HOMEPATH};
 560     }
 561     unless (defined $home) {
 562       $home = eval { (getpwuid($<))[7] };
 563     }
 564     defined $home or die "You supplied $path, but I can't find your home directory\n";
 565     $path =~ s/^~//;
 566     $path = File::Spec->catdir($home, $path);
 567   }
 568
 569   return $path;
 570 }
 571
 572 1;
 573
 574 __END__
 575
 576 =head1 NAME
 577
 578 Imager::Probe - hot needle of inquiry for libraries
 579
 580 =head1 SYNOPSIS
 581
 582   require Imager::Probe;
 583
 584   my %probe =
 585     (
 586      # short name of what we're looking for (displayed to user)
 587      name => "FOO",
 588      # pkg-config lookup
 589      pkg => [ qw/name1 name2 name3/ ],
 590      # perl subs that probe for the library
 591      code => [ \&foo_probe1, \&foo_probe2 ],
 592      # or just: code => \&foo_probe,
 593      inccheck => sub { ... },
 594      libcheck => sub { ... },
 595      # search for this library if libcheck not supplied
 596      libbase => "foo",
 597      # library link time options, uses libbase to build options otherwise
 598      libopts => "-lfoo",
 599      # C code to check the library is sane
 600      testcode => "...",
 601      # header files needed
 602      testcodeheaders => [ "stdio.h", "foo.h" ],
 603     );
 604   my $result = Imager::Probe->probe(\%probe)
 605     or print "Foo library not found: ",Imager::Probe->error;
 606
 607 =head1 DESCRIPTION
 608
 609 Does the probes that were hidden in Imager's F<Makefile.PL>, pulled
 610 out so the file format libraries can be externalized.
 611
 612 The return value is either nothing if the probe fails, or a hash
 613 containing:
 614
 615 =over
 616
 617 =item *
 618
 619 C<INC> - C<-I> and other C options
 620
 621 =item *
 622
 623 C<LIBS> - C<-L>, C<-l> and other link-time options
 624
 625 =item *
 626
 627 C<DEFINE> - C<-D> options, if any.
 628
 629 =back
 630
 631 The possible values for the hash supplied to the probe() method are:
 632
 633 =over
 634
 635 =item *
 636
 637 C<pkg> - an array of F<pkg-config> names to probe for.  If the
 638 F<pkg-config> checks pass, C<inccheck> and C<libcheck> aren't used.
 639
 640 =item *
 641
 642 C<inccheck> - a code reference that checks if the supplied include
 643 directory contains the required header files.
 644
 645 =item *
 646
 647 C<libcheck> - a code reference that checks if the supplied library
 648 directory contains the required library files.  Note: the
 649 F<Makefile.PL> version of this was supplied all of the library file
 650 names instead.  C<libcheck> can also be an arrayref of library check
 651 code references, all of which must find a match for the library to be
 652 considered "found".
 653
 654 =item *
 655
 656 C<libbase> - if C<inccheck> is supplied, but C<libcheck> isn't, then a
 657 C<libcheck> that checks for C<lib>I<libbase>I<$Config{_a}> and
 658 C<lib>I<libbase>.I<$Config{so}> is created.  If C<libopts> isn't
 659 supplied then that can be synthesized as C<< -lI<libbase>
 660 >>. C<libbase> can also be an arrayref of library base names to search
 661 for, in which case all of the libraries mentioned must be found for
 662 the probe to succeed.
 663
 664 =item *
 665
 666 C<libopts> - if the libraries are found via C<inccheck>/C<libcheck>,
 667 these are the C<-l> options to supply during the link phase.
 668
 669 =item *
 670
 671 C<code> - a code reference to perform custom checks.  Returns the
 672 probe result directly.  Can also be an array ref of functions to call.
 673
 674 =item *
 675
 676 C<testcode> - test C code that is run with Devel::CheckLib.  You also
 677 need to set C<testcodeheaders>.
 678
 679 =item *
 680
 681 C<testcodeprologue> - C code to insert between the headers and the
 682 main function.
 683
 684 =item *
 685
 686 C<incpath> - C<$Config{path_sep}> separated list of header file
 687 directories to check, or a reference to an array of such.
 688
 689 =item *
 690
 691 C<libpath> - C<$Config{path_sep}> separated list of library file
 692 directories to check, or a reference to an array of such.
 693
 694 =item *
 695
 696 C<alternatives> - an optional array reference of alternate
 697 configurations (as hash references) to test if the primary
 698 configuration isn't successful.  Each alternative should include an
 699 C<altname> key describing the alternative.  Any key not mentioned in
 700 an alternative defaults to the value from the main configuration.
 701
 702 =back
 703
 704 =head1 AUTHOR
 705
 706 Tony Cook <tonyc@cpan.org>, Arnar M. Hrafnkelsson
 707
 708 =cut