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


line stmt bran cond sub pod time code
1             package Plack::App::Proxy::Backend::HTTP::Tiny;
2              
3             =head1 NAME
4              
5             Plack::App::Proxy::HTTP::Tiny - Backend for Plack::App::Proxy
6              
7             =head1 SYNOPSIS
8              
9             =for markdown ```perl
10              
11             # In app.psgi
12             use Plack::Builder;
13              
14             builder {
15             enable "Proxy::Requests";
16             Plack::App::Proxy->new(backend => 'HTTP::Tiny', options => {
17             timeout => 15
18             })->to_app;
19             };
20              
21             =for markdown ```
22              
23             =head1 DESCRIPTION
24              
25             This backend uses L to make HTTP requests.
26              
27             L is a wrapper for L which is
28             Pure-Perl only and doesn't require any architecture specific files.
29              
30             It is possible to bundle it e.g. by L.
31              
32             All I from the L constructor goes to
33             L constructor. This backend sets some default
34             options for L:
35              
36             =for markdown ```perl
37              
38             max_redirect => 0,
39             http_proxy => undef,
40             https_proxy => undef,
41             all_proxy => undef,
42              
43             =for markdown ```
44              
45             =for readme stop
46              
47             =cut
48              
49 1     1   71312 use 5.006;
  1         5  
50              
51 1     1   5 use strict;
  1         3  
  1         20  
52 1     1   5 use warnings;
  1         2  
  1         59  
53              
54             our $VERSION = '0.0204';
55              
56 1     1   583 use parent qw(Plack::App::Proxy::Backend);
  1         324  
  1         6  
57              
58 1     1   16185 use HTTP::Headers;
  1         6843  
  1         36  
59              
60 1     1   457 use HTTP::Tiny::PreserveHostHeader;
  1         52572  
  1         353  
61              
62             sub call {
63 0     0 1   my ($self, $env) = @_;
64              
65             return sub {
66 0     0     my ($respond) = @_;
67              
68             my $http = HTTP::Tiny::PreserveHostHeader->new(
69             max_redirect => 0,
70             http_proxy => undef,
71             https_proxy => undef,
72             all_proxy => undef,
73 0 0         %{ $self->options || {} }
  0            
74             );
75              
76 0           my $writer;
77              
78             my $response = $http->request(
79             $self->method => $self->url,
80             {
81             headers => $self->headers,
82             content => $self->content,
83             data_callback => sub {
84 0           my ($data, $res) = @_;
85              
86 0 0         return if $res->{status} =~ /^59\d+/;
87              
88 0 0         if (not $writer) {
89 0           $env->{'plack.proxy.last_protocol'} = '1.1'; # meh
90 0           $env->{'plack.proxy.last_status'} = $res->{status};
91 0           $env->{'plack.proxy.last_reason'} = $res->{reason};
92 0           $env->{'plack.proxy.last_url'} = $self->url;
93              
94             $writer = $respond->(
95             [
96             $res->{status},
97 0           [$self->response_headers->(HTTP::Headers->new(%{ $res->{headers} }))],
  0            
98             ]
99             );
100             }
101              
102 0           $writer->write($data);
103             },
104             }
105 0           );
106              
107 0 0         if ($writer) {
108 0           $writer->close;
109 0           return;
110             }
111              
112 0 0         if ($response->{status} =~ /^59\d/) {
113 0           return $respond->([502, ['Content-Type' => 'text/html'], ["Gateway error: $response->{content}"]]);
114             }
115              
116             return $respond->(
117             [
118             $response->{status},
119 0           [$self->response_headers->(HTTP::Headers->new(%{ $response->{headers} }))],
120 0           [$response->{content}],
121             ]
122             );
123 0           };
124             }
125              
126             1;
127              
128             =for readme continue
129              
130             =head1 SEE ALSO
131              
132             L, L, L,
133             L, L.
134              
135             =head1 BUGS
136              
137             This module might be incompatible with further versions of
138             L module.
139              
140             If you find the bug or want to implement new features, please report it at
141             L
142              
143             The code repository is available at
144             L
145              
146             =head1 AUTHOR
147              
148             Piotr Roszatycki
149              
150             =head1 LICENSE
151              
152             Copyright (c) 2014-2016, 2023 Piotr Roszatycki .
153              
154             This is free software; you can redistribute it and/or modify it under
155             the same terms as perl itself.
156              
157             See L