git.maemo.org Git - pkg-perl/blob - deb-src/libwww-perl/libwww-perl-5.813/lib/HTTP/Headers/ETag.pm

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