package FFI::CheckLib;
use strict;
use warnings;
use File::Spec;
use List::Util 1.33 qw( any );
use Carp qw( croak carp );
use Env qw( @FFI_CHECKLIB_PATH );
use base qw( Exporter );
our @EXPORT = qw(
find_lib
assert_lib
check_lib
check_lib_or_exit
find_lib_or_exit
find_lib_or_die
);
our @EXPORT_OK = qw(
which
where
has_symbols
);
# ABSTRACT: Check that a library is available for FFI
our $VERSION = '0.31'; # VERSION
our $system_path = [];
our $os ||= $^O;
my $try_ld_on_text = 0;
sub _homebrew_lib_path {
require File::Which;
return undef unless File::Which::which('brew');
chomp(my $brew_path = (qx`brew --prefix`)[0]);
return "$brew_path/lib";
}
sub _macports_lib_path {
require File::Which;
my $port_path = File::Which::which('port');
return undef unless $port_path;
$port_path =~ s|bin/port|lib|;
return $port_path;
}
sub _darwin_extra_paths {
my $pkg_managers = lc( $ENV{FFI_CHECKLIB_PACKAGE} || 'homebrew,macports' );
return () if $pkg_managers eq 'none';
my $supported_managers = {
homebrew => \&_homebrew_lib_path,
macports => \&_macports_lib_path
};
my @extra_paths = ();
foreach my $pkg_manager (split( /,/, $pkg_managers )) {
if (my $lib_path = $supported_managers->{$pkg_manager}()) {
push @extra_paths, $lib_path;
}
}
return @extra_paths;
}
my @extra_paths = ();
if($os eq 'MSWin32' || $os eq 'msys')
{
$system_path = eval {
require Env;
Env->import('@PATH');
\our @PATH;
};
die $@ if $@;
}
else
{
$system_path = eval {
require DynaLoader;
no warnings 'once';
\@DynaLoader::dl_library_path;
};
die $@ if $@;
@extra_paths = _darwin_extra_paths() if $os eq 'darwin';
}
our $pattern = [ qr{^lib(.*?)\.so(?:\.([0-9]+(?:\.[0-9]+)*))?$} ];
our $version_split = qr/\./;
if($os eq 'cygwin')
{
push @$pattern, qr{^cyg(.*?)(?:-([0-9])+)?\.dll$};
}
elsif($os eq 'msys')
{
# doesn't seem as though msys uses psudo libfoo.so files
# in the way that cygwin sometimes does. we can revisit
# this if we find otherwise.
$pattern = [ qr{^msys-(.*?)(?:-([0-9])+)?\.dll$} ];
}
elsif($os eq 'MSWin32')
{
# handle cases like libgeos-3-7-0___.dll, libproj_9_1.dll and libgtk-2.0-0.dll
$pattern = [ qr{^(?:lib)?(\w+?)(?:[_-]([0-9\-\._]+))?_*\.dll$}i ];
$version_split = qr/[_\-]/;
}
elsif($os eq 'darwin')
{
push @$pattern, qr{^lib(.*?)(?:\.([0-9]+(?:\.[0-9]+)*))?\.(?:dylib|bundle)$};
}
elsif($os eq 'linux')
{
if(-e '/etc/redhat-release' && -x '/usr/bin/ld')
{
$try_ld_on_text = 1;
}
}
sub _matches
{
my($filename, $path) = @_;
foreach my $regex (@$pattern)
{
return [
$1, # 0 capture group 1 library name
File::Spec->catfile($path, $filename), # 1 full path to library
defined $2 ? (split $version_split, $2) : (), # 2... capture group 2 library version
] if $filename =~ $regex;
}
return ();
}
sub _cmp
{
my($A,$B) = @_;
return $A->[0] cmp $B->[0] if $A->[0] ne $B->[0];
my $i=2;
while(1)
{
return 0 if !defined($A->[$i]) && !defined($B->[$i]);
return -1 if !defined $A->[$i];
return 1 if !defined $B->[$i];
return $B->[$i] <=> $A->[$i] if $A->[$i] != $B->[$i];
$i++;
}
}
my $diagnostic;
sub _is_binary
{
-B $_[0]
}
sub find_lib
{
my(%args) = @_;
undef $diagnostic;
croak "find_lib requires lib argument" unless defined $args{lib};
my $recursive = $args{_r} || $args{recursive} || 0;
# make arguments be lists.
foreach my $arg (qw( lib libpath symbol verify alien ))
{
next if ref $args{$arg} eq 'ARRAY';
if(defined $args{$arg})
{
$args{$arg} = [ $args{$arg} ];
}
else
{
$args{$arg} = [];
}
}
if(defined $args{systempath} && !ref($args{systempath}))
{
$args{systempath} = [ $args{systempath} ];
}
my @path = @{ $args{libpath} };
@path = map { _recurse($_) } @path if $recursive;
if(defined $args{systempath})
{
push @path, grep { defined } @{ $args{systempath} }
}
else
{
# This is a little convaluted, but:
# 1. These are modifications of what we consider the "system" path
# if systempath isn't explicitly passed in as systempath
# 2. FFI_CHECKLIB_PATH is considered an authortative modification
# so it goes first and overrides FFI_CHECKLIB_PACKAGE
# 3. otherwise FFI_CHECKLIB_PACKAGE does its thing and goes on
# the end because homebrew does a good job of not replacing
# anything in the system by default.
# 4. We finally add what we consider the "system" path to the end of
# the search path so that libpath will be searched first.
my @system_path = @$system_path;
if($ENV{FFI_CHECKLIB_PATH})
{
@system_path = (@FFI_CHECKLIB_PATH, @system_path);
}
else
{
foreach my $extra_path (@extra_paths)
{
push @path, $extra_path unless any { $_ eq $extra_path } @path;
}
}
push @path, @system_path;
}
my $any = any { $_ eq '*' } @{ $args{lib} };
my %missing = map { $_ => 1 } @{ $args{lib} };
my %symbols = map { $_ => 1 } @{ $args{symbol} };
my @found;
delete $missing{'*'};
alien: foreach my $alien (reverse @{ $args{alien} })
{
unless($alien =~ /^([A-Za-z_][A-Za-z_0-9]*)(::[A-Za-z_][A-Za-z_0-9]*)*$/)
{
croak "Doesn't appear to be a valid Alien name $alien";
}
unless(eval { $alien->can('dynamic_libs') })
{
{
my $pm = "$alien.pm";
$pm =~ s/::/\//g;
local $@ = '';
eval { require $pm };
next alien if $@;
}
unless(eval { $alien->can('dynamic_libs') })
{
croak "Alien $alien doesn't provide a dynamic_libs method";
}
}
unshift @path, [$alien->dynamic_libs];
}
foreach my $path (@path)
{
next if ref $path ne 'ARRAY' && ! -d $path;
my @maybe =
# make determinist based on names and versions
sort { _cmp($a,$b) }
# Filter out the items that do not match the name that we are looking for
# Filter out any broken symbolic links
grep { ($any || $missing{$_->[0]} ) && (-e $_->[1]) }
ref $path eq 'ARRAY'
? do {
map {
my($v, $d, $f) = File::Spec->splitpath($_);
_matches($f, File::Spec->catpath($v,$d,''));
} @$path;
}
: do {
my $dh;
opendir $dh, $path;
# get [ name, full_path ] mapping,
# each entry is a 2 element list ref
map { _matches($_,$path) } readdir $dh;
};
if($try_ld_on_text && $args{try_linker_script})
{
# This is tested in t/ci.t only
@maybe = map {
-B $_->[1] ? $_ : do {
my($name, $so) = @$_;
my $output = `/usr/bin/ld -t $so -o /dev/null -shared`;
$output =~ /\((.*?lib.*\.so.*?)\)/
? [$name, $1]
: die "unable to parse ld output";
}
} @maybe;
}
midloop:
foreach my $lib (@maybe)
{
next unless $any || $missing{$lib->[0]};
foreach my $verify (@{ $args{verify} })
{
next midloop unless $verify->(@$lib);
}
delete $missing{$lib->[0]};
if(%symbols)
{
require DynaLoader;
my $dll = DynaLoader::dl_load_file($lib->[1],0);
foreach my $symbol (keys %symbols)
{
if(DynaLoader::dl_find_symbol($dll, $symbol) ? 1 : 0)
{
delete $symbols{$symbol}
}
}
DynaLoader::dl_unload_file($dll);
}
my $found = $lib->[1];
unless($any)
{
while(-l $found)
{
require File::Basename;
my $dir = File::Basename::dirname($found);
$found = File::Spec->rel2abs( readlink($found), $dir );
}
}
push @found, $found;
}
}
if(%missing)
{
my @missing = sort keys %missing;
if(@missing > 1)
{ $diagnostic = "libraries not found: @missing" }
else
{ $diagnostic = "library not found: @missing" }
}
elsif(%symbols)
{
my @missing = sort keys %symbols;
if(@missing > 1)
{ $diagnostic = "symbols not found: @missing" }
else
{ $diagnostic = "symbol not found: @missing" }
}
return if %symbols;
return $found[0] unless wantarray;
return @found;
}
sub _recurse
{
my($dir) = @_;
return unless -d $dir;
my $dh;
opendir $dh, $dir;
my @list = grep { -d $_ } map { File::Spec->catdir($dir, $_) } grep !/^\.\.?$/, readdir $dh;
closedir $dh;
($dir, map { _recurse($_) } @list);
}
sub assert_lib
{
croak $diagnostic || 'library not found' unless check_lib(@_);
}
sub check_lib_or_exit
{
unless(check_lib(@_))
{
carp $diagnostic || 'library not found';
exit;
}
}
sub find_lib_or_exit
{
my(@libs) = find_lib(@_);
unless(@libs)
{
carp $diagnostic || 'library not found';
exit;
}
return unless @libs;
wantarray ? @libs : $libs[0];
}
sub find_lib_or_die
{
my(@libs) = find_lib(@_);
unless(@libs)
{
croak $diagnostic || 'library not found';
}
return unless @libs;
wantarray ? @libs : $libs[0];
}
sub check_lib
{
find_lib(@_) ? 1 : 0;
}
sub which
{
my($name) = @_;
croak("cannot which *") if $name eq '*';
scalar find_lib( lib => $name );
}
sub where
{
my($name) = @_;
$name eq '*'
? find_lib(lib => '*')
: find_lib(lib => '*', verify => sub { $_[0] eq $name });
}
sub has_symbols
{
my($path, @symbols) = @_;
require DynaLoader;
my $dll = DynaLoader::dl_load_file($path, 0);
my $ok = 1;
foreach my $symbol (@symbols)
{
unless(DynaLoader::dl_find_symbol($dll, $symbol))
{
$ok = 0;
last;
}
}
DynaLoader::dl_unload_file($dll);
$ok;
}
sub system_path
{
$system_path;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::CheckLib - Check that a library is available for FFI
=head1 VERSION
version 0.31
=head1 SYNOPSIS
use FFI::CheckLib;
check_lib_or_exit( lib => 'jpeg', symbol => 'jinit_memory_mgr' );
check_lib_or_exit( lib => [ 'iconv', 'jpeg' ] );
# or prompt for path to library and then:
print "where to find jpeg library: ";
my $path =