File Coverage

blib/lib/Plack/App/Proxy/Backend/HTTP/Tiny.pm

Criterion	Covered	Total	%
statement	17	41	41.4
branch	0	10	0.0
condition			n/a
subroutine	6	8	75.0
pod	1	1	100.0
total	24	60	40.0

package Plack::App::Proxy::Backend::HTTP::Tiny;

=head1 NAME

Plack::App::Proxy::HTTP::Tiny - backend for Plack::App::Proxy

=head1 SYNOPSIS

=for markdown ```perl

    # In app.psgi
    use Plack::Builder;
    use Plack::App::Proxy::Anonymous;

    builder {
        enable "Proxy::Requests";
        Plack::App::Proxy->new(backend => 'HTTP::Tiny')->to_app;
    };

=for markdown ```

=head1 DESCRIPTION

This backend uses L to make HTTP requests.

L is a wrapper for L which is
Pure-Perl only and doesn't require any architecture specific files.

It is possible to bundle it e.g. by L.

=for readme stop

=cut

use 5.006;

use strict;
use warnings;

our $VERSION = '0.0201';

use parent qw(Plack::App::Proxy::Backend);

use HTTP::Headers;

use HTTP::Tiny::PreserveHostHeader;

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

    return sub {
        my ($respond) = @_;

        my $http = HTTP::Tiny::PreserveHostHeader->new(
            max_redirect => 0,
            %{ $self->options || {} }
        );

        my $writer;

        my $response = $http->request(
            $self->method => $self->url,
            {   headers       => $self->headers,
                content       => $self->content,
                data_callback => sub {
                    my ($data, $res) = @_;

                    return if $res->{status} =~ /^59\d+/;

                    if (not $writer) {
                        $env->{'plack.proxy.last_protocol'} = '1.1';            # meh
                        $env->{'plack.proxy.last_status'}   = $res->{status};
                        $env->{'plack.proxy.last_reason'}   = $res->{reason};
                        $env->{'plack.proxy.last_url'}      = $self->url;

                        $writer = $respond->(
                            [   $res->{status},
                                [$self->response_headers->(HTTP::Headers->new(%{ $res->{headers} }))],
                            ]
                        );
                    }

                    $writer->write($data);
                },
            }
        );

        if ($writer) {
            $writer->close;
            return;
        }

        if ($response->{status} =~ /^59\d/) {
            return $respond->([502, ['Content-Type' => 'text/html'], ["Gateway error: $response->{content}"]]);
        }

        return $respond->(
            [   $response->{status},
                [$self->response_headers->(HTTP::Headers->new(%{ $response->{headers} }))],
                [$response->{content}],
            ]
        );
    };
}

1;

=for readme continue

=head1 SEE ALSO

L, L, L,
L.

=head1 BUGS

This module might be incompatible with further versions of
L module.

If you find the bug or want to implement new features, please report it at
L

The code repository is available at
L

=head1 AUTHOR

Piotr Roszatycki

=head1 LICENSE

Copyright (c) 2014-2016, 2023 Piotr Roszatycki .

This is free software; you can redistribute it and/or modify it under
the same terms as perl itself.

See L