home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 May / Chip_2000-05_cd1.bin / zkuste / Perl / ActivePerl-5.6.0.613.msi / 䆊䌷䈹䈙䏵-䞅䞆䞀㡆䞃䄦䠥 / _5c341f152b68bbd529fce397130952ae < prev    next >
Encoding:
Text File  |  2000-03-15  |  2.2 KB  |  89 lines
  1. package HTTP::Headers::ETag;
  2.  
  3. use strict;
  4. use vars qw($VERSION);
  5. $VERSION = sprintf("%d.%02d", q$Revision: 1.3 $ =~ /(\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.     } elsif ($new =~ /^\d+$/) {
  36.         $self->_date_header("If-Range", $new);
  37.     } else {
  38.         $self->_etags("If-Range", $new);
  39.     }
  40.     }
  41.     return unless defined(wantarray);
  42.     for (@old) {
  43.     my $t = HTTP::Date::str2time($_);
  44.     $_ = $t if $t;
  45.     }
  46.     wantarray ? @old : join(", ", @old);
  47. }
  48.  
  49.  
  50. # Split a list of entity tag values.  The return value is a list
  51. # consisting of one element per entity tag.  Suitable for parsing
  52. # headers like C<If-Match>, C<If-None-Match>.  You might even want to
  53. # use it on C<ETag> and C<If-Range> entity tag values, because it will
  54. # normalize them to the common form.
  55. #
  56. #  entity-tag      = [ weak ] opaque-tag
  57. #  weak          = "W/"
  58. #  opaque-tag      = quoted-string
  59.  
  60.  
  61. sub _split_etag_list
  62. {
  63.     my(@val) = @_;
  64.     my @res;
  65.     for (@val) {
  66.         while (length) {
  67.             my $weak = "";
  68.         $weak = "W/" if s,^\s*[wW]/,,;
  69.             my $etag = "";
  70.         if (s/^\s*(\"[^\"\\]*(?:\\.[^\"\\]*)*\")//) {
  71.         push(@res, "$weak$1");
  72.             } elsif (s/^\s*,//) {
  73.                 push(@res, qq(W/"")) if $weak;
  74.             } elsif (s/^\s*([^,\s]+)//) {
  75.                 $etag = $1;
  76.         $etag =~ s/([\"\\])/\\$1/g;
  77.             push(@res, qq($weak"$etag"));
  78.             } elsif (s/^\s+// || !length) {
  79.                 push(@res, qq(W/"")) if $weak;
  80.             } else {
  81.          die "This should not happen: '$_'";
  82.             }
  83.         }
  84.    }
  85.    @res;
  86. }
  87.  
  88. 1;
  89.