File Coverage

blib/lib/Net/HTTP/Knork/Role/Middleware.pm
Criterion Covered Total %
statement 28 28 100.0
branch 3 6 50.0
condition 1 3 33.3
subroutine 6 6 100.0
pod 0 1 0.0
total 38 44 86.3


line stmt bran cond sub pod time code
1             package Net::HTTP::Knork::Role::Middleware;
2             # ABSTRACT: Role implementing middleware capabilities for Knork main class
3 5     5   39997 use Moo::Role;
  5         11  
  5         29  
4 5     5   1456 use Carp;
  5         9  
  5         349  
5 5     5   2594 use Class::Method::Modifiers qw/install_modifier/;
  5         6729  
  5         1282  
6              
7             requires qw/perform_request generate_response/;
8              
9              
10             sub add_middleware {
11 2     2 0 134 my $self = shift;
12 2         3 my $mw_spec = shift;
13 2 50 33     15 croak
14             "A middleware should specify at least a action 'on_requests' or 'on_response'"
15             unless ( defined( $mw_spec->{on_request} )
16             || defined( $mw_spec->{on_response} ) );
17 2         4 my $class = ref($self);
18 2 50       6 if ( $mw_spec->{on_request} ) {
19             install_modifier $class, 'around', 'perform_request', sub {
20 2     2   60 my $orig = shift;
21 2         4 my ( $self, $request ) = @_;
22 2         6 my $meth = $mw_spec->{on_request};
23 2         10 my $new_request = $meth->($self,$request);
24 2         259 $orig->( $self, $new_request );
25             }
26 2         15 }
27              
28 2 50       560 if ( $mw_spec->{on_response} ) {
29             install_modifier $class, 'around', 'generate_response', sub {
30 2     2   44 my $orig = shift;
31 2         5 my ( $self, $resp ) = @_;
32 2         6 my $meth = $mw_spec->{on_response};
33 2         12 my $old_resp = $resp->clone;
34 2         508 my $new_resp = $meth->($self,$old_resp);
35 2         66 $orig->( $self, $new_resp, $resp );
36             }
37 2         12 }
38             }
39              
40             1;
41              
42             __END__