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