File Coverage

blib/lib/Alien/Base/Wrapper.pm

Criterion	Covered	Total	%
statement	136	153	88.8
branch	40	56	71.4
condition	4	6	66.6
subroutine	19	20	95.0
pod	7	7	100.0
total	206	242	85.1

package Alien::Base::Wrapper;

use strict;
use warnings;
use 5.006;
use Config;
use Text::ParseWords qw( shellwords );

# NOTE: Although this module is now distributed with Alien-Build,
# it should have NO non-perl-core dependencies for all Perls
# 5.6.0-5.30.1 (as of this writing, and any Perl more recent).
# You should be able to extract this module from the rest of
# Alien-Build and use it by itself.  (There is a dzil plugin
# for this [AlienBase::Wrapper::Bundle]

# ABSTRACT: Compiler and linker wrapper for Alien
our $VERSION = '2.46'; # VERSION


sub _join
{
  join ' ',
    map {
      my $x = $_;
      $x =~ s/(\s)/\\$1/g;
      $x;
    } @_;
}

sub new
{
  my($class, @aliens) = @_;

  my $export = 1;
  my $writemakefile = 0;

  my @cflags_I;
  my @cflags_other;
  my @ldflags_L;
  my @ldflags_l;
  my @ldflags_other;
  my %requires = (
    'ExtUtils::MakeMaker'  => '6.52',
    'Alien::Base::Wrapper' => '1.97',
  );

  foreach my $alien (@aliens)
  {
    if($alien eq '!export')
    {
      $export = 0;
      next;
    }
    if($alien eq 'WriteMakefile')
    {
      $writemakefile = 1;
      next;
    }
    my $version = 0;
    if($alien =~ s/=(.*)$//)
    {
      $version = $1;
    }
    $alien = "Alien::$alien" unless $alien =~ /::/;
    $requires{$alien} = $version;
    my $alien_pm = $alien . '.pm';
    $alien_pm =~ s/::/\//g;
    require $alien_pm unless eval { $alien->can('cflags') } && eval { $alien->can('libs') };
    my $cflags;
    my $libs;
    if($alien->install_type eq 'share' && $alien->can('cflags_static'))
    {
      $cflags = $alien->cflags_static;
      $libs   = $alien->libs_static;
    }
    else
    {
      $cflags = $alien->cflags;
      $libs   = $alien->libs;
    }

    push @cflags_I,     grep  /^-I/, shellwords $cflags;
    push @cflags_other, grep !/^-I/, shellwords $cflags;

    push @ldflags_L,     grep  /^-L/,    shellwords $libs;
    push @ldflags_l,     grep  /^-l/,    shellwords $libs;
    push @ldflags_other, grep !/^-[Ll]/, shellwords $libs;
  }

  my @cflags_define = grep  /^-D/, @cflags_other;
  my @cflags_other2 = grep !/^-D/, @cflags_other;

  my @mm;

  push @mm, INC       => _join @cflags_I                             if @cflags_I;
  push @mm, CCFLAGS   => _join(@cflags_other2) . " $Config{ccflags}" if @cflags_other2;
  push @mm, DEFINE    => _join(@cflags_define)                       if @cflags_define;

  # TODO: handle spaces in -L paths
  push @mm, LIBS      => ["@ldflags_L @ldflags_l"];
  my @ldflags = (@ldflags_L, @ldflags_other);
  push @mm, LDDLFLAGS => _join(@ldflags) . " $Config{lddlflags}"     if @ldflags;
  push @mm, LDFLAGS   => _join(@ldflags) . " $Config{ldflags}"       if @ldflags;

  my @mb;

  push @mb, extra_compiler_flags => _join(@cflags_I, @cflags_other);
  push @mb, extra_linker_flags   => _join(@ldflags_l);

  if(@ldflags)
  {
    push @mb, config => {
      lddlflags => _join(@ldflags) . " $Config{lddlflags}",
      ldflags   => _join(@ldflags) . " $Config{ldflags}",
    },
  }

  bless {
    cflags_I       => \@cflags_I,
    cflags_other   => \@cflags_other,
    ldflags_L      => \@ldflags_L,
    ldflags_l      => \@ldflags_l,
    ldflags_other  => \@ldflags_other,
    mm             => \@mm,
    mb             => \@mb,
    _export        => $export,
    _writemakefile => $writemakefile,
    requires       => \%requires,
  }, $class;
}

my $default_abw = __PACKAGE__->new;

# for testing only
sub _reset { __PACKAGE__->new }


sub _myexec
{
  my @command = @_;
  if($^O eq 'MSWin32')
  {
    # To handle weird quoting on MSWin32
    # this logic needs to be improved.
    my $command = "@command";
    $command =~ s{"}{\\"}g;
    system $command;

    if($? == -1 )
    {
      die "failed to execute: $!\n";
    }
    elsif($? & 127)
    {
      die "child died with signal @{[ $? & 128 ]}";
    }
    else
    {
      exit($? >> 8);
    }
  }
  else
  {
    exec @command;
  }
}

sub cc
{
  my @command = (
    shellwords($Config{cc}),
    @{ $default_abw->{cflags_I} },
    @{ $default_abw->{cflags_other} },
    @ARGV,
  );
  print "@command\n" unless $ENV{ALIEN_BASE_WRAPPER_QUIET};
  _myexec @command;
}


sub ld
{
  my @command = (
    shellwords($Config{ld}),
    @{ $default_abw->{ldflags_L} },
    @{ $default_abw->{ldflags_other} },
    @ARGV,
    @{ $default_abw->{ldflags_l} },
  );
  print "@command\n" unless $ENV{ALIEN_BASE_WRAPPER_QUIET};
  _myexec @command;
}


sub mm_args
{
  my $self = ref $_[0] ? shift : $default_abw;
  @{ $self->{mm} };
}


sub mm_args2
{
  my $self = shift;
  $self = $default_abw unless ref $self;
  my %args = @_;

  my @mm = @{ $self->{mm} };

  while(@mm)
  {
    my $key = shift @mm;
    my $value = shift @mm;
    if(defined $args{$key})
    {
      if($args{$key} eq 'LIBS')
      {
        require Carp;
        # Todo: support this maybe?
        Carp::croak("please do not specify your own LIBS key with mm_args2");
      }
      else
      {
        $args{$key} = join ' ', $value, $args{$key};
      }
    }
    else
    {
      $args{$key} = $value;
    }
  }

  foreach my $module (keys %{ $self->{requires} })
  {
    $args{CONFIGURE_REQUIRES}->{$module} = $self->{requires}->{$module};
  }

  %args;
}


sub mb_args
{
  my $self = ref $_[0] ? shift : $default_abw;
  @{ $self->{mb} };
}

sub import
{
  shift;
  my $abw = $default_abw = __PACKAGE__->new(@_);
  if($abw->_export)
  {
    my $caller = caller;
    no strict 'refs';
    *{"${caller}::cc"} = \&cc;
    *{"${caller}::ld"} = \&ld;
  }
  if($abw->_writemakefile)
  {
    my $caller = caller;
    no strict 'refs';
    *{"${caller}::WriteMakefile"} = \&WriteMakefile;
  }
}


sub WriteMakefile
{
  my %args = @_;

  require ExtUtils::MakeMaker;
  ExtUtils::MakeMaker->VERSION('6.52');

  my @aliens;

  if(my $reqs = delete $args{alien_requires})
  {
    if(ref $reqs eq 'HASH')
    {
      @aliens = map {
        my $module  = $_;
        my $version = $reqs->{$module};
        $version ? "$module=$version" : "$module";
      } sort keys %$reqs;
    }
    elsif(ref $reqs eq 'ARRAY')
    {
      @aliens = @$reqs;
    }
    else
    {
      require Carp;
      Carp::croak("aliens_require must be either a hash or array reference");
    }
  }
  else
  {
    require Carp;
    Carp::croak("You are using Alien::Base::Wrapper::WriteMakefile, but didn't specify any alien requirements");
  }

  ExtUtils::MakeMaker::WriteMakefile(
    Alien::Base::Wrapper->new(@aliens)->mm_args2(%args),
  );
}

sub _export        { shift->{_export} }
sub _writemakefile { shift->{_writemakefile} }

1;

__END__