File Coverage

blib/lib/Alien/Build.pm

Criterion	Covered	Total	%
statement	500	519	96.3
branch	191	220	86.8
condition	74	99	74.7
subroutine	83	83	100.0
pod	27	27	100.0
total	875	948	92.3

package Alien::Build;

use strict;
use warnings;
use 5.008004;
use Path::Tiny ();
use Carp ();
use File::chdir;
use JSON::PP ();
use Env qw( @PATH @PKG_CONFIG_PATH );
use Config ();
use Alien::Build::Log;

# ABSTRACT: Build external dependencies for use in CPAN
our $VERSION = '2.45'; # VERSION


sub _path { goto \&Path::Tiny::path }


sub new
{
  my($class, %args) = @_;
  my $self = bless {
    install_prop => {
      root  => _path($args{root} || "_alien")->absolute->stringify,
      patch => (defined $args{patch}) ? _path($args{patch})->absolute->stringify : undef,
    },
    runtime_prop => {
      alien_build_version => $Alien::Build::VERSION || 'dev',
    },
    plugin_instance_prop => {},
    bin_dir => [],
    pkg_config_path => [],
    aclocal_path => [],
  }, $class;

  $self->meta->filename(
    $args{filename} || do {
      my(undef, $filename) = caller;
      _path($filename)->absolute->stringify;
    }
  );

  if($args{meta_prop})
  {
    $self->meta->prop->{$_} = $args{meta_prop}->{$_} for keys %{ $args{meta_prop} };
  }

  $self;
}


my $count = 0;

sub load
{
  my(undef, $alienfile, @args) = @_;

  my $rcfile = Path::Tiny->new($ENV{ALIEN_BUILD_RC} || '~/.alienbuild/rc.pl')->absolute;
  if(-r $rcfile)
  {
    require Alien::Build::rc;
    package Alien::Build::rc;
    require $rcfile;
  }

  unless(-r $alienfile)
  {
    Carp::croak "Unable to read alienfile: $alienfile";
  }

  my $file = _path $alienfile;
  my $name = $file->parent->basename;
  $name =~ s/^alien-//i;
  $name =~ s/[^a-z]//g;
  $name = 'x' if $name eq '';
  $name = ucfirst $name;

  my $class = "Alien::Build::Auto::$name@{[ $count++ ]}";

  { no strict 'refs';
  @{ "${class}::ISA" } = ('Alien::Build');
  *{ "${class}::Alienfile::meta" } = sub {
    $class =~ s{::Alienfile$}{};
    $class->meta;
  }};

  my @preload = qw( Core::Setup Core::Download Core::FFI Core::Override Core::CleanInstall );
  push @preload, @Alien::Build::rc::PRELOAD;
  push @preload, split /;/, $ENV{ALIEN_BUILD_PRELOAD}
    if defined $ENV{ALIEN_BUILD_PRELOAD};

  my @postload = qw( Core::Legacy Core::Gather Core::Tail );
  push @postload, @Alien::Build::rc::POSTLOAD;
  push @postload, split /;/, $ENV{ALIEN_BUILD_POSTLOAD}
    if defined $ENV{ALIEN_BUILD_POSTLOAD};

  my $self = $class->new(
    filename => $file->absolute->stringify,
    @args,
  );

  require alienfile;

  foreach my $preload (@preload)
  {
    ref $preload eq 'CODE' ? $preload->($self->meta) : $self->meta->apply_plugin($preload);
  }

  # TODO: do this without a string eval ?
  ## no critic
  eval '# line '. __LINE__ . ' "' . __FILE__ . qq("\n) . qq{
    package ${class}::Alienfile;
    do '@{[ $file->absolute->stringify ]}';
    die \$\@ if \$\@;
  };
  die $@ if $@;
  ## use critic

  foreach my $postload (@postload)
  {
    ref $postload eq 'CODE' ? $postload->($self->meta) : $self->meta->apply_plugin($postload);
  }

  $self->{args} = \@args;
  unless(defined $self->meta->prop->{arch})
  {
    $self->meta->prop->{arch} = 1;
  }

  unless(defined $self->meta->prop->{network})
  {
    $self->meta->prop->{network} = 1;
    ## https://github.com/PerlAlien/Alien-Build/issues/23#issuecomment-341114414
    #$self->meta->prop->{network} = 0 if $ENV{NO_NETWORK_TESTING};
    $self->meta->prop->{network} = 0 if (defined $ENV{ALIEN_INSTALL_NETWORK}) && ! $ENV{ALIEN_INSTALL_NETWORK};
  }

  unless(defined $self->meta->prop->{local_source})
  {
    if(! defined $self->meta->prop->{start_url})
    {
      $self->meta->prop->{local_source} = 0;
    }
    # we assume URL schemes are at least two characters, that
    # way Windows absolute paths can be used as local start_url
    elsif($self->meta->prop->{start_url} =~ /^([a-z]{2,}):/i)
    {
      my $scheme = $1;
      $self->meta->prop->{local_source} = $scheme eq 'file';
    }
    else
    {
      $self->meta->prop->{local_source} = 1;
    }
  }

  return $self;
}


sub resume
{
  my(undef, $alienfile, $root) = @_;
  my $h = JSON::PP::decode_json(_path("$root/state.json")->slurp);
  my $self = Alien::Build->load("$alienfile", @{ $h->{args} });
  $self->{install_prop}         = $h->{install};
  $self->{plugin_instance_prop} = $h->{plugin_instance};
  $self->{runtime_prop}         = $h->{runtime};
  $self;
}


sub meta_prop
{
  my($class) = @_;
  $class->meta->prop;
}


sub install_prop
{
  shift->{install_prop};
}


sub plugin_instance_prop
{
  my($self, $plugin) = @_;
  my $instance_id = $plugin->instance_id;
  $self->{plugin_instance_prop}->{$instance_id} ||= {};
}


sub runtime_prop
{
  shift->{runtime_prop};
}


sub hook_prop
{
  shift->{hook_prop};
}

sub _command_prop
{
  my($self) = @_;

  return {
    alien => {
      install => $self->install_prop,
      runtime => $self->runtime_prop,
      hook    => $self->hook_prop,
      meta    => $self->meta_prop,
    },
    perl => {
      config => \%Config::Config,
    },
    env => \%ENV,
  };
}


sub checkpoint
{
  my($self) = @_;
  my $root = $self->root;
  _path("$root/state.json")->spew(
    JSON::PP->new->pretty->canonical(1)->ascii->encode({
      install         => $self->install_prop,
      runtime         => $self->runtime_prop,
      plugin_instance => $self->{plugin_instance_prop},
      args            => $self->{args},
    })
  );
  $self;
}


sub root
{
  my($self) = @_;
  my $root = $self->install_prop->{root};
  _path($root)->mkpath unless -d $root;
  $root;
}


sub install_type
{
  my($self) = @_;
  $self->{runtime_prop}->{install_type} ||= $self->probe;
}


sub set_prefix
{
  my($self, $prefix) = @_;

  if($self->meta_prop->{destdir})
  {
    $self->runtime_prop->{prefix} =
    $self->install_prop->{prefix} = $prefix;
  }
  else
  {
    $self->runtime_prop->{prefix} = $prefix;
    $self->install_prop->{prefix} = $self->install_prop->{stage};
  }
}


sub set_stage
{
  my($self, $dir) = @_;
  $self->install_prop->{stage} = $dir;
}

sub _merge
{
  my %h;
  while(@_)
  {
    my $mod = shift;
    my $ver = shift;
    if((!defined $h{$mod}) || $ver > $h{$mod})
    { $h{$mod} = $ver }
  }
  \%h;
}


sub requires
{
  my($self, $phase) = @_;
  $phase ||= 'any';
  my $meta = $self->meta;
  $phase =~ /^(?:any|configure)$/
  ? $meta->{require}->{$phase} || {}
  : _merge %{ $meta->{require}->{any} }, %{ $meta->{require}->{$phase} };
}


sub load_requires
{
  my($self, $phase, $eval) = @_;
  my $reqs = $self->requires($phase);
  foreach my $mod (keys %$reqs)
  {
    my $ver = $reqs->{$mod};
    my $check = sub {
      my $pm = "$mod.pm";
      $pm =~ s{::}{/}g;
      require $pm;
    };
    if($eval)
    {
      eval { $check->() };
      die "Required $mod @{[ $ver || 'undef' ]}, missing" if $@;
    }
    else
    {
      $check->();
    }
    # note Test::Alien::Build#alienfile_skip_if_missing_prereqs does a regex
    # on this diagnostic, so if you change it here, change it there too.
    die "Required $mod $ver, have @{[ $mod->VERSION || 0 ]}" if $ver && ! $mod->VERSION($ver);

    # allow for requires on Alien::Build or Alien::Base
    next if $mod eq 'Alien::Build';
    next if $mod eq 'Alien::Base';

    if($mod->can('bin_dir'))
    {
      push @{ $self->{bin_dir} }, $mod->bin_dir;
    }

    if(($mod->can('runtime_prop') && $mod->runtime_prop)
    || ($mod->isa('Alien::Base')  && $mod->install_type('share')))
    {
      for my $dir (qw(lib share)) {
          my $path = _path($mod->dist_dir)->child("$dir/pkgconfig");
          if(-d $path)
          {
            push @{ $self->{pkg_config_path} }, $path->stringify;
          }
      }
      my $path = _path($mod->dist_dir)->child('share/aclocal');
      if(-d $path)
      {
        $path = "$path";
        if($^O eq 'MSWin32')
        {
          # convert to MSYS path
          $path =~ s{^([a-z]):}{/$1/}i;
        }
        push @{ $self->{aclocal_path} }, $path;
      }
    }

    # sufficiently new Autotools have a aclocal_dir which will
    # give us the directories we need.
    if($mod eq 'Alien::Autotools' && $mod->can('aclocal_dir'))
    {
      push @{ $self->{aclocal_path} }, $mod->aclocal_dir;
    }

    if($mod->can('alien_helper'))
    {
      my $helpers = $mod->alien_helper;
      foreach my $name (sort keys %$helpers)
      {
        my $code = $helpers->{$name};
        $self->meta->interpolator->replace_helper($name => $code);
      }
    }

  }
  1;
}

sub _call_hook
{
  my $self = shift;

  local $ENV{PATH} = $ENV{PATH};
  unshift @PATH, @{ $self->{bin_dir} };

  local $ENV{PKG_CONFIG_PATH} = $ENV{PKG_CONFIG_PATH};
  unshift @PKG_CONFIG_PATH, @{ $self->{pkg_config_path} };

  local $ENV{ACLOCAL_PATH} = $ENV{ACLOCAL_PATH};
  # autoconf uses MSYS paths, even for the ACLOCAL_PATH environment variable, so we can't use Env for this.
  {
    my @path;
    @path = split /:/, $ENV{ACLOCAL_PATH} if defined $ENV{ACLOCAL_PATH};
    unshift @path, @{ $self->{aclocal_path} };
    $ENV{ACLOCAL_PATH} = join ':', @path;
  }

  my $config = ref($_[0]) eq 'HASH' ? shift : {};
  my($name, @args) = @_;

  local $self->{hook_prop} = {};

  $self->meta->call_hook( $config, $name => $self, @args );
}


sub probe
{
  my($self) = @_;
  local $CWD = $self->root;
  my $dir;

  my $env = $self->_call_hook('override');
  my $type;
  my $error;

  $env = '' if $env eq 'default';

  if($env eq 'share')
  {
    $type = 'share';
  }
  else
  {
    $type = eval {
      $self->_call_hook(
        {
          before   => sub {
            $dir = Alien::Build::TempDir->new($self, "probe");
            $CWD = "$dir";
          },
          after    => sub {
            $CWD = $self->root;
          },
          ok       => 'system',
          continue => sub {
            if($_[0] eq 'system')
            {
              foreach my $name (qw( probe_class probe_instance_id ))
              {
                if(exists $self->hook_prop->{$name} && defined $self->hook_prop->{$name})
                {
                  $self->install_prop->{"system_$name"} = $self->hook_prop->{$name};
                }
              }
              return undef;
            }
            else
            {
              return 1;
            }
          },
        },
        'probe',
      );
    };
    $error = $@;
    $type = 'share' unless defined $type;
  }

  if($error)
  {
    if($env eq 'system')
    {
      die $error;
    }
    $self->log("error in probe (will do a share install): $@");
    $self->log("Don't panic, we will attempt a share build from source if possible.");
    $self->log("Do not file a bug unless you expected a system install to succeed.");
    $type = 'share';
  }

  if($env && $env ne $type)
  {
    die "requested $env install not available";
  }

  if($type !~ /^(system|share)$/)
  {
    Carp::croak "probe hook returned something other than system or share: $type";
  }

  if($type eq 'share' && (!$self->meta_prop->{network}) && (!$self->meta_prop->{local_source}))
  {
    $self->log("install type share requested or detected, but network fetch is turned off");
    $self->log("see https://metacpan.org/pod/Alien::Build::Manual::FAQ#Network-fetch-is-turned-off");
    Carp::croak "network fetch is turned off";
  }

  $self->runtime_prop->{install_type} = $type;

  $type;
}


sub download
{
  my($self) = @_;

  return $self unless $self->install_type eq 'share';
  return $self if $self->install_prop->{complete}->{download};

  if($self->meta->has_hook('download'))
  {
    my $tmp;
    local $CWD;
    my $valid = 0;

    $self->_call_hook(
      {
        before => sub {
          $tmp = Alien::Build::TempDir->new($self, "download");
          $CWD = "$tmp";
        },
        verify => sub {
          my @list = grep { $_->basename !~ /^\./, } _path('.')->children;

          my $count = scalar @list;

          if($count == 0)
          {
            die "no files downloaded";
          }
          elsif($count == 1)
          {
            my($archive) = $list[0];
            if(-d $archive)
            {
              $self->log("single dir, assuming directory");
            }
            else
            {
              $self->log("single file, assuming archive");
            }
            $self->install_prop->{download} = $archive->absolute->stringify;
            $self->install_prop->{complete}->{download} = 1;
            $valid = 1;
          }
          else
          {
            $self->log("multiple files, assuming directory");
            $self->install_prop->{complete}->{download} = 1;
            $self->install_prop->{download} = _path('.')->absolute->stringify;
            $valid = 1;
          }
        },
        after  => sub {
          $CWD = $self->root;
        },
      },
      'download',
    );

    return $self if $valid;
  }
  else
  {
    # This will call the default download hook
    # defined in Core::Download since the recipe
    # does not provide a download hook
    return $self->_call_hook('download');
  }

  die "download failed";
}


sub fetch
{
  my $self = shift;
  $self->_call_hook( 'fetch' => @_ );
}


sub decode
{
  my($self, $res) = @_;
  $self->_call_hook( decode => $res );
}


sub prefer
{
  my($self, $res) = @_;
  $self->_call_hook( prefer => $res );
}


sub extract
{
  my($self, $archive) = @_;

  $archive ||= $self->install_prop->{download};

  unless(defined $archive)
  {
    die "tried to call extract before download";
  }

  my $nick_name = 'build';

  if($self->meta_prop->{out_of_source})
  {
    $nick_name = 'extract';
    my $extract = $self->install_prop->{extract};
    return $extract if defined $extract && -d $extract;
  }

  my $tmp;
  local $CWD;
  my $ret;

  $self->_call_hook({

    before => sub {
      # called build instead of extract, because this
      # will be used for the build step, and technically
      # extract is a substage of build anyway.
      $tmp = Alien::Build::TempDir->new($self, $nick_name);
      $CWD = "$tmp";
    },
    verify => sub {

      my $path = '.';
      if($self->meta_prop->{out_of_source} && $self->install_prop->{extract})
      {
        $path = $self->install_prop->{extract};
      }

      my @list = grep { $_->basename !~ /^\./ && $_->basename ne 'pax_global_header' } _path($path)->children;

      my $count = scalar @list;

      if($count == 0)
      {
        die "no files extracted";
      }
      elsif($count == 1 && -d $list[0])
      {
        $ret = $list[0]->absolute->stringify;
      }
      else
      {
        $ret = "$tmp";
      }

    },
    after => sub {
      $CWD = $self->root;
    },

  }, 'extract', $archive);

  $self->install_prop->{extract} ||= $ret;
  $ret ? $ret : ();
}


sub build
{
  my($self) = @_;

  # save the evironment, in case some plugins decide
  # to alter it.  Or us!  See just a few lines below.
  local %ENV = %ENV;

  my $stage = _path($self->install_prop->{stage});
  $stage->mkpath;

  my $tmp;

  if($self->install_type eq 'share')
  {
    foreach my $suffix ('', '_ffi')
    {
      local $CWD;
      delete $ENV{DESTDIR} unless $self->meta_prop->{destdir};

      my %env_meta = %{ $self->meta_prop   ->{env} || {} };
      my %env_inst = %{ $self->install_prop->{env} || {} };

      if($self->meta_prop->{env_interpolate})
      {
        foreach my $key (keys %env_meta)
        {
          $env_meta{$key} = $self->meta->interpolator->interpolate($env_meta{$key});
        }
      }

      %ENV = (%ENV, %env_meta);
      %ENV = (%ENV, %env_inst);

      my $destdir;

      $self->_call_hook(
      {
        before => sub {
          if($self->meta_prop->{out_of_source})
          {
            $self->extract;
            $CWD = $tmp = Alien::Build::TempDir->new($self, 'build');
          }
          else
          {
            $CWD = $tmp = $self->extract;
          }
          if($self->meta_prop->{destdir})
          {
            $destdir = Alien::Build::TempDir->new($self, 'destdir');
            $ENV{DESTDIR} = "$destdir";
          }
          $self->_call_hook({ all => 1 }, "patch${suffix}");
        },
        after => sub {
          $destdir = "$destdir" if $destdir;
        },
      }, "build${suffix}");

      $self->install_prop->{"_ab_build@{[ $suffix || '_share' ]}"} = "$CWD";

      $self->_call_hook("gather@{[ $suffix || '_share' ]}");
    }
  }

  elsif($self->install_type eq 'system')
  {
    local $CWD = $self->root;
    my $dir;

    $self->_call_hook(
      {
        before => sub {
          $dir = Alien::Build::TempDir->new($self, "gather");
          $CWD = "$dir";
        },
        after  => sub {
          $CWD = $self->root;
        },
      },
      'gather_system',
    );

    $self->install_prop->{finished} = 1;
    $self->install_prop->{complete}->{gather_system} = 1;
  }

  $self;
}


sub test
{
  my($self) = @_;

  if($self->install_type eq 'share')
  {
    foreach my $suffix ('_share', '_ffi')
    {
      if($self->meta->has_hook("test$suffix"))
      {
        my $dir = $self->install_prop->{"_ab_build$suffix"};
        Carp::croak("no build directory to run tests") unless $dir && -d $dir;
        local $CWD = $dir;
        $self->_call_hook("test$suffix");
      }
    }
  }
  else
  {
    if($self->meta->has_hook("test_system"))
    {
      my $dir = Alien::Build::TempDir->new($self, "test");
      local $CWD = "$dir";
      $self->_call_hook("test_system");
    }
  }

}


sub clean_install
{
  my($self) = @_;
  if($self->install_type eq 'share')
  {
    $self->_call_hook("clean_install");
  }
}


sub system
{
  my($self, $command, @args) = @_;

  my $prop = $self->_command_prop;

  ($command, @args) = map {
    $self->meta->interpolator->interpolate($_, $prop)
  } ($command, @args);

  $self->log("+ $command @args");

  scalar @args
    ? system $command, @args
    : system $command;
}


sub log
{
  my(undef, $message) = @_;
  my $caller = [caller];
  chomp $message;
  foreach my $line (split /\n/, $message)
  {
    Alien::Build::Log->default->log(
      caller  => $caller,
      message => $line,
    );
  }
}


{
  my %meta;

  sub meta
  {
    my($class) = @_;
    $class = ref $class if ref $class;
    $meta{$class} ||= Alien::Build::Meta->new( class => $class );
  }
}

package Alien::Build::Meta;

our @CARP_NOT = qw( alienfile );

sub new
{
  my($class, %args) = @_;
  my $self = bless {
    phase => 'any',
    build_suffix => '',
    require => {
      any    => {},
      share  => {},
      system => {},
    },
    around => {},
    prop => {},
    %args,
  }, $class;
  $self;
}


sub prop
{
  shift->{prop};
}

sub filename
{
  my($self, $new) = @_;
  $self->{filename} = $new if defined $new;
  $self->{filename};
}


sub add_requires
{
  my $self = shift;
  my $phase = shift;
  while(@_)
  {
    my $module = shift;
    my $version = shift;
    my $old = $self->{require}->{$phase}->{$module};
    if((!defined $old) || $version > $old)
    { $self->{require}->{$phase}->{$module} = $version }
  }
  $self;
}


sub interpolator
{
  my($self, $new) = @_;
  if(defined $new)
  {
    if(defined $self->{intr})
    {
      Carp::croak "tried to set interpolator twice";
    }
    if(ref $new)
    {
      $self->{intr} = $new;
    }
    else
    {
      $self->{intr} = $new->new;
    }
  }
  elsif(!defined $self->{intr})
  {
    require Alien::Build::Interpolate::Default;
    $self->{intr} = Alien::Build::Interpolate::Default->new;
  }
  $self->{intr};
}


sub has_hook
{
  my($self, $name) = @_;
  defined $self->{hook}->{$name};
}


sub _instr
{
  my($self, $name, $instr) = @_;
  if(ref($instr) eq 'CODE')
  {
    return $instr;
  }
  elsif(ref($instr) eq 'ARRAY')
  {
    my %phase = (
      download      => 'share',
      fetch         => 'share',
      decode        => 'share',
      prefer        => 'share',
      extract       => 'share',
      patch         => 'share',
      patch_ffi     => 'share',
      build         => 'share',
      build_ffi     => 'share',
      stage         => 'share',
      gather_ffi    => 'share',
      gather_share  => 'share',
      gather_system => 'system',
      test_ffi      => 'share',
      test_share    => 'share',
      test_system   => 'system',
    );
    require Alien::Build::CommandSequence;
    my $seq = Alien::Build::CommandSequence->new(@$instr);
    $seq->apply_requirements($self, $phase{$name} || 'any');
    return $seq;
  }
  else
  {
    Carp::croak "type not supported as a hook";
  }
}

sub register_hook
{
  my($self, $name, $instr) = @_;
  push @{ $self->{hook}->{$name} }, _instr $self, $name, $instr;
  $self;
}


sub default_hook
{
  my($self, $name, $instr) = @_;
  $self->{default_hook}->{$name} = _instr $self, $name, $instr;
  $self;
}


sub around_hook
{
  my($self, $name, $code) = @_;
  if(my $old = $self->{around}->{$name})
  {
    # this is the craziest shit I have ever
    # come up with.
    $self->{around}->{$name} = sub {
      my $orig = shift;
      $code->(sub { $old->($orig, @_) }, @_);
    };
  }
  else
  {
    $self->{around}->{$name} = $code;
  }
}

sub after_hook
{
  my($self, $name, $code) = @_;
  $self->around_hook(
    $name => sub {
      my $orig = shift;
      my $ret = $orig->(@_);
      $code->(@_);
      $ret;
    }
  );
}

sub before_hook
{
  my($self, $name, $code) = @_;
  $self->around_hook(
    $name => sub {
      my $orig = shift;
      $code->(@_);
      my $ret = $orig->(@_);
      $ret;
    }
  );
}


sub call_hook
{
  my $self = shift;
  my %args = ref $_[0] ? %{ shift() } : ();
  my($name, @args) = @_;
  my $error;

  my @hooks = @{ $self->{hook}->{$name} || []};

  if(@hooks == 0)
  {
    if(defined $self->{default_hook}->{$name})
    {
      @hooks = ($self->{default_hook}->{$name})
    }
    elsif(!$args{all})
    {
      Carp::croak "No hooks registered for $name";
    }
  }

  my $value;

  foreach my $hook (@hooks)
  {
    if(eval { $args[0]->isa('Alien::Build') })
    {
      %{ $args[0]->{hook_prop} } = (
        name => $name,
      );
    }

    my $wrapper = $self->{around}->{$name} || sub { my $code = shift; $code->(@_) };
    my $value;
    $args{before}->() if $args{before};
    if(ref($hook) eq 'CODE')
    {
      $value = eval {
        my $value = $wrapper->(sub { $hook->(@_) }, @args);
        $args{verify}->('code') if $args{verify};
        $value;
      };
    }
    else
    {
      $value = $wrapper->(sub {
        eval {
          $hook->execute(@_);
          $args{verify}->('command') if $args{verify};
        };
        defined $args{ok} ? $args{ok} : 1;
      }, @args);
    }
    $error = $@;
    $args{after}->() if $args{after};
    if($args{all})
    {
      die if $error;
    }
    else
    {
      next if $error;
      next if $args{continue} && $args{continue}->($value);
      return $value;
    }
  }

  die $error if $error && ! $args{all};

  $value;
}


sub apply_plugin
{
  my($self, $name, @args) = @_;

  my $class;
  my $pm;
  my $found;

  if($name =~ /^=(.*)$/)
  {
    $class = $1;
    $pm    = "$class.pm";
    $pm    =~ s!::!/!g;
    $found = 1;
  }

  if($name !~ /::/ && !$found)
  {
    foreach my $inc (@INC)
    {
      # TODO: allow negotiators to work with @INC hooks
      next if ref $inc;
      my $file = Path::Tiny->new("$inc/Alien/Build/Plugin/$name/Negotiate.pm");
      if(-r $file)
      {
        $class = "Alien::Build::Plugin::${name}::Negotiate";
        $pm    = "Alien/Build/Plugin/$name/Negotiate.pm";
        $found = 1;
        last;
      }
    }
  }

  unless($found)
  {
    $class = "Alien::Build::Plugin::$name";
    $pm    = "Alien/Build/Plugin/$name.pm";
    $pm    =~ s{::}{/}g;
  }

  require $pm unless $class->can('new');
  my $plugin = $class->new(@args);
  $plugin->init($self);
  $self;
}

package Alien::Build::TempDir;

# TODO: it's confusing that there is both a AB::TempDir and AB::Temp
# although they do different things.  there could maybe be a better
# name for AB::TempDir (maybe AB::TempBuildDir, though that is a little
# redundant).  Happily both are private classes, and either are able to
# rename, if a good name can be thought of.

use overload '""' => sub { shift->as_string }, bool => sub { 1 }, fallback => 1;
use File::Temp qw( tempdir );

sub new
{
  my($class, $build, $name) = @_;
  my $root = $build->install_prop->{root};
  Path::Tiny->new($root)->mkpath unless -d $root;
  bless {
    dir => Path::Tiny->new(tempdir( "${name}_XXXX", DIR => $root)),
  }, $class;
}

sub as_string
{
  shift->{dir}->stringify;
}

sub DESTROY
{
  my($self) = @_;
  if(-d $self->{dir} && $self->{dir}->children == 0)
  {
    rmdir($self->{dir}) || warn "unable to remove @{[ $self->{dir} ]} $!";
  }
}

1;

__END__