File Coverage

blib/lib/Alien/Build/Plugin/Download/Negotiate.pm

Criterion	Covered	Total	%
statement	67	79	84.8
branch	43	54	79.6
condition	11	15	73.3
subroutine	10	10	100.0
pod	2	2	100.0
total	133	160	83.1

package Alien::Build::Plugin::Download::Negotiate;

use strict;
use warnings;
use 5.008004;
use Alien::Build::Plugin;
use Alien::Build::Util qw( _has_ssl );
use Carp ();

# ABSTRACT: Download negotiation plugin
our $VERSION = '2.47'; # VERSION


has '+url' => undef;


has 'filter'  => undef;


has 'version' => undef;


has 'ssl'     => 0;


has 'passive' => 0;

has 'scheme'  => undef;


has 'bootstrap_ssl' => 0;


has 'prefer' => 1;


has 'decoder' => undef;


sub pick
{
  my($self) = @_;
  my($fetch, @decoders) = $self->_pick;
  if($self->decoder)
  {
    @decoders = ref $self->decoder ? @{ $self->decoder } : ($self->decoder);
  }
  ($fetch, @decoders);
}

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

  if(eval { require Mojo::DOM58; Mojo::DOM58->VERSION(1.00); 1 })
  { return "Decode::Mojo" }
  elsif(eval { require Mojo::DOM; require Mojolicious; Mojolicious->VERSION('7.00'); 1 })
  { return "Decode::Mojo" }
  elsif(eval { require HTML::LinkExtor; 1; })
  { return "Decode::HTML" }
  else
  { return "Decode::Mojo" }
}

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

  $self->scheme(
    $self->url !~ m!(ftps?|https?|file):!i
      ? 'file'
      : $self->url =~ m!^([a-z]+):!i
  ) unless defined $self->scheme;

  if($self->scheme eq 'https' || ($self->scheme eq 'http' && $self->ssl))
  {
    if($self->bootstrap_ssl && ! _has_ssl)
    {
      return (['Fetch::CurlCommand','Fetch::Wget'], __PACKAGE__->_pick_decoder);
    }
    elsif(_has_ssl)
    {
      return ('Fetch::HTTPTiny', __PACKAGE__->_pick_decoder);
    }
    elsif(do { require Alien::Build::Plugin::Fetch::CurlCommand; Alien::Build::Plugin::Fetch::CurlCommand->protocol_ok('https') })
    {
      return ('Fetch::CurlCommand', __PACKAGE__->_pick_decoder);
    }
    else
    {
      return ('Fetch::HTTPTiny', __PACKAGE__->_pick_decoder);
    }
  }
  elsif($self->scheme eq 'http')
  {
    return ('Fetch::HTTPTiny', __PACKAGE__->_pick_decoder);
  }
  elsif($self->scheme eq 'ftp')
  {
    if($ENV{ftp_proxy} || $ENV{all_proxy})
    {
      return $self->scheme =~ /^ftps?/
        ? ('Fetch::LWP', 'Decode::DirListing', __PACKAGE__->_pick_decoder)
        : ('Fetch::LWP', __PACKAGE__->_pick_decoder);
    }
    else
    {
      return ('Fetch::NetFTP');
    }
  }
  elsif($self->scheme eq 'file')
  {
    return ('Fetch::Local');
  }
  else
  {
    die "do not know how to handle scheme @{[ $self->scheme ]} for @{[ $self->url ]}";
  }
}

sub init
{
  my($self, $meta) = @_;

  unless(defined $self->url)
  {
    if(defined $meta->prop->{start_url})
    {
      $self->url($meta->prop->{start_url});
    }
    else
    {
      Carp::croak "url is a required property unless you use the start_url directive";
    }
  }

  $meta->add_requires('share' => 'Alien::Build::Plugin::Download::Negotiate' => '0.61')
    if $self->passive;

  $meta->prop->{plugin_download_negotiate_default_url} = $self->url;

  my($fetch, @decoders) = $self->pick;

  $fetch = [ $fetch ] unless ref $fetch;

  foreach my $fetch (@$fetch)
  {
    my @args;
    push @args, ssl => $self->ssl;
    # For historical reasons, we pass the URL into older fetch plugins, because
    # this used to be the interface.  Using start_url is now preferred!
    push @args, url => $self->url if $fetch =~ /^Fetch::(HTTPTiny|LWP|Local|LocalDir|NetFTP|CurlCommand)$/;
    push @args, passive => $self->passive if $fetch eq 'Fetch::NetFTP';
    push @args, bootstrap_ssl => $self->bootstrap_ssl if $self->bootstrap_ssl;

    $meta->apply_plugin($fetch, @args);
  }

  if($self->version)
  {
    $meta->apply_plugin($_) for @decoders;

    if(defined $self->prefer && ref($self->prefer) eq 'CODE')
    {
      $meta->add_requires('share' => 'Alien::Build::Plugin::Download::Negotiate' => '1.30');
      $meta->register_hook(
        prefer => $self->prefer,
      );
    }
    elsif($self->prefer)
    {
      $meta->apply_plugin('Prefer::SortVersions',
        (defined $self->filter ? (filter => $self->filter) : ()),
        version => $self->version,
      );
    }
    else
    {
      $meta->add_requires('share' => 'Alien::Build::Plugin::Download::Negotiate' => '1.30');
    }
  }
}

1;

__END__