Includes ContentLength and Runtime as basic examples.
our $BACKEND_NAMESPACE;
+our $MIDDLEWARE_NAMESPACE;
our @BACKENDS;
our %REGISTERED_BACKENDS;
BEGIN {
- $BACKEND_NAMESPACE = __PACKAGE__ . '::Backend';
+ $BACKEND_NAMESPACE = __PACKAGE__ . '::Backend';
+ $MIDDLEWARE_NAMESPACE = __PACKAGE__ . '::Middleware';
}
(@_ == 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, {
@_ == 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);
}
}
+=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);
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
package HTTP::AnyUA::Util;
-# ABSTRACT: Utility subroutines for HTTP::AnyUA backends
+# ABSTRACT: Utility subroutines for HTTP::AnyUA backends and middleware
use warnings;
use strict;
http_headers_to_native
native_to_http_request
coderef_content_to_string
+ normalize_headers
internal_exception
http_date
parse_http_date
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);
--- /dev/null
+#!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';
+
--- /dev/null
+#!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';
+
projects / chaz / p5-HTTP-AnyUA / commitdiff
