File Coverage

blib/lib/PAGI/Middleware/ETag.pm
Criterion Covered Total %
statement 56 64 87.5
branch 13 16 81.2
condition 5 8 62.5
subroutine 9 9 100.0
pod 1 1 100.0
total 84 98 85.7


line stmt bran cond sub pod time code
1             package PAGI::Middleware::ETag;
2              
3 1     1   572 use strict;
  1         1  
  1         35  
4 1     1   5 use warnings;
  1         2  
  1         78  
5 1     1   7 use parent 'PAGI::Middleware';
  1         2  
  1         10  
6 1     1   82 use Future::AsyncAwait;
  1         2  
  1         8  
7 1     1   74 use Digest::MD5 qw(md5_hex);
  1         2  
  1         931  
8              
9             =head1 NAME
10              
11             PAGI::Middleware::ETag - ETag generation middleware
12              
13             =head1 SYNOPSIS
14              
15             use PAGI::Middleware::Builder;
16              
17             my $app = builder {
18             enable 'ETag';
19             $my_app;
20             };
21              
22             =head1 DESCRIPTION
23              
24             PAGI::Middleware::ETag generates ETag headers for responses based on
25             the response body content. Works best with buffered (non-streaming) responses.
26              
27             =head1 CONFIGURATION
28              
29             =over 4
30              
31             =item * weak (default: 0)
32              
33             If true, generate weak ETags (W/"...").
34              
35             =back
36              
37             =cut
38              
39             sub _init {
40 3     3   5 my ($self, $config) = @_;
41              
42 3   100     18 $self->{weak} = $config->{weak} // 0;
43             }
44              
45             sub wrap {
46 3     3 1 25 my ($self, $app) = @_;
47              
48 3     3   57 return async sub {
49 3         35 my ($scope, $receive, $send) = @_;
50 3 50       9 if ($scope->{type} ne 'http') {
51 0         0 await $app->($scope, $receive, $send);
52 0         0 return;
53             }
54              
55 3         6 my @body_parts;
56             my $original_headers;
57 3         0 my $status;
58 3         3 my $is_streaming = 0;
59              
60 6         140 my $wrapped_send = async sub {
61 6         8 my ($event) = @_;
62 6 100       38 if ($event->{type} eq 'http.response.start') {
    50          
63 3         4 $status = $event->{status};
64 3         3 $original_headers = $event->{headers};
65             # Check if already has ETag
66 3   50     4 for my $h (@{$original_headers // []}) {
  3         9  
67 4 100       23 if (lc($h->[0]) eq 'etag') {
68             # Already has ETag, pass through
69 1         3 await $send->($event);
70 1         43 $is_streaming = 1; # Flag to pass through body
71 1         3 return;
72             }
73             }
74             }
75             elsif ($event->{type} eq 'http.response.body') {
76 3 100       8 if ($is_streaming) {
77 1         2 await $send->($event);
78 1         24 return;
79             }
80              
81 2   50     5 push @body_parts, $event->{body} // '';
82              
83             # If streaming, can't generate ETag
84 2 50       7 if ($event->{more}) {
85 0         0 $is_streaming = 1;
86 0         0 await $send->({
87             type => 'http.response.start',
88             status => $status,
89             headers => $original_headers,
90             });
91 0         0 for my $part (@body_parts) {
92 0         0 await $send->({
93             type => 'http.response.body',
94             body => $part,
95             more => 1,
96             });
97             }
98 0         0 @body_parts = ();
99             }
100             }
101             else {
102 0         0 await $send->($event);
103             }
104 3         11 };
105              
106 3         7 await $app->($scope, $receive, $wrapped_send);
107              
108 3 100       132 return if $is_streaming;
109              
110             # Generate ETag from body
111 2         5 my $body = join('', @body_parts);
112 2         5 my $etag = $self->_generate_etag($body);
113              
114             # Add ETag to headers
115 2   50     3 my @new_headers = @{$original_headers // []};
  2         5  
116 2         5 push @new_headers, ['ETag', $etag];
117              
118 2         7 await $send->({
119             type => 'http.response.start',
120             status => $status,
121             headers => \@new_headers,
122             });
123 2         69 await $send->({
124             type => 'http.response.body',
125             body => $body,
126             more => 0,
127             });
128 3         14 };
129             }
130              
131             sub _generate_etag {
132 2     2   4 my ($self, $body) = @_;
133              
134 2         7 my $hash = md5_hex($body);
135 2 100       8 if ($self->{weak}) {
136 1         3 return qq{W/"$hash"};
137             }
138 1         2 return qq{"$hash"};
139             }
140              
141             1;
142              
143             __END__