view release on metacpan or  search on metacpan

lib/Alien/Build/Plugin/Fetch/HTTPTiny.pm  view on Meta::CPAN

    {
      $meta->add_requires('share' => $mod => $reqs->{$mod});
    }
  }

  $meta->register_hook( fetch => sub {
    my($build, $url, %options) = @_;
    $url ||= $self->url;

    $url = URI->new($url) unless ref($url) && $url->isa('URI');

    my %headers;
    if(my $headers = $options{http_headers})
    {
      if(ref $headers eq 'ARRAY')
      {
        my @headers = @$headers;
        while(@headers)
        {
          my $key = shift @headers;
          my $value = shift @headers;
          unless(defined $key && defined $value)
          {
            $build->log("Fetch for $url with http_headers contains undef key or value");
            next;
          }
          push @{ $headers{$key} }, $value;
        }
      }
      else
      {
        $build->log("Fetch for $url with http_headers that is not an array reference");
      }
    }

    my $ua = HTTP::Tiny->new(
      agent      => "Alien-Build/@{[ $Alien::Build::VERSION || 'dev' ]} ",
      verify_SSL => $build->download_rule =~ /encrypt/ ? 1 : 0,
    );
    my $res = $ua->get($url, { headers => \%headers });

    unless($res->{success})
    {
      my $status = $res->{status} || '---';
      my $reason = $res->{reason} || 'unknown';

      $build->log("$status $reason fetching $url");
      if($status == 599)
      {
        $build->log("exception: $_") for split /\n/, $res->{content};

        my($can_ssl, $why_ssl) = HTTP::Tiny->can_ssl;
        if(! $can_ssl)
        {
          if($res->{redirects}) {
            foreach my $redirect (@{ $res->{redirects} })
            {
              if(defined $redirect->{headers}->{location} && $redirect->{headers}->{location} =~ /^https:/)
              {
                $build->log("An attempt at a SSL URL https was made, but your HTTP::Tiny does not appear to be able to use https.");
                $build->log("Please see: https://metacpan.org/pod/Alien::Build::Manual::FAQ#599-Internal-Exception-errors-downloading-packages-from-the-internet");
              }
            }
          }
        }
      }

      die "error fetching $url: $status $reason";
    }

    my($type) = split /;/, $res->{headers}->{'content-type'};
    $type = lc $type;
    my $base            = URI->new($res->{url});
    my $filename        = File::Basename::basename do { my $name = $base->path; $name =~ s{/$}{}; $name };

    # TODO: this doesn't get exercised by t/bin/httpd
    if(my $disposition = $res->{headers}->{"content-disposition"})
    {
      # Note: from memory without quotes does not match the spec,
      # but many servers actually return this sort of value.
      if($disposition =~ /filename="([^"]+)"/ || $disposition =~ /filename=([^\s]+)/)
      {
        $filename = $1;
      }
    }

    if($type eq 'text/html')
    {
      return {
        type     => 'html',
        base     => $base->as_string,
        content  => $res->{content},
        protocol => $url->scheme,
      };
    }
    else
    {
      return {
        type     => 'file',
        filename => $filename || 'downloadedfile',
        content  => $res->{content},
        protocol => $url->scheme,
      };
    }

  });

  $self;
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Alien::Build::Plugin::Fetch::HTTPTiny - Plugin for fetching files using HTTP::Tiny

=head1 VERSION

version 2.84

=head1 SYNOPSIS