File Coverage

blib/lib/HTTP/Headers/ETag.pm
Criterion Covered Total %
statement 43 44 97.7
branch 29 30 96.6
condition 2 3 66.6
subroutine 8 8 100.0
pod 0 4 0.0
total 82 89 92.1


line stmt bran cond sub pod time code
1             package HTTP::Headers::ETag;
2              
3 1     1   1423 use strict;
  1         2  
  1         30  
4 1     1   6 use warnings;
  1         2  
  1         734  
5              
6             our $VERSION = '6.44';
7              
8             require HTTP::Date;
9              
10             require HTTP::Headers;
11             package
12             HTTP::Headers;
13              
14             sub _etags
15             {
16 14     14   22 my $self = shift;
17 14         21 my $header = shift;
18 14         33 my @old = _split_etag_list($self->_header($header));
19 14 100       28 if (@_) {
20 8         16 $self->_header($header => join(", ", _split_etag_list(@_)));
21             }
22 14 100       85 wantarray ? @old : join(", ", @old);
23             }
24              
25 11     11 0 694 sub etag { shift->_etags("ETag", @_); }
26 1     1 0 4 sub if_match { shift->_etags("If-Match", @_); }
27 1     1 0 3 sub if_none_match { shift->_etags("If-None-Match", @_); }
28              
29             sub if_range {
30             # Either a date or an entity-tag
31 7     7 0 1107 my $self = shift;
32 7         15 my @old = $self->_header("If-Range");
33 7 100       19 if (@_) {
34 3         6 my $new = shift;
35 3 100       12 if (!defined $new) {
    100          
36 1         4 $self->remove_header("If-Range");
37             }
38             elsif ($new =~ /^\d+$/) {
39 1         4 $self->_date_header("If-Range", $new);
40             }
41             else {
42 1         3 $self->_etags("If-Range", $new);
43             }
44             }
45 7 100       37 return unless defined(wantarray);
46 4         8 for (@old) {
47 3         7 my $t = HTTP::Date::str2time($_);
48 3 100       155 $_ = $t if $t;
49             }
50 4 100       29 wantarray ? @old : join(", ", @old);
51             }
52              
53              
54             # Split a list of entity tag values. The return value is a list
55             # consisting of one element per entity tag. Suitable for parsing
56             # headers like C, C. You might even want to
57             # use it on C and C entity tag values, because it will
58             # normalize them to the common form.
59             #
60             # entity-tag = [ weak ] opaque-tag
61             # weak = "W/"
62             # opaque-tag = quoted-string
63              
64              
65             sub _split_etag_list
66             {
67 22     22   47 my(@val) = @_;
68 22         29 my @res;
69 22         36 for (@val) {
70 19         37 while (length) {
71 29         37 my $weak = "";
72 29 100       91 $weak = "W/" if s,^\s*[wW]/,,;
73 29         44 my $etag = "";
74 29 100 66     136 if (s/^\s*(\"[^\"\\]*(?:\\.[^\"\\]*)*\")//) {
    100          
    100          
    50          
75 13         50 push(@res, "$weak$1");
76             }
77             elsif (s/^\s*,//) {
78 6 100       20 push(@res, qq(W/"")) if $weak;
79             }
80             elsif (s/^\s*([^,\s]+)//) {
81 8         16 $etag = $1;
82 8         13 $etag =~ s/([\"\\])/\\$1/g;
83 8         28 push(@res, qq($weak"$etag"));
84             }
85             elsif (s/^\s+// || !length) {
86 2 100       8 push(@res, qq(W/"")) if $weak;
87             }
88             else {
89 0         0 die "This should not happen: '$_'";
90             }
91             }
92             }
93 22         65 @res;
94             }
95              
96             1;
97              
98             __END__