view release on metacpan or  search on metacpan

lib/Alien/Build/Plugin/Extract/CommandLine.pm  view on Meta::CPAN

use strict;
use warnings;
use 5.008004;
use Alien::Build::Plugin;
use Path::Tiny ();
use File::Which ();
use File::chdir;
use File::Temp qw( tempdir );
use Capture::Tiny qw( capture_merged );

# ABSTRACT: Plugin to extract an archive using command line tools
our $VERSION = '2.84'; # VERSION


has '+format' => 'tar';


sub gzip_cmd
{
  _which('gzip') ? 'gzip' : undef;
}


sub _which { scalar File::Which::which(@_) }

sub bzip2_cmd
{
  _which('bzip2') ? 'bzip2' : undef;
}


sub xz_cmd
{
  _which('xz') ? 'xz' : undef;
}


{
  my $bsd_tar;

  # Note: GNU tar can be iffy to very bad on windows, where absolute
  # paths get confused with remote tars.  We used to assume that 'tar.exe'
  # is borked on Windows, but recent versions of Windows 10 come bundled
  # with bsdtar (libarchive) named 'tar.exe', and we should definitely
  # prefer that to ptar.
  sub _windows_tar_is_bsdtar
  {
    return 1 if $^O ne 'MSWin32';
    return $bsd_tar if defined $bsd_tar;
    my($out) = capture_merged {
      system 'tar', '--version';
    };
    return $bsd_tar = $out =~ /bsdtar/ ? 1 : 0
  }
}

sub tar_cmd
{
  _which('bsdtar')
    ? 'bsdtar'
    # Slowlaris /usr/bin/tar doesn't seem to like pax global header
    # but seems to have gtar in the path by default, which is okay with it
    : $^O eq 'solaris' && _which('gtar')
      ? 'gtar'
      # See note above for Windows logic.
      : _which('tar') && _windows_tar_is_bsdtar()
        ? 'tar'
        : _which('ptar')
          ? 'ptar'
          : undef;
};


sub unzip_cmd
{
  if($^O eq 'MSWin32' && _which('tar') && _windows_tar_is_bsdtar())
  {
    (_which('tar'), 'xf');
  }
  else
  {
    _which('unzip') ? 'unzip' : undef;
  }
}

sub _run
{
  my(undef, $build, @cmd) = @_;
  $build->log("+ @cmd");
  system @cmd;
  die "execute failed" if $?;
}

sub _cp
{
  my(undef, $build, $from, $to) = @_;
  require File::Copy;
  $build->log("copy $from => $to");
  File::Copy::cp($from, $to) || die "unable to copy: $!";
}

sub _mv
{
  my(undef, $build, $from, $to) = @_;
  $build->log("move $from => $to");
  rename($from, $to) || die "unable to rename: $!";
}

sub _dcon
{
  my($self, $src) = @_;

  my $name;
  my $cmd;

  if($src =~ /\.(gz|tgz|Z|taz)$/)
  {
    $self->gzip_cmd(_which('gzip')) unless defined $self->gzip_cmd;
    if($src =~ /\.(gz|tgz)$/)
    {
      $cmd = $self->gzip_cmd unless $self->_tar_can('tar.gz');