File Coverage

blib/lib/LWP/UserAgent/Role/CHICaching/VaryNotAsterisk.pm
Criterion Covered Total %
statement 15 15 100.0
branch 2 2 100.0
condition n/a
subroutine 5 5 100.0
pod 1 1 100.0
total 23 23 100.0


line stmt bran cond sub pod time code
1             package LWP::UserAgent::Role::CHICaching::VaryNotAsterisk;
2              
3 1     1   481 use 5.006000;
  1         3  
4 1     1   4 use CHI;
  1         1  
  1         14  
5 1     1   5 use Moo::Role;
  1         2  
  1         5  
6 1     1   206 use Types::Standard qw(Str);
  1         1  
  1         8  
7              
8             our $AUTHORITY = 'cpan:KJETILK';
9             our $VERSION = '0.04';
10              
11             =pod
12              
13             =encoding utf-8
14              
15             =head1 NAME
16              
17             LWP::UserAgent::Role::CHICaching::VaryNotAsterisk - A role for when Vary is not * when caching LWP::UserAgent
18              
19             =head1 SYNOPSIS
20              
21             See L<LWP::UserAgent::Role::CHICaching>.
22              
23              
24             =head1 DESCRIPTION
25              
26             See L<LWP::UserAgent::Role::CHICaching::SimpleKeyGen> for a
27             background. Basically, this module does the second dumbest thing, but
28             in doing so, the User Agent ceases to be compliant with the HTTP
29             standard. You basically have to implement your own C<key> attribute to
30             make it compliant.
31              
32             =head2 Attributes and Methods
33              
34             =over
35              
36             =item C<< cache_vary >>
37              
38             Allow a response with a C<Vary> header to be cached if it doesn't
39             contain an asterisk (*).
40              
41             =back
42              
43             =cut
44              
45             sub cache_vary {
46 5     5 1 3194 my ($self, $res) = @_;
47 5         12 foreach my $vary ($res->header('Vary')) {
48 4 100       111 return 0 if ($vary =~ m/\*/);
49             }
50 3         38 return 1;
51             }
52              
53             1;
54              
55             __END__
56              
57              
58             =head1 AUTHOR
59              
60             Kjetil Kjernsmo E<lt>kjetilk@cpan.orgE<gt>.
61              
62             =head1 COPYRIGHT AND LICENCE
63              
64             This software is copyright (c) 2015, 2016 by Kjetil Kjernsmo.
65              
66             This is free software; you can redistribute it and/or modify it under
67             the same terms as the Perl 5 programming language system itself.