File Coverage

blib/lib/Alien/Build/Plugin/Fetch/LWP.pm

Criterion	Covered	Total	%
statement	22	42	52.3
branch	2	14	14.2
condition	3	17	17.6
subroutine	6	7	85.7
pod	1	1	100.0
total	34	81	41.9

package Alien::Build::Plugin::Fetch::LWP;

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

# ABSTRACT: Plugin for fetching files using LWP
our $VERSION = '2.47'; # VERSION


has '+url' => '';


has ssl => 0;

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

  $meta->add_requires('share' => 'LWP::UserAgent' => 0 );

  $meta->prop->{start_url} ||= $self->url;
  $self->url($meta->prop->{start_url});
  $self->url || Carp::croak('url is a required property');

  if($self->url =~ /^https:/ || $self->ssl)
  {
    $meta->add_requires('share' => 'LWP::Protocol::https' => 0 );
  }

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

    my @headers;
    if(my $headers = $options{http_headers})
    {
      if(ref $headers eq 'ARRAY')
      {
        @headers = @$headers;
      }
      else
      {
        $build->log("Fetch for $url with http_headers that is not an array reference");
      }
    }

    my $ua = LWP::UserAgent->new;
    $ua->env_proxy;
    my $res = $ua->get($url, @headers);

    die "error fetching $url: @{[ $res->status_line ]}"
      unless $res->is_success;

    my($type, $charset) = $res->content_type_charset;
    my $base            = $res->base;
    my $filename        = $res->filename;

    if($type eq 'text/html')
    {
      return {
        type    => 'html',
        charset => $charset,
        base    => "$base",
        content => $res->decoded_content || $res->content,
      };
    }
    elsif($type eq 'text/ftp-dir-listing')
    {
      return {
        type => 'dir_listing',
        base => "$base",
        content => $res->decoded_content || $res->content,
      };
    }
    else
    {
      return {
        type     => 'file',
        filename => $filename || 'downloadedfile',
        content  => $res->content,
      };
    }

  });

  $self;
}

1;

__END__