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.003";
   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   return _paths
 389     (
 390      $ENV{IM_LIBPATH},
 391      $req->{libpath},
 392      (
 393       map { split ' ' }
 394       grep $_,
 395       @Config{qw/loclibpth libpth libspath/}
 396      ),
 397      $^O eq "MSWin32" ? $ENV{LIB} : "",
 398      $^O eq "cygwin" ? "/usr/lib/w32api" : "",
 399      "/usr/lib",
 400      "/usr/local/lib",
 401      _gcc_lib_paths(),
 402      _dyn_lib_paths(),
 403     );
 404 }
 405
 406 sub _gcc_lib_paths {
 407   $Config{gccversion}
 408     or return;
 409
 410   my ($base_version) = $Config{gccversion} =~ /^([0-9]+)/
 411     or return;
 412
 413   $base_version >= 4
 414     or return;
 415
 416   local $ENV{LANG} = "C";
 417   local $ENV{LC_ALL} = "C";
 418   my ($lib_line) = grep /^libraries:/, `$Config{cc} -print-search-dirs`
 419     or return;
 420   $lib_line =~ s/^libraries: =//;
 421   chomp $lib_line;
 422
 423   return grep !/gcc/ && -d, split /:/, $lib_line;
 424 }
 425
 426 sub _dyn_lib_paths {
 427   return map { defined() ? split /\Q$Config{path_sep}/ : () }
 428     map $ENV{$_},
 429       qw(LD_RUN_PATH LD_LIBRARY_PATH DYLD_LIBRARY_PATH LIBRARY_PATH);
 430 }
 431
 432 sub _inc_paths {
 433   my ($req) = @_;
 434
 435   my @paths = _paths
 436     (
 437      $ENV{IM_INCPATH},
 438      $req->{incpath},
 439      $^O eq "MSWin32" ? $ENV{INCLUDE} : "",
 440      $^O eq "cygwin" ? "/usr/include/w32api" : "",
 441      (
 442       map { split ' ' }
 443       grep $_,
 444       @Config{qw/locincpth incpath/}
 445      ),
 446      "/usr/include",
 447      "/usr/local/include",
 448      _dyn_inc_paths(),
 449     );
 450
 451   if ($req->{incsuffix}) {
 452     @paths = map File::Spec->catdir($_, $req->{incsuffix}), @paths;
 453   }
 454
 455   return @paths;
 456 }
 457
 458 sub _dyn_inc_paths {
 459   return map {
 460     my $tmp = $_;
 461     $tmp =~ s/\blib$/include/ ? $tmp : ()
 462   } _dyn_lib_paths();
 463 }
 464
 465 sub _paths {
 466   my (@in) = @_;
 467
 468   my @out;
 469
 470   # expand any array refs
 471   @in = map { ref() ? @$_ : $_ } @in;
 472
 473   for my $path (@in) {
 474     $path or next;
 475     $path = _tilde_expand($path);
 476
 477     push @out, grep -d $_, split /\Q$Config{path_sep}/, $path;
 478   }
 479
 480   @out = map Cwd::realpath($_), @out;
 481
 482   my %seen;
 483   @out = grep !$seen{$_}++, @out;
 484
 485   return @out;
 486 }
 487
 488 my $home;
 489 sub _tilde_expand {
 490   my ($path) = @_;
 491
 492   if ($path =~ m!^~[/\\]!) {
 493     defined $home or $home = $ENV{HOME};
 494     if (!defined $home && $^O eq 'MSWin32'
 495        && defined $ENV{HOMEDRIVE} && defined $ENV{HOMEPATH}) {
 496       $home = $ENV{HOMEDRIVE} . $ENV{HOMEPATH};
 497     }
 498     unless (defined $home) {
 499       $home = eval { (getpwuid($<))[7] };
 500     }
 501     defined $home or die "You supplied $path, but I can't find your home directory\n";
 502     $path =~ s/^~//;
 503     $path = File::Spec->catdir($home, $path);
 504   }
 505
 506   return $path;
 507 }
 508
 509 1;
 510
 511 __END__
 512
 513 =head1 NAME
 514
 515 Imager::Probe - hot needle of inquiry for libraries
 516
 517 =head1 SYNOPSIS
 518
 519   require Imager::Probe;
 520
 521   my %probe =
 522     (
 523      # short name of what we're looking for (displayed to user)
 524      name => "FOO",
 525      # pkg-config lookup
 526      pkg => [ qw/name1 name2 name3/ ],
 527      # perl subs that probe for the library
 528      code => [ \&foo_probe1, \&foo_probe2 ],
 529      # or just: code => \&foo_probe,
 530      inccheck => sub { ... },
 531      libcheck => sub { ... },
 532      # search for this library if libcheck not supplied
 533      libbase => "foo",
 534      # library link time options, uses libbase to build options otherwise
 535      libopts => "-lfoo",
 536      # C code to check the library is sane
 537      testcode => "...",
 538      # header files needed
 539      testcodeheaders => [ "stdio.h", "foo.h" ],
 540     );
 541   my $result = Imager::Probe->probe(\%probe)
 542     or print "Foo library not found: ",Imager::Probe->error;
 543
 544 =head1 DESCRIPTION
 545
 546 Does the probes that were hidden in Imager's F<Makefile.PL>, pulled
 547 out so the file format libraries can be externalized.
 548
 549 The return value is either nothing if the probe fails, or a hash
 550 containing:
 551
 552 =over
 553
 554 =item *
 555
 556 C<INC> - C<-I> and other C options
 557
 558 =item *
 559
 560 C<LIBS> - C<-L>, C<-l> and other link-time options
 561
 562 =item *
 563
 564 C<DEFINE> - C<-D> options, if any.
 565
 566 =back
 567
 568 The possible values for the hash supplied to the probe() method are:
 569
 570 =over
 571
 572 =item *
 573
 574 C<pkg> - an array of F<pkg-config> names to probe for.  If the
 575 F<pkg-config> checks pass, C<inccheck> and C<libcheck> aren't used.
 576
 577 =item *
 578
 579 C<inccheck> - a code reference that checks if the supplied include
 580 directory contains the required header files.
 581
 582 =item *
 583
 584 C<libcheck> - a code reference that checks if the supplied library
 585 directory contains the required library files.  Note: the
 586 F<Makefile.PL> version of this was supplied all of the library file
 587 names instead.  C<libcheck> can also be an arrayref of library check
 588 code references, all of which must find a match for the library to be
 589 considered "found".
 590
 591 =item *
 592
 593 C<libbase> - if C<inccheck> is supplied, but C<libcheck> isn't, then a
 594 C<libcheck> that checks for C<lib>I<libbase>I<$Config{_a}> and
 595 C<lib>I<libbase>.I<$Config{so}> is created.  If C<libopts> isn't
 596 supplied then that can be synthesized as C<< -lI<libbase>
 597 >>. C<libbase> can also be an arrayref of library base names to search
 598 for, in which case all of the libraries mentioned must be found for
 599 the probe to succeed.
 600
 601 =item *
 602
 603 C<libopts> - if the libraries are found via C<inccheck>/C<libcheck>,
 604 these are the C<-l> options to supply during the link phase.
 605
 606 =item *
 607
 608 C<code> - a code reference to perform custom checks.  Returns the
 609 probe result directly.  Can also be an array ref of functions to call.
 610
 611 =item *
 612
 613 C<testcode> - test C code that is run with Devel::CheckLib.  You also
 614 need to set C<testcodeheaders>.
 615
 616 =item *
 617
 618 C<testcodeprologue> - C code to insert between the headers and the
 619 main function.
 620
 621 =item *
 622
 623 C<incpath> - C<$Config{path_sep}> separated list of header file
 624 directories to check, or a reference to an array of such.
 625
 626 =item *
 627
 628 C<libpath> - C<$Config{path_sep}> separated list of library file
 629 directories to check, or a reference to an array of such.
 630
 631 =item *
 632
 633 C<alternatives> - an optional array reference of alternate
 634 configurations (as hash references) to test if the primary
 635 configuration isn't successful.  Each alternative should include an
 636 C<altname> key describing the alternative.  Any key not mentioned in
 637 an alternative defaults to the value from the main configuration.
 638
 639 =back
 640
 641 =head1 AUTHOR
 642
 643 Tony Cook <tonyc@cpan.org>, Arnar M. Hrafnkelsson
 644
 645 =cut