add middleware
authorCharles McGarvey <chazmcgarvey@brokenzipper.com>
Fri, 17 Mar 2017 03:29:10 +0000 (21:29 -0600)
committerCharles McGarvey <chazmcgarvey@brokenzipper.com>
Fri, 17 Mar 2017 03:37:44 +0000 (21:37 -0600)
Includes ContentLength and Runtime as basic examples.

lib/HTTP/AnyUA.pm
lib/HTTP/AnyUA/Middleware.pm [new file with mode: 0644]
lib/HTTP/AnyUA/Middleware/ContentLength.pm [new file with mode: 0644]
lib/HTTP/AnyUA/Middleware/Runtime.pm [new file with mode: 0644]
lib/HTTP/AnyUA/Util.pm
t/40-middleware-content-length.t [new file with mode: 0644]
t/40-middleware-runtime.t [new file with mode: 0644]

index c340913a159ebd602830197ba30b019af321b1ac..75122b83ac48ee186a066f61f2d286fb256726e6 100644 (file)
@@ -338,11 +338,13 @@ use Scalar::Util;
 
 
 our $BACKEND_NAMESPACE;
+our $MIDDLEWARE_NAMESPACE;
 our @BACKENDS;
 our %REGISTERED_BACKENDS;
 
 BEGIN {
-    $BACKEND_NAMESPACE = __PACKAGE__ . '::Backend';
+    $BACKEND_NAMESPACE      = __PACKAGE__ . '::Backend';
+    $MIDDLEWARE_NAMESPACE   = __PACKAGE__ . '::Middleware';
 }
 
 
@@ -509,10 +511,7 @@ sub post_form {
     (@_ == 3 || @_ == 4 && ref $args eq 'HASH')
         or _usage(q{$any_ua->post_form($url, $formdata, \%options)});
 
-    my $headers = {};
-    while (my ($key, $value) = each %{$args->{headers} || {}}) {
-        $headers->{lc $key} = $value;
-    }
+    my $headers = HTTP::AnyUA::Util::normalize_headers($args->{headers});
     delete $args->{headers};
 
     return $self->request(POST => $url, {
@@ -552,13 +551,7 @@ sub mirror {
     @_ == 3 || (@_ == 4 && ref $args eq 'HASH')
         or _usage(q{$any_ua->mirror($url, $filepath, \%options)});
 
-    if (exists $args->{headers}) {
-        my $headers = {};
-        while (my ($key, $value) = each %{$args->{headers} || {}}) {
-            $headers->{lc($key)} = $value;
-        }
-        $args->{headers} = $headers;
-    }
+    $args->{headers} = HTTP::AnyUA::Util::normalize_headers($args->{headers});
 
     if (-e $file and my $mtime = (stat($file))[9]) {
         $args->{headers}{'if-modified-since'} ||= HTTP::AnyUA::Util::http_date($mtime);
@@ -613,6 +606,44 @@ sub mirror {
     }
 }
 
+=method apply_middleware
+
+    $any_ua->apply_middleware($middleware_package);
+    $any_ua->apply_middleware($middleware_package, %args);
+    $any_ua->apply_middleware($middleware_obj);
+
+Wrap the backend with some new middleware. Middleware packages are relative to the
+C<HTTP::AnyUA::Middleware::> namespace unless prefixed with a C<+>.
+
+This effectively replaces the L</backend> with a new object that wraps the previous backend.
+
+This can be used multiple times to add multiple layers of middleware, and order matters. The last
+middleware applied is the first one to see the request and last one to get the response. For
+example, if you apply middleware that does logging and middleware that does caching (and
+short-circuits on a cache hit), applying your logging middleware I<first> will cause only cache
+misses to be logged whereas applying your cache middleware first will allow all requests to be
+logged.
+
+See L<HTTP::AnyUA::Middleware> for more information about what middleware is and how to write your
+own middleware.
+
+=cut
+
+sub apply_middleware {
+    my $self    = shift;
+    my $class   = shift;
+
+    if (!ref $class) {
+        $class = "${MIDDLEWARE_NAMESPACE}::${class}" unless $class =~ s/^\+//;
+        $self->_module_loader->load($class);
+    }
+
+    $self->{backend} = $class->wrap($self->backend, @_);
+    $self->_check_response_is_future($self->response_is_future);
+
+    return $self;
+}
+
 =method register_backend
 
     HTTP::AnyUA->register_backend($user_agent_package => $backend_package);
diff --git a/lib/HTTP/AnyUA/Middleware.pm b/lib/HTTP/AnyUA/Middleware.pm
new file mode 100644 (file)
index 0000000..21b6db8
--- /dev/null
@@ -0,0 +1,154 @@
+package HTTP::AnyUA::Middleware;
+# ABSTRACT: A base class for HTTP::AnyUA middleware
+
+=head1 SYNOPSIS
+
+    package HTTP::AnyUA::Middleware::MyMiddleware;
+
+    use parent 'HTTP::AnyUA::Middleware';
+
+    sub request {
+        my ($self, $method, $url, $args) = @_;
+
+        # Maybe do something with the request args here.
+
+        # Let backend handle the response:
+        my $response = $self->backend($method, $url, $args);
+
+        my $handle_response = sub {
+            my $response = shift;
+
+            # Maybe do something with the response here.
+
+            return $response;
+        };
+
+        if ($self->response_is_future) {
+            $response->transform(
+                done => $handle_response,
+                fail => $handle_response,
+            );
+        }
+        else {
+            $response = $handle_response->($response);
+        }
+
+        return $response;
+    }
+
+=head1 DESCRIPTION
+
+This module provides an interface for an L<HTTP::AnyUA> "middleware," which is a component that sits
+between an L<HTTP::AnyUA> object and the L<backend|HTTP::AnyUA::Backend> (which may in fact be
+another middleware).
+
+The easiest way to use middleware is to use L<HTTP::AnyUA/apply_middleware>.
+
+The middleware mechanism can be used to munge or react to requests and responses to and from the
+backend user agent. Middlewares are a completely optional part of L<HTTP::AnyUA>. They can be
+wrapped around each other to create multiple layers and interesting possibilities. The functionality
+provided by middleware may be alternative to features provided by some of the supported user agents,
+themselves, but implementing functionality on this layer makes it work for I<all> the user agents.
+
+=cut
+
+use warnings;
+use strict;
+
+our $VERSION = '9999.999'; # VERSION
+
+sub _croak { require Carp; Carp::croak(@_) }
+sub _usage { _croak("Usage: @_\n") }
+
+
+=method new
+
+    $middleware = HTTP::AnyUA::Middleware::MyMiddleware->new($backend);
+    $middleware = HTTP::AnyUA::Middleware::MyMiddleware->new($backend, %args);
+
+Construct a new middleware.
+
+=cut
+
+sub new {
+    my $class   = shift;
+    my $backend = shift or die 'Backend is required';
+    my $self = bless {backend => $backend}, $class;
+    $self->init(@_);
+    return $self;
+}
+
+=method init
+
+Called by the default constructor with the middleware arguments.
+
+This may be overridden by implementations instead of the constructor.
+
+=cut
+
+sub init {}
+
+=method wrap
+
+    $middleware = HTTP::AnyUA::Middleware::MyMiddleware->wrap($backend, %args);
+    $middleware->wrap($backend);
+
+Construct a new middleware or, when called on an instance, set a new backend on an existing
+middleware.
+
+=cut
+
+sub wrap {
+    my $self    = shift;
+    my $backend = shift or _usage($self . q{->wrap($backend, %args)});
+
+    if (ref $self) {
+        $self->{backend} = $backend;
+    }
+    else {
+        $self = $self->new($backend, @_);
+    }
+
+    return $self;
+}
+
+=method request
+
+    $response = $middleware->request($method => $url, \%options);
+
+Make a request, get a response.
+
+This should be overridden by implementations to do whatever they want with or to the request and/or
+response.
+
+=cut
+
+sub request { shift->backend->request(@_) }
+
+=attr backend
+
+Get the current backend that is wrapped.
+
+=cut
+
+sub backend { shift->{backend} }
+
+=attr ua
+
+Get the backend user agent.
+
+=cut
+
+sub ua { shift->backend->ua(@_) }
+
+=attr response_is_future
+
+Get whether or not responses are L<Future> objects. Default is whatever the backend returns.
+
+This may be overridden by implementations.
+
+=cut
+
+sub response_is_future { shift->backend->response_is_future(@_) }
+
+1;
diff --git a/lib/HTTP/AnyUA/Middleware/ContentLength.pm b/lib/HTTP/AnyUA/Middleware/ContentLength.pm
new file mode 100644 (file)
index 0000000..750316f
--- /dev/null
@@ -0,0 +1,44 @@
+package HTTP::AnyUA::Middleware::ContentLength;
+# ABSTRACT: Middleware to add Content-Length header automatically
+
+=head1 SYNOPSIS
+
+    $any_ua->apply_middleware('ContentLength');
+
+=head1 DESCRIPTION
+
+This middleware adds a Content-Length header to the request if the content is known (i.e. the
+"content" field of the request options is a string instead of a coderef) and if the header is not
+already set.
+
+=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 request {
+    my $self = shift;
+    my ($method, $url, $args) = @_;
+
+    $args->{headers} = HTTP::AnyUA::Util::normalize_headers($args->{headers});
+
+    if (!defined $args->{headers}{'content-length'} && $args->{content} && !ref $args->{content}) {
+        $args->{headers}{'content-length'} = length $args->{content};
+    }
+
+    return $self->backend->request($method, $url, $args);
+}
+
+1;
diff --git a/lib/HTTP/AnyUA/Middleware/Runtime.pm b/lib/HTTP/AnyUA/Middleware/Runtime.pm
new file mode 100644 (file)
index 0000000..ed1643c
--- /dev/null
@@ -0,0 +1,59 @@
+package HTTP::AnyUA::Middleware::Runtime;
+# ABSTRACT: Middleware to determine response time
+
+=head1 SYNOPSIS
+
+    $any_ua->apply_middleware('Runtime');
+
+=head1 DESCRIPTION
+
+This middleware adds a "runtime" field to the response, the value of which is the number of seconds
+it took to make the request and finish the response.
+
+=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 Time::HiRes;
+
+
+sub request {
+    my $self = shift;
+    my ($method, $url, $args) = @_;
+
+    my $start = [Time::HiRes::gettimeofday];
+
+    my $resp = $self->backend->request($method, $url, $args);
+
+    my $handle_response = sub {
+        my $resp = shift;
+
+        $resp->{runtime} = sprintf('%.6f', Time::HiRes::tv_interval($start));
+
+        return $resp;
+    };
+
+    if ($self->response_is_future) {
+        $resp->transform(
+            done => $handle_response,
+            fail => $handle_response,
+        );
+    }
+    else {
+        $resp = $handle_response->($resp);
+    }
+
+    return $resp;
+}
+
+1;
index 580b850ddefc951d32bc744808404c421339332f..3729c56e45029257864f73e00232132e85f5ce24 100644 (file)
@@ -1,5 +1,5 @@
 package HTTP::AnyUA::Util;
-# ABSTRACT: Utility subroutines for HTTP::AnyUA backends
+# ABSTRACT: Utility subroutines for HTTP::AnyUA backends and middleware
 
 use warnings;
 use strict;
@@ -13,6 +13,7 @@ our @EXPORT_OK = qw(
     http_headers_to_native
     native_to_http_request
     coderef_content_to_string
+    normalize_headers
     internal_exception
     http_date
     parse_http_date
@@ -102,6 +103,28 @@ sub http_headers_to_native {
     return $native;
 }
 
+=func normalize_headers
+
+    $normalized_headers = normalize_headers(\%headers);
+
+Normalize headers. Currently lowercases header keys.
+
+=cut
+
+sub normalize_headers {
+    my $headers_in = shift;
+
+    my $headers = {};
+
+    if (defined $headers_in) {
+        while (my ($key, $value) = each %{$headers_in || {}}) {
+            $headers->{lc($key)} = $value;
+        }
+    }
+
+    return $headers;
+}
+
 =func internal_exception
 
     $response = internal_exception($content);
diff --git a/t/40-middleware-content-length.t b/t/40-middleware-content-length.t
new file mode 100644 (file)
index 0000000..e283454
--- /dev/null
@@ -0,0 +1,36 @@
+#!perl
+
+use warnings;
+use strict;
+
+use lib 't/lib';
+
+use HTTP::AnyUA;
+use Test::More tests => 3;
+
+HTTP::AnyUA->register_backend(Mock => '+MockBackend');
+
+my $any_ua  = HTTP::AnyUA->new(ua => 'Mock');
+my $backend = $any_ua->backend;
+
+$any_ua->apply_middleware('ContentLength');
+
+my $url     = 'http://acme.tld/';
+my $content = "hello world\n";
+
+$any_ua->post($url, {content => $content});
+my $cl = ($backend->requests)[-1][2]{headers}{'content-length'};
+is $cl, length($content), 'content-length is set correctly with string content';
+
+$any_ua->post($url);
+$cl = ($backend->requests)[-1][2]{headers}{'content-length'};
+is $cl, undef, 'content-length is not set with no content';
+
+my $chunk   = 0;
+my @chunk   = ('some ', 'document');
+my $code    = sub { return $chunk[$chunk++] };
+
+$any_ua->post($url, {content => $code});
+$cl = ($backend->requests)[-1][2]{headers}{'content-length'};
+is $cl, undef, 'content-length is not set with coderef content';
+
diff --git a/t/40-middleware-runtime.t b/t/40-middleware-runtime.t
new file mode 100644 (file)
index 0000000..5597fda
--- /dev/null
@@ -0,0 +1,23 @@
+#!perl
+
+use warnings;
+use strict;
+
+use lib 't/lib';
+
+use HTTP::AnyUA;
+use Test::More tests => 1;
+
+HTTP::AnyUA->register_backend(Mock => '+MockBackend');
+
+my $any_ua  = HTTP::AnyUA->new(ua => 'Mock');
+my $backend = $any_ua->backend;
+
+$any_ua->apply_middleware('Runtime');
+
+my $url = 'http://acme.tld/';
+
+my $resp = $any_ua->get($url);
+note explain $resp;
+isnt $resp->{runtime}, undef, 'runtime is defined';
+
This page took 0.035079 seconds and 4 git commands to generate.