view release on metacpan or  search on metacpan

lib/Catmandu/Importer.pm  view on Meta::CPAN

package Catmandu::Importer;

use Catmandu::Sane;

our $VERSION = '1.2025';

use Catmandu::Util       qw(io is_value is_string is_array_ref is_hash_ref);
use Catmandu::Util::Path qw(as_path);
use LWP::UserAgent;
use HTTP::Request ();
use URI           ();
use URI::Template ();
use Moo::Role;
use namespace::clean;

with 'Catmandu::Logger';
with 'Catmandu::Iterable';
with 'Catmandu::IterableOnce';
with 'Catmandu::Fixable';
with 'Catmandu::Serializer';

around generator => sub {
    my ($orig, $self) = @_;

    my $generator = $orig->($self);

    if (my $fixer = $self->_fixer) {
        $generator = $fixer->fix($generator);
    }

    if (defined(my $path = $self->data_path)) {
        my $getter = as_path($path)->getter;
        return sub {
            state @buf;
            while (1) {
                return shift @buf if @buf;
                @buf = @{$getter->($generator->() // return)};
                next;
            }
        };
    }

    $generator;
};

has file => (is => 'lazy', init_arg => undef);
has _file_template =>
    (is => 'ro', predicate => 'has_file', init_arg => 'file');
has variables         => (is => 'ro', predicate => 1);
has fh                => (is => 'ro', lazy      => 1, builder => 1);
has encoding          => (is => 'ro', builder   => 1);
has data_path         => (is => 'ro');
has user_agent        => (is => 'ro');
has http_method       => (is => 'lazy');
has http_headers      => (is => 'lazy');
has http_agent        => (is => 'ro', predicate => 1);
has http_max_redirect => (is => 'ro', predicate => 1);
has http_timeout      => (is => 'ro', default   => sub {180});   # LWP default
has http_verify_hostname => (is => 'ro', default   => sub {1});
has http_retry           => (is => 'ro', predicate => 1);
has http_timing          => (is => 'ro', predicate => 1);
has http_body            => (is => 'ro', predicate => 1);
has _http_client => (
    is       => 'ro',
    lazy     => 1,
    builder  => '_build_http_client',
    init_arg => 'user_agent'
);
has _http_timing_tries => (is => 'lazy');
has ignore_404         => (is => 'ro');

lib/Catmandu/Importer.pm  view on Meta::CPAN

                        $vars = [split ',', $vars];
                    }
                    for my $var (@$vars) {
                        $body =~ s/{\w+}/$var/;
                    }
                }
            }
        }

        my $content = $self->_http_request(
            $self->http_method, $file, $self->http_headers,
            $body, $self->_http_timing_tries,
        );

        return io(\$content, mode => 'r', binmode => $_[0]->encoding);
    }

    io($file, mode => 'r', binmode => $_[0]->encoding);
}

sub _build_http_headers {
    [];
}

sub _build_http_method {
    'GET';
}

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

    if ($self->has_http_timing) {
        my @timing_tries = $self->http_timing =~ /(\d+(?:\.\d+)*)/g;
        return \@timing_tries;
    }
    elsif ($self->has_http_retry) {
        my @timing_tries = (1) x $self->http_retry;
        return \@timing_tries;
    }
    return;
}

sub _build_http_client {
    my ($self) = @_;
    my $ua = LWP::UserAgent->new;
    $ua->timeout($self->http_timeout);
    $ua->agent($self->http_agent) if $self->has_http_agent;
    $ua->max_redirect($self->http_max_redirect)
        if $self->has_http_max_redirect;
    $ua->ssl_opts(verify_hostname => $self->http_verify_hostname);
    $ua->protocols_allowed([qw(http https)]);
    $ua->env_proxy;
    $ua;
}

sub _http_request {
    my ($self, $method, $url, $headers, $body, $timing_tries) = @_;

    my $client = $self->_http_client;

    my $req = HTTP::Request->new($method, $url, $headers || []);
    $req->content($body) if defined $body;

    my $res = $client->request($req);

    if ($res->code =~ /^408|500|502|503|504$/ && $timing_tries) {
        my @tries = @$timing_tries;
        while (my $sleep = shift @tries) {
            sleep $sleep;
            $res = $client->request($req->clone);
            last if $res->code !~ /^408|500|502|503|504$/;
        }
    }

    my $res_body = $res->decoded_content;

    unless ($res->is_success) {
        my $res_headers = [];
        for my $header ($res->header_field_names) {
            my $val = $res->header($header);
            push @$res_headers, $header, $val;
        }
        Catmandu::HTTPError->throw(
            {
                code             => $res->code,
                message          => $res->status_line,
                url              => $url,
                method           => $method,
                request_headers  => $headers,
                request_body     => $body,
                response_headers => $res_headers,
                response_body    => $res_body,
            }
        );
    }

    $res_body;
}

sub readline {
    warnings::warnif("deprecated",
        "readline is deprecated, fh->getline instead");
    $_[0]->fh->getline;
}

sub readall {
    warnings::warnif("deprecated",
        "readall is deprecated, join('',fh->getlines) instead");
    join '', $_[0]->fh->getlines;
}

1;

__END__

=pod

=head1 NAME

Catmandu::Importer - Namespace for packages that can import