package Alien::Base;
use strict;
use warnings;
use 5.008004;
use Carp;
use Path::Tiny ();
use Scalar::Util qw/blessed/;
use Capture::Tiny 0.17 qw/capture_stdout/;
use Text::ParseWords qw/shellwords/;
use Alien::Util;
# ABSTRACT: Base classes for Alien:: modules
our $VERSION = '2.84'; # VERSION
sub import {
my $class = shift;
return if $class eq __PACKAGE__;
return if $class->runtime_prop;
return if $class->install_type('system');
require DynaLoader;
# Sanity check in order to ensure that dist_dir can be found.
# This will throw an exception otherwise.
$class->dist_dir;
# get a reference to %Alien::MyLibrary::AlienLoaded
# which contains names of already loaded libraries
# this logic may be replaced by investigating the DynaLoader arrays
my $loaded = do {
no strict 'refs';
no warnings 'once';
\%{ $class . "::AlienLoaded" };
};
my @libs = $class->split_flags( $class->libs );
my @L = grep { s/^-L// } map { "$_" } @libs; ## no critic (ControlStructures::ProhibitMutatingListFunctions)
my @l = grep { /^-l/ } @libs;
unshift @DynaLoader::dl_library_path, @L;
my @libpaths;
foreach my $l (@l) {
next if $loaded->{$l};
my $path = DynaLoader::dl_findfile( $l );
unless ($path) {
carp "Could not resolve $l";
next;
}
push @libpaths, $path;
$loaded->{$l} = $path;
}
push @DynaLoader::dl_resolve_using, @libpaths;
my @librefs = map { DynaLoader::dl_load_file( $_, 0x01 ) } grep !/\.(a|lib)$/, @libpaths;
push @DynaLoader::dl_librefs, @librefs;
}
sub _dist_dir ($)
{
my($dist_name) = @_;
my @pm = split /-/, $dist_name;
$pm[-1] .= ".pm";
foreach my $inc (@INC)
{
my $pm = Path::Tiny->new($inc, @pm);
if(-f $pm)
{
my $share = Path::Tiny->new($inc, qw( auto share dist ), $dist_name );
if(-d $share)
{
return $share->absolute->stringify;
}
last;
}
}
Carp::croak("unable to find dist share directory for $dist_name");
}
sub dist_dir {
my $class = shift;
my $dist = blessed $class || $class;
$dist =~ s/::/-/g;
my $dist_dir =
$class->config('finished_installing')
? _dist_dir $dist
: $class->config('working_directory');
croak "Failed to find share dir for dist '$dist'"
unless defined $dist_dir && -d $dist_dir;
return $dist_dir;
}
sub new { return bless {}, $_[0] }
sub _flags
{
my($class, $key) = @_;
my $config = $class->runtime_prop;
my $flags = $config->{$key};
my $prefix = $config->{prefix};
$prefix =~ s{\\}{/}g if $^O =~ /^(MSWin32|msys)$/;
my $distdir = $config->{distdir};
$distdir =~ s{\\}{/}g if $^O =~ /^(MSWin32|msys)$/;
if(defined $flags && $prefix ne $distdir)
{
$flags = join ' ', map {
my $flag = $_;
$flag =~ s/^(-I|-L|-LIBPATH:)?\Q$prefix\E/$1$distdir/;
$flag =~ s/(\s)/\\$1/g;
$flag;
} $class->split_flags($flags);
}
$flags;
}
sub cflags {
my $class = shift;
return $class->runtime_prop ? $class->_flags('cflags') : $class->_pkgconfig_keyword('Cflags');
}
sub cflags_static {
my $class = shift;
return $class->runtime_prop ? $class->_flags('cflags_static') : $class->_pkgconfig_keyword('Cflags', 'static');
}
sub libs {
my $class = shift;
return $class->runtime_prop ? $class->_flags('libs') : $class->_pkgconfig_keyword('Libs');
}
sub libs_static {
my $class = shift;
return $class->runtime_prop ? $class->_flags('libs_static') : $class->_pkgconfig_keyword('Libs', 'static');
}
sub version {
my $self = shift;
return $self->runtime_prop
? $self->runtime_prop->{version}
: do {
my $version = $self->config('version');
chomp $version;
$version;
};
}
sub atleast_version {
my $self = shift;
my ($wantver) = @_;
defined(my $version = $self->version) or
croak "$self has no defined ->version";
return $self->version_cmp($version, $wantver) >= 0;
}
sub exact_version {
my $self = shift;
my ($wantver) = @_;
defined(my $version = $self->version) or
croak "$self has no defined ->version";
return $self->version_cmp($version, $wantver) == 0;
}
sub max_version {
my $self = shift;
my ($wantver) = @_;
defined(my $version = $self->version) or
croak "$self has no defined ->version";
return $self->version_cmp($version, $wantver) <= 0;
}
sub version_cmp {
shift;
goto &Alien::Util::version_cmp;
}
sub install_type {
my $self = shift;
my $type = $self->config('install_type');
return @_ ? $type eq $_[0] : $type;
}
sub is_system_install
{
my($self) = @_;
$self->install_type('system');
}
sub is_share_install
{
my($self) = @_;
$self->install_type('share');
}
sub _pkgconfig_keyword {
my $self = shift;
my $keyword = shift;
my $static = shift;
# use pkg-config if installed system-wide
if ($self->install_type('system')) {
my $name = $self->config('name');
require Alien::Base::PkgConfig;
my $command = Alien::Base::PkgConfig->pkg_config_command . " @{[ $static ? '--static' : '' ]} --\L$keyword\E $name";
$! = 0;
chomp ( my $pcdata = capture_stdout { system( $command ) } );
# if pkg-config fails for whatever reason, then we try to
# fallback on alien_provides_*
$pcdata = '' if $! || $?;
$pcdata =~ s/\s*$//;
if($self->config('system_provides')) {
if(my $system_provides = $self->config('system_provides')->{$keyword}) {
$pcdata = length $pcdata ? "$pcdata $system_provides" : $system_provides;
}
}
return $pcdata;
}
# use parsed info from build .pc file
my $dist_dir = $self->dist_dir;
my @pc = $self->_pkgconfig(@_);
my @strings =
grep defined,
map { $_->keyword($keyword,
#{ pcfiledir => $dist_dir }
) }
@pc;
if(defined $self->config('original_prefix') && $self->config('original_prefix') ne $self->dist_dir)
{
my $dist_dir = $self->dist_dir;
$dist_dir =~ s{\\}{/}g if $^O eq 'MSWin32';
my $old = quotemeta $self->config('original_prefix');
@strings = map {
my $flag = $_;
$flag =~ s{^(-I|-L|-LIBPATH:)?($old)}{$1.$dist_dir}e;
$flag =~ s/(\s)/\\$1/g;
$flag;
} map { $self->split_flags($_) } @strings;
}
return join( ' ', @strings );
}
sub _pkgconfig {
my $self = shift;
my %all = %{ $self->config('pkgconfig') };
# merge in found pc files
require File::Find;
my $wanted = sub {
return if ( -d or not /\.pc$/ );
require Alien::Base::PkgConfig;
my $pkg = Alien::Base::PkgConfig->new($_);
$all{$pkg->{package}} = $pkg;
};
File::Find::find( $wanted, $self->dist_dir );
croak "No Alien::Base::PkgConfig objects are stored!"
unless keys %all;
# Run through all pkgconfig objects and ensure that their modules are loaded:
for my $pkg_obj (values %all) {
my $perl_module_name = blessed $pkg_obj;
my $pm = "$perl_module_name.pm";
$pm =~ s/::/\//g;
eval { require $pm };
}
return @all{@_} if @_;
my $manual = delete $all{_manual};
if (keys %all) {
return values %all;
} else {
return $manual;
}
}
# helper method to call Alien::MyLib::ConfigData->config(@_)
sub config {
my $class = shift;
$class = blessed $class || $class;
if(my $ab_config = $class->runtime_prop)
{
my $key = shift;
return $ab_config->{legacy}->{$key};
}
my $config = $class . '::ConfigData';
my $pm = "$class/ConfigData.pm";
$pm =~ s{::}{/}g;
eval { require $pm };
if($@)
{
warn "Cannot find either a share directory or a ConfigData module for $class.\n";
my $pm = "$class.pm";
$pm =~ s{::}{/}g;
warn "($class loaded from $INC{$pm})\n" if $INC{$pm};
warn "Please see https://metacpan.org/pod/distribution/Alien-Build/lib/Alien/Build/Manual/FAQ.pod#Cannot-find-either-a-share-directory-or-a-ConfigData-module\n";
die $@;
}
return $config->config(@_);
}
# helper method to split flags based on the OS
sub split_flags {
my ($class, $line) = @_;
if( $^O eq 'MSWin32' ) {
$class->split_flags_windows($line);
} else {
# $os eq 'Unix'
$class->split_flags_unix($line);
}
}
sub split_flags_unix {
my ($class, $line) = @_;
shellwords($line);
}
sub split_flags_windows {
# NOTE a better approach would be to write a function that understands cmd.exe metacharacters.
my ($class, $line) = @_;
# Double the backslashes so that when they are unescaped by shellwords(),
# they become a single backslash. This should be fine on Windows since
# backslashes are not used to escape metacharacters in cmd.exe.
$line =~ s,\\,\\\\,g;
shellwords($line);
}
sub dynamic_libs {
my ($class) = @_;
require FFI::CheckLib;
my @find_lib_flags;
if($class->install_type('system')) {
if(my $prop = $class->runtime_prop)
{
if($prop->{ffi_checklib}->{system})
{
push @find_lib_flags, @{ $prop->{ffi_checklib}->{system} };
}
return FFI::CheckLib::find_lib( lib => $prop->{ffi_name}, @find_lib_flags )
if defined $prop->{ffi_name};
}
my $name = $class->config('ffi_name');
unless(defined $name)
{
$name = $class->config('name');
$name = '' unless defined $name;
# strip leading lib from things like libarchive or libffi
$name =~ s/^lib//;
# strip trailing version numbers
$name =~ s/-[0-9\.]+$//;
}
my @libpath;
if(defined $class->libs)
{
foreach my $flag ($class->split_flags($class->libs))
{
if($flag =~ /^-L(.*)$/)
{
push @libpath, $1;
}
}
}
return FFI::CheckLib::find_lib(lib => $name, libpath => \@libpath, @find_lib_flags );
} else {
my $dir = $class->dist_dir;
my $dynamic = Path::Tiny->new($class->dist_dir, 'dynamic');
if(my $prop = $class->runtime_prop)
{
if($prop->{ffi_checklib}->{share})
{
push @find_lib_flags, @{ $prop->{ffi_checklib}->{share_flags} };
}
}
if(-d $dynamic)
{
return FFI::CheckLib::find_lib(
lib => '*',
libpath => "$dynamic",
systempath => [],
);
}
return FFI::CheckLib::find_lib(
lib => '*',
libpath => $dir,
systempath => [],
recursive => 1,
);
}
}
sub bin_dir {
my ($class) = @_;
if($class->install_type('system'))
{
my $prop = $class->runtime_prop;
return () unless defined $prop;
return () unless defined $prop->{system_bin_dir};
return ref $prop->{system_bin_dir} ? @{ $prop->{system_bin_dir} } : ($prop->{system_bin_dir});
}
else
{
my $dir = Path::Tiny->new($class->dist_dir, 'bin');
return -d $dir ? ("$dir") : ();
}
}
sub dynamic_dir {
my ($class) = @_;
if($class->install_type('system'))
{
return ();
}
else
{
my $dir = Path::Tiny->new($class->dist_dir, 'dynamic');
return -d $dir ? ("$dir") : ();
}
}
sub alien_helper {
{};
}
sub inline_auto_include {
my ($class) = @_;
$class->runtime_prop->{inline_auto_include} || $class->config('inline_auto_include') || []
}
sub Inline {
my ($class, $language) = @_;
return unless defined $language;
return if $language !~ /^(C|CPP)$/;
my $config = {
# INC should arguably be for -I flags only, but
# this improves compat with ExtUtils::Depends.
# see gh#107, gh#108
INC => $class->cflags,
LIBS => $class->libs,
};
if (@{ $class->inline_auto_include } > 0) {
$config->{AUTO_INCLUDE} = join "\n", map { "#include \"$_\"" } @{ $class->inline_auto_include };
}
$config;
}
{
my %alien_build_config_cache;
sub runtime_prop
{
my($class) = @_;
if(ref($class))
{
# called as an instance method.
my $self = $class;
$class = ref $self;
return $self->{_alt}->{runtime_prop} if defined $self->{_alt};
}
return $alien_build_config_cache{$class} if
exists $alien_build_config_cache{$class};
$alien_build_config_cache{$class} ||= do {
my $dist = ref $class ? ref $class : $class;
$dist =~ s/::/-/g;
my $dist_dir = eval { _dist_dir $dist };
return if $@;
my $alien_json = Path::Tiny->new($dist_dir, '_alien', 'alien.json');
return unless -r $alien_json;
my $json = $alien_json->slurp;
require JSON::PP;
my $config = JSON::PP::decode_json($json);
$config->{distdir} = $dist_dir;
$config;
};
}
}
sub alt
{
my($old, $name) = @_;
my $new = ref $old ? (ref $old)->new : $old->new;
my $orig;
if(ref($old) && defined $old->{_alt})
{ $orig = $old->{_alt}->{orig} }
else
{ $orig = $old->runtime_prop }
require Storable;
my $runtime_prop = Storable::dclone($orig);
if($runtime_prop->{alt}->{$name})
{
foreach my $key (keys %{ $runtime_prop->{alt}->{$name} })
{
$runtime_prop->{$key} = $runtime_prop->{alt}->{$name}->{$key};
}
}
else
{
Carp::croak("no such alt: $name");
}
$new->{_alt} = {
runtime_prop => $runtime_prop,
orig => $orig,
};
$new;
}
sub alt_names
{
my($class) = @_;
my $alts = $class->runtime_prop->{alt};
defined $alts
? sort keys %$alts
: ();
}
sub alt_exists
{
my($class, $alt_name) = @_;
my $alts = $class->runtime_prop->{alt};
defined $alts
? exists $alts->{$alt_name} && defined $alts->{$alt_name}
: 0;
}
1;
=pod
=encoding UTF-8
=head1 NAME
Alien::Base - Base classes for Alien:: modules
=head1 VERSION
version 2.84
=head1 SYNOPSIS
package Alien::MyLibrary;
use strict;
use warnings;
use parent 'Alien::Base';
1;
(for details on the C