File Coverage

blib/lib/HTTP/Thin/UserAgent.pm

Criterion	Covered	Total	%
statement	62	128	48.4
branch	0	14	0.0
condition	1	2	50.0
subroutine	21	36	58.3
pod	2	10	20.0
total	86	190	45.2

package HTTP::Thin::UserAgent;
$HTTP::Thin::UserAgent::VERSION = '0.015';
use 5.12.1;
use warnings;

# ABSTRACT: A Thin UserAgent around some useful modules.


{
    package
        HTTP::Thin::UserAgent::HTTPExceptionWithResponse;
    use Moo::Role;
    has response => ( is => 'ro' );
}

{
    package
        HTTP::Thin::UserAgent::Error::UnexpectedResponse;

    use Moo;
    extends qw(Throwable::Error);
    with qw(HTTP::Thin::UserAgent::HTTPExceptionWithResponse);

}

{
    package
        HTTP::Thin::UserAgent::HTTP::Throwable::Factory;
        use Moo;

        extends qw(HTTP::Throwable::Factory);

        sub extra_roles {
            return qw(
                HTTP::Throwable::Role::TextBody
                HTTP::Thin::UserAgent::HTTPExceptionWithResponse
            );
        }

        # A PR for this has been sent to HTTP::Throwable when that ships we can bump the dep
        # and remove this method
        sub ident_for_status_code {
            my ($self, $code) = @_;

            my %lookup = (
                300 => 'MultipleChoices',
                301 => 'MovedPermanently',
                302 => 'Found',
                303 => 'SeeOther',
                304 => 'NotModified',
                305 => 'UseProxy',
                307 => 'TemporaryRedirect',

                400 => 'BadRequest',
                401 => 'Unauthorized',
                403 => 'Forbidden',
                404 => 'NotFound',
                405 => 'MethodNotAllowed',
                406 => 'NotAcceptable',
                407 => 'ProxyAuthenticationRequired',
                408 => 'RequestTimeout',
                409 => 'Conflict',
                410 => 'Gone',
                411 => 'LengthRequired',
                412 => 'PreconditionFailed',
                413 => 'RequestEntityTooLarge',
                414 => 'RequestURITooLong',
                415 => 'UnsupportedMediaType',
                416 => 'RequestedRangeNotSatisfiable',
                417 => 'ExpectationFailed',

                500 => 'InternalServerError',
                501 => 'NotImplemented',
                502 => 'BadGateway',
                503 => 'Status::ServiceUnavailable',
                504 => 'GatewayTimeout',
                505 => 'HTTPVersionNotSupported',
            );

            return $lookup{$code};
        }
}

{

    package
        HTTP::Thin::UserAgent::Client;

    use Moo;
    use MooX::late;
    use MooX::ChainedAttributes;
    use HTTP::Thin;
    use JSON::Any;
    use Try::Tiny;
    use Scalar::Util qw/weaken/;
    use Carp qw(confess);

    use constant TRACE => $ENV{TRACE} // 0;
    use constant UnexpectedResponse => 'HTTP::Thin::UserAgent::Error::UnexpectedResponse';
    use constant HTTPException => 'HTTP::Thin::UserAgent::HTTP::Throwable::Factory';

    has ua => (
        is      => 'ro',
        default => sub { HTTP::Thin->new() },
    );

    has request => (
        is => 'ro',
        required => 1,
    );

    has on_error => (
        is      => 'rw',
        default => sub { sub { confess $_->message } },
        chained => 1,
    );

    has decoder => (
        is => 'rw',
        chained => 1,
        default => sub {
            sub { shift->decoded_content }
        },
    );

    sub decoded_content {
        my $self = shift;
        return $self->decoder->( $self->response );
    }

    sub decode { warn 'decode is deprecated, please call decoded_content instead'; shift->decoded_content }

    has response => (
        is      => 'ro',
        lazy    => 1,
        builder => '_build_response',
        handles => { 'content' => 'decoded_content' },
    );

    sub _build_response {
        my $self    = shift;
        my $ua      = $self->ua;
        my $request = $self->request;

        warn $request->dump if TRACE;
        my $res = $ua->request($request);
        warn $res->dump if TRACE;

        if ( $res->is_error ) {
            my $e;
            if ( my $id = HTTPException->ident_for_status_code( $res->code ) ) {
                $e = HTTPException->new_exception(
                    $id => {
                        additional_headers => [ $res->headers->flatten() ],
                        response           => $res,
                    }
                );
            }
            else {
                $e = HTTPException->new_exception(
                    {
                        status_code        => $res->code,
                        reason             => $res->message,
                        additional_headers => [ $res->headers->flatten(), ],
                        response           => $res,
                    }
                );
            }

            for ($e) { $self->on_error->($e) }
        }

        return $res;
    }

    sub as_json {
        my $self = shift;

        my $request = $self->request;

        $request->header(
            'Accept'       => 'application/json',
            'Content-Type' => 'application/json',
        );

        if ( my $data = shift ) {
            $request->content( JSON::Any->encode($data) );
        }

        weaken($self);
        $self->decoder(
            sub {
                my $res          = shift;
                my $content_type = $res->header('Content-Type');
                my $data         = try {
                    die "Content-Type was $content_type not application/json"
                        unless $content_type =~ m'application/json';
                    JSON::Any->decode( $res->decoded_content );
                }
                catch {
                    my $error = UnexpectedResponse->new(
                        message  => $_,
                        response => $res,
                    );
                    for ($error) {
                        $self->on_error->($error);
                    }
                };
            }
        );
        return $self;
    }

    sub dump { require Data::Dumper; return Data::Dumper::Dumper(shift) }

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

        weaken($self);
        $self->decoder(
            sub {
                my $res = shift;
                my $data = try { $scraper->scrape( $res->decoded_content ) }
                catch {
                    my $error = UnexpectedResponse->new(
                        message  => $_,
                        response => $res
                    );
                    for ($error) { $self->on_error->($error); }
                };
                return $data;
            }
        );
        return $self;
    }

    sub tree {
        my ($self) = @_;
        my $t = HTML::TreeBuilder::XPath->new;
        $t->store_comments(1) if ( $t->can('store_comments') );
        $t->ignore_unknown(0);
        $t->parse( $self->content );
        return $t;
    }

    sub find {
        my ( $self, $exp ) = @_;

        my $xpath =
            $exp =~ m!^(?:/|id\()!
          ? $exp
          : HTML::Selector::XPath::selector_to_xpath($exp);

        my @nodes = try { $self->tree->findnodes($xpath) }
        catch {
            for ($_) { $self->on_error($_) }
        };
        return unless @nodes;
        return \@nodes;
    }

}

use parent qw(Exporter);
use Import::Into;
use HTTP::Request::Common;
use Web::Scraper;

our @EXPORT = qw(http);

sub import {
    shift->export_to_level(1);
    HTTP::Request::Common->import::into( scalar caller );
    Web::Scraper->import::into( scalar caller );
}

sub http { HTTP::Thin::UserAgent::Client->new( request => shift ) }

1;

__END__