home *** CD-ROM | disk | FTP | other *** search
/ Netrunner 2004 October / NETRUNNER0410.ISO / regular / ActivePerl-5.8.4.810-MSWin32-x86.msi / _0163b71a631dc2ad579caf8995624ff8 < prev    next >
Text File  |  2004-06-01  |  2KB  |  95 lines
  1. package HTTP::Headers::ETag;
  2.  
  3. use strict;
  4. use vars qw($VERSION);
  5. $VERSION = sprintf("%d.%02d", q$Revision: 1.4 $ =~ /(\d+)\.(\d+)/);
  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;
  95.