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.004";
   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      _dyn_inc_paths(),
 465     );
 466
 467   if ($req->{incsuffix}) {
 468     @paths = map File::Spec->catdir($_, $req->{incsuffix}), @paths;
 469   }
 470
 471   return @paths;
 472 }
 473
 474 sub _dyn_inc_paths {
 475   return map {
 476     my $tmp = $_;
 477     $tmp =~ s/\blib$/include/ ? $tmp : ()
 478   } _dyn_lib_paths();
 479 }
 480
 481 sub _paths {
 482   my (@in) = @_;
 483
 484   my @out;
 485
 486   # expand any array refs
 487   @in = map { ref() ? @$_ : $_ } @in;
 488
 489   for my $path (@in) {
 490     $path or next;
 491     $path = _tilde_expand($path);
 492
 493     push @out, grep -d $_, split /\Q$Config{path_sep}/, $path;
 494   }
 495
 496   @out = map Cwd::realpath($_), @out;
 497
 498   my %seen;
 499   @out = grep !$seen{$_}++, @out;
 500
 501   return @out;
 502 }
 503
 504 my $home;
 505 sub _tilde_expand {
 506   my ($path) = @_;
 507
 508   if ($path =~ m!^~[/\\]!) {
 509     defined $home or $home = $ENV{HOME};
 510     if (!defined $home && $^O eq 'MSWin32'
 511        && defined $ENV{HOMEDRIVE} && defined $ENV{HOMEPATH}) {
 512       $home = $ENV{HOMEDRIVE} . $ENV{HOMEPATH};
 513     }
 514     unless (defined $home) {
 515       $home = eval { (getpwuid($<))[7] };
 516     }
 517     defined $home or die "You supplied $path, but I can't find your home directory\n";
 518     $path =~ s/^~//;
 519     $path = File::Spec->catdir($home, $path);
 520   }
 521
 522   return $path;
 523 }
 524
 525 1;
 526
 527 __END__
 528
 529 =head1 NAME
 530
 531 Imager::Probe - hot needle of inquiry for libraries
 532
 533 =head1 SYNOPSIS
 534
 535   require Imager::Probe;
 536
 537   my %probe =
 538     (
 539      # short name of what we're looking for (displayed to user)
 540      name => "FOO",
 541      # pkg-config lookup
 542      pkg => [ qw/name1 name2 name3/ ],
 543      # perl subs that probe for the library
 544      code => [ \&foo_probe1, \&foo_probe2 ],
 545      # or just: code => \&foo_probe,
 546      inccheck => sub { ... },
 547      libcheck => sub { ... },
 548      # search for this library if libcheck not supplied
 549      libbase => "foo",
 550      # library link time options, uses libbase to build options otherwise
 551      libopts => "-lfoo",
 552      # C code to check the library is sane
 553      testcode => "...",
 554      # header files needed
 555      testcodeheaders => [ "stdio.h", "foo.h" ],
 556     );
 557   my $result = Imager::Probe->probe(\%probe)
 558     or print "Foo library not found: ",Imager::Probe->error;
 559
 560 =head1 DESCRIPTION
 561
 562 Does the probes that were hidden in Imager's F<Makefile.PL>, pulled
 563 out so the file format libraries can be externalized.
 564
 565 The return value is either nothing if the probe fails, or a hash
 566 containing:
 567
 568 =over
 569
 570 =item *
 571
 572 C<INC> - C<-I> and other C options
 573
 574 =item *
 575
 576 C<LIBS> - C<-L>, C<-l> and other link-time options
 577
 578 =item *
 579
 580 C<DEFINE> - C<-D> options, if any.
 581
 582 =back
 583
 584 The possible values for the hash supplied to the probe() method are:
 585
 586 =over
 587
 588 =item *
 589
 590 C<pkg> - an array of F<pkg-config> names to probe for.  If the
 591 F<pkg-config> checks pass, C<inccheck> and C<libcheck> aren't used.
 592
 593 =item *
 594
 595 C<inccheck> - a code reference that checks if the supplied include
 596 directory contains the required header files.
 597
 598 =item *
 599
 600 C<libcheck> - a code reference that checks if the supplied library
 601 directory contains the required library files.  Note: the
 602 F<Makefile.PL> version of this was supplied all of the library file
 603 names instead.  C<libcheck> can also be an arrayref of library check
 604 code references, all of which must find a match for the library to be
 605 considered "found".
 606
 607 =item *
 608
 609 C<libbase> - if C<inccheck> is supplied, but C<libcheck> isn't, then a
 610 C<libcheck> that checks for C<lib>I<libbase>I<$Config{_a}> and
 611 C<lib>I<libbase>.I<$Config{so}> is created.  If C<libopts> isn't
 612 supplied then that can be synthesized as C<< -lI<libbase>
 613 >>. C<libbase> can also be an arrayref of library base names to search
 614 for, in which case all of the libraries mentioned must be found for
 615 the probe to succeed.
 616
 617 =item *
 618
 619 C<libopts> - if the libraries are found via C<inccheck>/C<libcheck>,
 620 these are the C<-l> options to supply during the link phase.
 621
 622 =item *
 623
 624 C<code> - a code reference to perform custom checks.  Returns the
 625 probe result directly.  Can also be an array ref of functions to call.
 626
 627 =item *
 628
 629 C<testcode> - test C code that is run with Devel::CheckLib.  You also
 630 need to set C<testcodeheaders>.
 631
 632 =item *
 633
 634 C<testcodeprologue> - C code to insert between the headers and the
 635 main function.
 636
 637 =item *
 638
 639 C<incpath> - C<$Config{path_sep}> separated list of header file
 640 directories to check, or a reference to an array of such.
 641
 642 =item *
 643
 644 C<libpath> - C<$Config{path_sep}> separated list of library file
 645 directories to check, or a reference to an array of such.
 646
 647 =item *
 648
 649 C<alternatives> - an optional array reference of alternate
 650 configurations (as hash references) to test if the primary
 651 configuration isn't successful.  Each alternative should include an
 652 C<altname> key describing the alternative.  Any key not mentioned in
 653 an alternative defaults to the value from the main configuration.
 654
 655 =back
 656
 657 =head1 AUTHOR
 658
 659 Tony Cook <tonyc@cpan.org>, Arnar M. Hrafnkelsson
 660
 661 =cut