File Coverage

blib/lib/Plack/Middleware/ConditionalGET.pm
Criterion Covered Total %
statement 36 36 100.0
branch 14 14 100.0
condition n/a
subroutine 9 9 100.0
pod 1 3 33.3
total 60 62 96.7


line stmt bran cond sub pod time code
1             package Plack::Middleware::ConditionalGET;
2 2     2   13 use strict;
  2         4  
  2         65  
3 2     2   9 use parent qw( Plack::Middleware );
  2         3  
  2         12  
4 2     2   149 use Plack::Util;
  2         5  
  2         522  
5              
6             sub call {
7 11     11 1 20 my $self = shift;
8 11         15 my $env = shift;
9              
10 11         36 my $res = $self->app->($env);
11 11 100       109 return $res unless $env->{REQUEST_METHOD} =~ /^(GET|HEAD)$/;
12              
13             $self->response_cb($res, sub {
14 10     10   13 my $res = shift;
15              
16 10         26 my $h = Plack::Util::headers($res->[1]);
17              
18             # check both ETag and If-Modified-Since, and at least one should exist
19             # and all present headers should match, not either.
20 10 100       26 my @checks = ( $self->etag_matches($h, $env), $self->not_modified_since($h, $env) )
21             or return;
22              
23 9 100       70 unless (grep !$_, @checks) {
24 5         11 $res->[0] = 304;
25 5         31 $h->remove($_) for qw( Content-Type Content-Length Content-Disposition );
26 5 100       12 if ($res->[2]) {
27 4         33 $res->[2] = [];
28             } else {
29             return sub {
30 4 100       16 return defined $_[0] ? '' : undef;
31 1         43 };
32             }
33             }
34 10         53 });
35             }
36              
37 2     2   13 no warnings 'uninitialized';
  2         4  
  2         389  
38              
39             # RFC 2616 14.25 says it's OK and expected to use 'eq' :)
40             # > Note: When handling an If-Modified-Since header field, some
41             # > servers will use an exact date comparison function, rather than a
42             # > less-than function, for deciding whether to send a 304 ...
43              
44             sub etag_matches {
45 10     10 0 19 my($self, $h, $env) = @_;
46 10 100       60 return unless $h->exists('ETag');
47 6         29 $h->get('ETag') eq _value($env->{HTTP_IF_NONE_MATCH});
48             }
49              
50             sub not_modified_since {
51 10     10 0 19 my($self, $h, $env) = @_;
52 10 100       32 return unless $h->exists('Last-Modified');
53 6         21 $h->get('Last-Modified') eq _value($env->{HTTP_IF_MODIFIED_SINCE});
54             }
55              
56             sub _value {
57 12     12   19 my $str = shift;
58             # IE sends wrong formatted value(i.e. "Thu, 03 Dec 2009 01:46:32 GMT; length=17936")
59 12         21 $str =~ s/;.*$//;
60 12         44 return $str;
61             }
62              
63             1;
64              
65             __END__