File Coverage

blib/lib/HTTP/Tiny/PreserveHostHeader.pm
Criterion Covered Total %
statement 11 25 44.0
branch 0 6 0.0
condition 0 2 0.0
subroutine 4 6 66.6
pod n/a
total 15 39 38.4


line stmt bran cond sub pod time code
1             package HTTP::Tiny::PreserveHostHeader;
2              
3             =head1 NAME
4              
5             HTTP::Tiny::PreserveHostHeader - Preserve Host header on requests
6              
7             =head1 SYNOPSIS
8              
9             =for markdown ```perl
10              
11             use HTTP::Tiny::PreserveHostHeader;
12              
13             my $response = HTTP::Tiny::PreserveHostHeader->new->get(
14             'http://example.com', {
15             headers => {
16             Host => 'example.net',
17             }
18             }
19             );
20              
21             =for markdown ```
22              
23             =head1 DESCRIPTION
24              
25             This module extends L and allows to preserve original C
26             header from HTTP request.
27              
28             The L is strictly compatible with HTTP 1.1 spec, section 14.23:
29              
30             =over
31              
32             The Host field value MUST represent the naming authority of the origin
33             server or gateway given by the original URL.
34              
35             =back
36              
37             It means that L always rewrite C header to the value
38             taken from URL.
39              
40             Some non-standard HTTP clients, such as reverse HTTP proxy, need to override
41             C header to other value.
42              
43             =for readme stop
44              
45             =cut
46              
47 1     1   95046 use 5.006;
  1         4  
48              
49 1     1   6 use strict;
  1         2  
  1         21  
50 1     1   5 use warnings;
  1         2  
  1         66  
51              
52             our $VERSION = '0.0103';
53              
54 1     1   519 use parent qw(HTTP::Tiny);
  1         289  
  1         5  
55              
56             ## no critic(Subroutines::ProhibitUnusedPrivateSubroutines)
57             sub _prepare_headers_and_cb {
58 0     0     my ($self, $request, $args, $url, $auth) = @_;
59              
60 0           my $host;
61              
62 0           while (my ($k, $v) = each %{ $args->{headers} }) {
  0            
63 0 0         if (lc $k eq 'host') {
64 0           $host = $v;
65 0           delete $args->{headers}{$k};
66             }
67             }
68              
69 0           $self->SUPER::_prepare_headers_and_cb($request, $args, $url, $auth);
70              
71 0 0         $request->{headers}{host} = $host if $host;
72              
73 0           return;
74             }
75              
76             ## no critic(Subroutines::ProhibitUnusedPrivateSubroutines)
77             sub _agent {
78 0     0     my ($self) = @_;
79 0 0         my $class = ref $self ? ref $self : $self;
80 0           (my $default_agent = $class) =~ s{::}{-}g;
81             ## no critic(Subroutines::ProtectPrivateSubs)
82 0   0       return $default_agent . "/" . ($class->VERSION || 0) . " " . HTTP::Tiny->_agent;
83             }
84              
85             1;
86              
87             =for readme continue
88              
89             =head1 SEE ALSO
90              
91             L, L.
92              
93             =head1 BUGS
94              
95             If you find the bug or want to implement new features, please report it at
96             L
97              
98             The code repository is available at
99             L
100              
101             =head1 AUTHOR
102              
103             Piotr Roszatycki
104              
105             =head1 LICENSE
106              
107             Copyright (c) 2014-2016, 2023 Piotr Roszatycki .
108              
109             This is free software; you can redistribute it and/or modify it under
110             the same terms as perl itself.
111              
112             See L