"Fossies" - the Fresh Open Source Software Archive

Member "install-tl-20200916/tlpkg/tlperl/site/lib/HTTP/Headers/ETag.pm" (7 Mar 2020, 2555 Bytes) of package /windows/misc/install-tl.zip:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

    1 package HTTP::Headers::ETag;
    2 
    3 use strict;
    4 use warnings;
    5 
    6 our $VERSION = '6.22';
    7 
    8 require HTTP::Date;
    9 
   10 require HTTP::Headers;
   11 package
   12     HTTP::Headers;
   13 
   14 sub _etags
   15 {
   16     my $self = shift;
   17     my $header = shift;
   18     my @old = _split_etag_list($self->_header($header));
   19     if (@_) {
   20     $self->_header($header => join(", ", _split_etag_list(@_)));
   21     }
   22     wantarray ? @old : join(", ", @old);
   23 }
   24 
   25 sub etag          { shift->_etags("ETag", @_); }
   26 sub if_match      { shift->_etags("If-Match", @_); }
   27 sub if_none_match { shift->_etags("If-None-Match", @_); }
   28 
   29 sub if_range {
   30     # Either a date or an entity-tag
   31     my $self = shift;
   32     my @old = $self->_header("If-Range");
   33     if (@_) {
   34     my $new = shift;
   35     if (!defined $new) {
   36         $self->remove_header("If-Range");
   37     }
   38     elsif ($new =~ /^\d+$/) {
   39         $self->_date_header("If-Range", $new);
   40     }
   41     else {
   42         $self->_etags("If-Range", $new);
   43     }
   44     }
   45     return unless defined(wantarray);
   46     for (@old) {
   47     my $t = HTTP::Date::str2time($_);
   48     $_ = $t if $t;
   49     }
   50     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<If-Match>, C<If-None-Match>.  You might even want to
   57 # use it on C<ETag> and C<If-Range> 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     my(@val) = @_;
   68     my @res;
   69     for (@val) {
   70         while (length) {
   71             my $weak = "";
   72         $weak = "W/" if s,^\s*[wW]/,,;
   73             my $etag = "";
   74         if (s/^\s*(\"[^\"\\]*(?:\\.[^\"\\]*)*\")//) {
   75         push(@res, "$weak$1");
   76             }
   77             elsif (s/^\s*,//) {
   78                 push(@res, qq(W/"")) if $weak;
   79             }
   80             elsif (s/^\s*([^,\s]+)//) {
   81                 $etag = $1;
   82         $etag =~ s/([\"\\])/\\$1/g;
   83             push(@res, qq($weak"$etag"));
   84             }
   85             elsif (s/^\s+// || !length) {
   86                 push(@res, qq(W/"")) if $weak;
   87             }
   88             else {
   89         die "This should not happen: '$_'";
   90             }
   91         }
   92    }
   93    @res;
   94 }
   95 
   96 1;
   97 
   98 __END__
   99 
  100 =pod
  101 
  102 =encoding UTF-8
  103 
  104 =head1 NAME
  105 
  106 HTTP::Headers::ETag
  107 
  108 =head1 VERSION
  109 
  110 version 6.22
  111 
  112 =head1 AUTHOR
  113 
  114 Gisle Aas <gisle@activestate.com>
  115 
  116 =head1 COPYRIGHT AND LICENSE
  117 
  118 This software is copyright (c) 1994-2017 by Gisle Aas.
  119 
  120 This is free software; you can redistribute it and/or modify it under
  121 the same terms as the Perl 5 programming language system itself.
  122 
  123 =cut