From 71cd1b88c0f201ac30cf44a4112810b3eeac7ec0 Mon Sep 17 00:00:00 2001
From: Charles McGarvey <chazmcgarvey@brokenzipper.com>
Date: Sat, 2 Mar 2019 13:58:28 -0700
Subject: [PATCH] add RequestHeaders middleware

---
 lib/HTTP/AnyUA/Middleware/RequestHeaders.pm | 76 +++++++++++++++++++++
 t/40-middleware-request-headers.t           | 48 +++++++++++++
 2 files changed, 124 insertions(+)
 create mode 100644 lib/HTTP/AnyUA/Middleware/RequestHeaders.pm
 create mode 100644 t/40-middleware-request-headers.t

diff --git a/lib/HTTP/AnyUA/Middleware/RequestHeaders.pm b/lib/HTTP/AnyUA/Middleware/RequestHeaders.pm
new file mode 100644
index 0000000..557271a
--- /dev/null
+++ b/lib/HTTP/AnyUA/Middleware/RequestHeaders.pm
@@ -0,0 +1,76 @@
+package HTTP::AnyUA::Middleware::RequestHeaders;
+# ABSTRACT: Middleware to add custom request headers
+
+=head1 SYNOPSIS
+
+    $any_ua->apply_middleware('RequestHeaders',
+        headers  => {connection => 'close'},
+        override => 0,
+    );
+
+=head1 DESCRIPTION
+
+This middleware adds custom headers to each request.
+
+=head1 SEE ALSO
+
+=for :list
+* L<HTTP::AnyUA::Middleware>
+
+=cut
+
+use warnings;
+use strict;
+
+our $VERSION = '9999.999'; # VERSION
+
+use parent 'HTTP::AnyUA::Middleware';
+
+use HTTP::AnyUA::Util;
+
+
+sub init {
+    my $self = shift;
+    my %args = @_;
+    $self->{override} = !!$args{override};
+    $self->{headers}  = HTTP::AnyUA::Util::normalize_headers($args{headers});
+}
+
+sub request {
+    my $self = shift;
+    my ($method, $url, $args) = @_;
+
+    if ($self->override) {
+        $args->{headers} = {
+            %{HTTP::AnyUA::Util::normalize_headers($args->{headers})},
+            %{$self->headers},
+        };
+    }
+    else {
+        $args->{headers} = {
+            %{$self->headers},
+            %{HTTP::AnyUA::Util::normalize_headers($args->{headers})},
+        };
+    }
+
+    return $self->backend->request($method, $url, $args);
+}
+
+=attr headers
+
+Get the custom headers.
+
+=cut
+
+sub headers { shift->{headers} }
+
+=attr override
+
+When true, custom headers overwrite headers in the request. The default is false (the request
+headers take precedence when defined).
+
+=cut
+
+sub override { shift->{override} }
+
+1;
diff --git a/t/40-middleware-request-headers.t b/t/40-middleware-request-headers.t
new file mode 100644
index 0000000..c15736a
--- /dev/null
+++ b/t/40-middleware-request-headers.t
@@ -0,0 +1,48 @@
+#!perl
+
+use warnings;
+use strict;
+
+use lib 't/lib';
+
+use HTTP::AnyUA;
+use Test::More tests => 5;
+
+HTTP::AnyUA->register_backend(Mock => '+MockBackend');
+
+my $any_ua  = HTTP::AnyUA->new(ua => 'Mock');
+my $backend = $any_ua->backend;
+
+$any_ua->apply_middleware('RequestHeaders',
+    headers => {
+        whatever => 'meh',
+        Foo      => 'bar',
+    },
+);
+
+my $url     = 'http://acme.tld/';
+
+$any_ua->get($url, {headers => {baz => 'qux'}});
+my $headers = ($backend->requests)[-1][2]{headers};
+is $headers->{whatever}, 'meh', 'custom header with GET';
+is $headers->{foo}, 'bar', 'normalized header';
+is $headers->{baz}, 'qux', 'request header left intact';
+
+$any_ua->get($url, {headers => {baz => 'qux', foo => 'moof'}});
+$headers = ($backend->requests)[-1][2]{headers};
+is $headers->{foo}, 'moof', 'request header takes precedence';
+
+$any_ua  = HTTP::AnyUA->new(ua => 'Mock');
+$backend = $any_ua->backend;
+
+$any_ua->apply_middleware('RequestHeaders',
+    headers => {
+        Foo => 'bar',
+    },
+    override => 1,
+);
+
+$any_ua->get($url, {headers => {foo => 'moof'}});
+$headers = ($backend->requests)[-1][2]{headers};
+is $headers->{foo}, 'bar', 'custom header takes precedence if override on';
+
-- 
2.43.0