diff options
Diffstat (limited to 'chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Headers.pm')
| -rw-r--r-- | chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Headers.pm | 737 |
1 files changed, 0 insertions, 737 deletions
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Headers.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Headers.pm deleted file mode 100644 index 7cb5fe11f68..00000000000 --- a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/HTTP/Headers.pm +++ /dev/null @@ -1,737 +0,0 @@ -package HTTP::Headers; - -use strict; -use Carp (); - -use vars qw($VERSION $TRANSLATE_UNDERSCORE); -$VERSION = "5.810"; - -# The $TRANSLATE_UNDERSCORE variable controls whether '_' can be used -# as a replacement for '-' in header field names. -$TRANSLATE_UNDERSCORE = 1 unless defined $TRANSLATE_UNDERSCORE; - -# "Good Practice" order of HTTP message headers: -# - General-Headers -# - Request-Headers -# - Response-Headers -# - Entity-Headers - -my @general_headers = qw( - Cache-Control Connection Date Pragma Trailer Transfer-Encoding Upgrade - Via Warning -); - -my @request_headers = qw( - Accept Accept-Charset Accept-Encoding Accept-Language - Authorization Expect From Host - If-Match If-Modified-Since If-None-Match If-Range If-Unmodified-Since - Max-Forwards Proxy-Authorization Range Referer TE User-Agent -); - -my @response_headers = qw( - Accept-Ranges Age ETag Location Proxy-Authenticate Retry-After Server - Vary WWW-Authenticate -); - -my @entity_headers = qw( - Allow Content-Encoding Content-Language Content-Length Content-Location - Content-MD5 Content-Range Content-Type Expires Last-Modified -); - -my %entity_header = map { lc($_) => 1 } @entity_headers; - -my @header_order = ( - @general_headers, - @request_headers, - @response_headers, - @entity_headers, -); - -# Make alternative representations of @header_order. This is used -# for sorting and case matching. -my %header_order; -my %standard_case; - -{ - my $i = 0; - for (@header_order) { - my $lc = lc $_; - $header_order{$lc} = ++$i; - $standard_case{$lc} = $_; - } -} - - - -sub new -{ - my($class) = shift; - my $self = bless {}, $class; - $self->header(@_) if @_; # set up initial headers - $self; -} - - -sub header -{ - my $self = shift; - Carp::croak('Usage: $h->header($field, ...)') unless @_; - my(@old); - my %seen; - while (@_) { - my $field = shift; - my $op = @_ ? ($seen{lc($field)}++ ? 'PUSH' : 'SET') : 'GET'; - @old = $self->_header($field, shift, $op); - } - return @old if wantarray; - return $old[0] if @old <= 1; - join(", ", @old); -} - -sub clear -{ - my $self = shift; - %$self = (); -} - - -sub push_header -{ - Carp::croak('Usage: $h->push_header($field, $val)') if @_ != 3; - shift->_header(@_, 'PUSH'); -} - - -sub init_header -{ - Carp::croak('Usage: $h->init_header($field, $val)') if @_ != 3; - shift->_header(@_, 'INIT'); -} - - -sub remove_header -{ - my($self, @fields) = @_; - my $field; - my @values; - foreach $field (@fields) { - $field =~ tr/_/-/ if $field !~ /^:/ && $TRANSLATE_UNDERSCORE; - my $v = delete $self->{lc $field}; - push(@values, ref($v) eq 'ARRAY' ? @$v : $v) if defined $v; - } - return @values; -} - -sub remove_content_headers -{ - my $self = shift; - unless (defined(wantarray)) { - # fast branch that does not create return object - delete @$self{grep $entity_header{$_} || /^content-/, keys %$self}; - return; - } - - my $c = ref($self)->new; - for my $f (grep $entity_header{$_} || /^content-/, keys %$self) { - $c->{$f} = delete $self->{$f}; - } - $c; -} - - -sub _header -{ - my($self, $field, $val, $op) = @_; - - # $push is only used interally sub push_header - Carp::croak('Need a field name') unless length($field); - - unless ($field =~ /^:/) { - $field =~ tr/_/-/ if $TRANSLATE_UNDERSCORE; - my $old = $field; - $field = lc $field; - unless(defined $standard_case{$field}) { - # generate a %standard_case entry for this field - $old =~ s/\b(\w)/\u$1/g; - $standard_case{$field} = $old; - } - } - - my $h = $self->{$field}; - my @old = ref($h) eq 'ARRAY' ? @$h : (defined($h) ? ($h) : ()); - - $op ||= defined($val) ? 'SET' : 'GET'; - unless ($op eq 'GET' || ($op eq 'INIT' && @old)) { - if (defined($val)) { - my @new = ($op eq 'PUSH') ? @old : (); - if (ref($val) ne 'ARRAY') { - push(@new, $val); - } - else { - push(@new, @$val); - } - $self->{$field} = @new > 1 ? \@new : $new[0]; - } - elsif ($op ne 'PUSH') { - delete $self->{$field}; - } - } - @old; -} - - -sub _sorted_field_names -{ - my $self = shift; - return sort { - ($header_order{$a} || 999) <=> ($header_order{$b} || 999) || - $a cmp $b - } keys %$self -} - - -sub header_field_names { - my $self = shift; - return map $standard_case{$_} || $_, $self->_sorted_field_names - if wantarray; - return keys %$self; -} - - -sub scan -{ - my($self, $sub) = @_; - my $key; - foreach $key ($self->_sorted_field_names) { - next if $key =~ /^_/; - my $vals = $self->{$key}; - if (ref($vals) eq 'ARRAY') { - my $val; - for $val (@$vals) { - &$sub($standard_case{$key} || $key, $val); - } - } - else { - &$sub($standard_case{$key} || $key, $vals); - } - } -} - - -sub as_string -{ - my($self, $endl) = @_; - $endl = "\n" unless defined $endl; - - my @result = (); - $self->scan(sub { - my($field, $val) = @_; - $field =~ s/^://; - if ($val =~ /\n/) { - # must handle header values with embedded newlines with care - $val =~ s/\s+$//; # trailing newlines and space must go - $val =~ s/\n\n+/\n/g; # no empty lines - $val =~ s/\n([^\040\t])/\n $1/g; # intial space for continuation - $val =~ s/\n/$endl/g; # substitute with requested line ending - } - push(@result, "$field: $val"); - }); - - join($endl, @result, ''); -} - - -sub clone -{ - my $self = shift; - my $clone = new HTTP::Headers; - $self->scan(sub { $clone->push_header(@_);} ); - $clone; -} - - -sub _date_header -{ - require HTTP::Date; - my($self, $header, $time) = @_; - my($old) = $self->_header($header); - if (defined $time) { - $self->_header($header, HTTP::Date::time2str($time)); - } - $old =~ s/;.*// if defined($old); - HTTP::Date::str2time($old); -} - - -sub date { shift->_date_header('Date', @_); } -sub expires { shift->_date_header('Expires', @_); } -sub if_modified_since { shift->_date_header('If-Modified-Since', @_); } -sub if_unmodified_since { shift->_date_header('If-Unmodified-Since', @_); } -sub last_modified { shift->_date_header('Last-Modified', @_); } - -# This is used as a private LWP extension. The Client-Date header is -# added as a timestamp to a response when it has been received. -sub client_date { shift->_date_header('Client-Date', @_); } - -# The retry_after field is dual format (can also be a expressed as -# number of seconds from now), so we don't provide an easy way to -# access it until we have know how both these interfaces can be -# addressed. One possibility is to return a negative value for -# relative seconds and a positive value for epoch based time values. -#sub retry_after { shift->_date_header('Retry-After', @_); } - -sub content_type { - my $ct = (shift->_header('Content-Type', @_))[0]; - return '' unless defined($ct) && length($ct); - my @ct = split(/;\s*/, $ct, 2); - for ($ct[0]) { - s/\s+//g; - $_ = lc($_); - } - wantarray ? @ct : $ct[0]; -} - -sub _is_html { - my $self = shift; - return $self->content_type eq 'text/html' || $self->_is_xhtml; -} - -sub _is_xhtml { - my $ct = shift->content_type; - for (qw(application/xhtml+xml application/vnd.wap.xhtml+xml)) { - return 1 if $_ eq $ct; - } - return 0; -} - -sub referer { - my $self = shift; - if (@_ && $_[0] =~ /#/) { - # Strip fragment per RFC 2616, section 14.36. - my $uri = shift; - if (ref($uri)) { - $uri = $uri->clone; - $uri->fragment(undef); - } - else { - $uri =~ s/\#.*//; - } - unshift @_, $uri; - } - ($self->_header('Referer', @_))[0]; -} -*referrer = \&referer; # on tchrist's request - -sub title { (shift->_header('Title', @_))[0] } -sub content_encoding { (shift->_header('Content-Encoding', @_))[0] } -sub content_language { (shift->_header('Content-Language', @_))[0] } -sub content_length { (shift->_header('Content-Length', @_))[0] } - -sub user_agent { (shift->_header('User-Agent', @_))[0] } -sub server { (shift->_header('Server', @_))[0] } - -sub from { (shift->_header('From', @_))[0] } -sub warning { (shift->_header('Warning', @_))[0] } - -sub www_authenticate { (shift->_header('WWW-Authenticate', @_))[0] } -sub authorization { (shift->_header('Authorization', @_))[0] } - -sub proxy_authenticate { (shift->_header('Proxy-Authenticate', @_))[0] } -sub proxy_authorization { (shift->_header('Proxy-Authorization', @_))[0] } - -sub authorization_basic { shift->_basic_auth("Authorization", @_) } -sub proxy_authorization_basic { shift->_basic_auth("Proxy-Authorization", @_) } - -sub _basic_auth { - require MIME::Base64; - my($self, $h, $user, $passwd) = @_; - my($old) = $self->_header($h); - if (defined $user) { - Carp::croak("Basic authorization user name can't contain ':'") - if $user =~ /:/; - $passwd = '' unless defined $passwd; - $self->_header($h => 'Basic ' . - MIME::Base64::encode("$user:$passwd", '')); - } - if (defined $old && $old =~ s/^\s*Basic\s+//) { - my $val = MIME::Base64::decode($old); - return $val unless wantarray; - return split(/:/, $val, 2); - } - return; -} - - -1; - -__END__ - -=head1 NAME - -HTTP::Headers - Class encapsulating HTTP Message headers - -=head1 SYNOPSIS - - require HTTP::Headers; - $h = HTTP::Headers->new; - - $h->header('Content-Type' => 'text/plain'); # set - $ct = $h->header('Content-Type'); # get - $h->remove_header('Content-Type'); # delete - -=head1 DESCRIPTION - -The C<HTTP::Headers> class encapsulates HTTP-style message headers. -The headers consist of attribute-value pairs also called fields, which -may be repeated, and which are printed in a particular order. The -field names are cases insensitive. - -Instances of this class are usually created as member variables of the -C<HTTP::Request> and C<HTTP::Response> classes, internal to the -library. - -The following methods are available: - -=over 4 - -=item $h = HTTP::Headers->new - -Constructs a new C<HTTP::Headers> object. You might pass some initial -attribute-value pairs as parameters to the constructor. I<E.g.>: - - $h = HTTP::Headers->new( - Date => 'Thu, 03 Feb 1994 00:00:00 GMT', - Content_Type => 'text/html; version=3.2', - Content_Base => 'http://www.perl.org/'); - -The constructor arguments are passed to the C<header> method which is -described below. - -=item $h->clone - -Returns a copy of this C<HTTP::Headers> object. - -=item $h->header( $field ) - -=item $h->header( $field => $value, ... ) - -Get or set the value of one or more header fields. The header field -name ($field) is not case sensitive. To make the life easier for perl -users who wants to avoid quoting before the => operator, you can use -'_' as a replacement for '-' in header names. - -The header() method accepts multiple ($field => $value) pairs, which -means that you can update several fields with a single invocation. - -The $value argument may be a plain string or a reference to an array -of strings for a multi-valued field. If the $value is provided as -C<undef> then the field is removed. If the $value is not given, then -that header field will remain unchanged. - -The old value (or values) of the last of the header fields is returned. -If no such field exists C<undef> will be returned. - -A multi-valued field will be returned as separate values in list -context and will be concatenated with ", " as separator in scalar -context. The HTTP spec (RFC 2616) promise that joining multiple -values in this way will not change the semantic of a header field, but -in practice there are cases like old-style Netscape cookies (see -L<HTTP::Cookies>) where "," is used as part of the syntax of a single -field value. - -Examples: - - $header->header(MIME_Version => '1.0', - User_Agent => 'My-Web-Client/0.01'); - $header->header(Accept => "text/html, text/plain, image/*"); - $header->header(Accept => [qw(text/html text/plain image/*)]); - @accepts = $header->header('Accept'); # get multiple values - $accepts = $header->header('Accept'); # get values as a single string - -=item $h->push_header( $field => $value ) - -Add a new field value for the specified header field. Previous values -for the same field are retained. - -As for the header() method, the field name ($field) is not case -sensitive and '_' can be used as a replacement for '-'. - -The $value argument may be a scalar or a reference to a list of -scalars. - - $header->push_header(Accept => 'image/jpeg'); - $header->push_header(Accept => [map "image/$_", qw(gif png tiff)]); - -=item $h->init_header( $field => $value ) - -Set the specified header to the given value, but only if no previous -value for that field is set. - -The header field name ($field) is not case sensitive and '_' -can be used as a replacement for '-'. - -The $value argument may be a scalar or a reference to a list of -scalars. - -=item $h->remove_header( $field, ... ) - -This function removes the header fields with the specified names. - -The header field names ($field) are not case sensitive and '_' -can be used as a replacement for '-'. - -The return value is the values of the fields removed. In scalar -context the number of fields removed is returned. - -Note that if you pass in multiple field names then it is generally not -possible to tell which of the returned values belonged to which field. - -=item $h->remove_content_headers - -This will remove all the header fields used to describe the content of -a message. All header field names prefixed with C<Content-> falls -into this category, as well as C<Allow>, C<Expires> and -C<Last-Modified>. RFC 2616 denote these fields as I<Entity Header -Fields>. - -The return value is a new C<HTTP::Headers> object that contains the -removed headers only. - -=item $h->clear - -This will remove all header fields. - -=item $h->header_field_names - -Returns the list of distinct names for the fields present in the -header. The field names have case as suggested by HTTP spec, and the -names are returned in the recommended "Good Practice" order. - -In scalar context return the number of distinct field names. - -=item $h->scan( \&process_header_field ) - -Apply a subroutine to each header field in turn. The callback routine -is called with two parameters; the name of the field and a single -value (a string). If a header field is multi-valued, then the -routine is called once for each value. The field name passed to the -callback routine has case as suggested by HTTP spec, and the headers -will be visited in the recommended "Good Practice" order. - -Any return values of the callback routine are ignored. The loop can -be broken by raising an exception (C<die>), but the caller of scan() -would have to trap the exception itself. - -=item $h->as_string - -=item $h->as_string( $eol ) - -Return the header fields as a formatted MIME header. Since it -internally uses the C<scan> method to build the string, the result -will use case as suggested by HTTP spec, and it will follow -recommended "Good Practice" of ordering the header fields. Long header -values are not folded. - -The optional $eol parameter specifies the line ending sequence to -use. The default is "\n". Embedded "\n" characters in header field -values will be substituted with this line ending sequence. - -=back - -=head1 CONVENIENCE METHODS - -The most frequently used headers can also be accessed through the -following convenience Methods. These methods can both be used to read -and to set the value of a header. The header value is set if you pass -an argument to the method. The old header value is always returned. -If the given header did not exist then C<undef> is returned. - -Methods that deal with dates/times always convert their value to system -time (seconds since Jan 1, 1970) and they also expect this kind of -value when the header value is set. - -=over 4 - -=item $h->date - -This header represents the date and time at which the message was -originated. I<E.g.>: - - $h->date(time); # set current date - -=item $h->expires - -This header gives the date and time after which the entity should be -considered stale. - -=item $h->if_modified_since - -=item $h->if_unmodified_since - -These header fields are used to make a request conditional. If the requested -resource has (or has not) been modified since the time specified in this field, -then the server will return a C<304 Not Modified> response instead of -the document itself. - -=item $h->last_modified - -This header indicates the date and time at which the resource was last -modified. I<E.g.>: - - # check if document is more than 1 hour old - if (my $last_mod = $h->last_modified) { - if ($last_mod < time - 60*60) { - ... - } - } - -=item $h->content_type - -The Content-Type header field indicates the media type of the message -content. I<E.g.>: - - $h->content_type('text/html'); - -The value returned will be converted to lower case, and potential -parameters will be chopped off and returned as a separate value if in -an array context. If there is no such header field, then the empty -string is returned. This makes it safe to do the following: - - if ($h->content_type eq 'text/html') { - # we enter this place even if the real header value happens to - # be 'TEXT/HTML; version=3.0' - ... - } - -=item $h->content_encoding - -The Content-Encoding header field is used as a modifier to the -media type. When present, its value indicates what additional -encoding mechanism has been applied to the resource. - -=item $h->content_length - -A decimal number indicating the size in bytes of the message content. - -=item $h->content_language - -The natural language(s) of the intended audience for the message -content. The value is one or more language tags as defined by RFC -1766. Eg. "no" for some kind of Norwegian and "en-US" for English the -way it is written in the US. - -=item $h->title - -The title of the document. In libwww-perl this header will be -initialized automatically from the E<lt>TITLE>...E<lt>/TITLE> element -of HTML documents. I<This header is no longer part of the HTTP -standard.> - -=item $h->user_agent - -This header field is used in request messages and contains information -about the user agent originating the request. I<E.g.>: - - $h->user_agent('Mozilla/1.2'); - -=item $h->server - -The server header field contains information about the software being -used by the originating server program handling the request. - -=item $h->from - -This header should contain an Internet e-mail address for the human -user who controls the requesting user agent. The address should be -machine-usable, as defined by RFC822. E.g.: - - $h->from('King Kong <king@kong.com>'); - -I<This header is no longer part of the HTTP standard.> - -=item $h->referer - -Used to specify the address (URI) of the document from which the -requested resource address was obtained. - -The "Free On-line Dictionary of Computing" as this to say about the -word I<referer>: - - <World-Wide Web> A misspelling of "referrer" which - somehow made it into the {HTTP} standard. A given {web - page}'s referer (sic) is the {URL} of whatever web page - contains the link that the user followed to the current - page. Most browsers pass this information as part of a - request. - - (1998-10-19) - -By popular demand C<referrer> exists as an alias for this method so you -can avoid this misspelling in your programs and still send the right -thing on the wire. - -When setting the referrer, this method removes the fragment from the -given URI if it is present, as mandated by RFC2616. Note that -the removal does I<not> happen automatically if using the header(), -push_header() or init_header() methods to set the referrer. - -=item $h->www_authenticate - -This header must be included as part of a C<401 Unauthorized> response. -The field value consist of a challenge that indicates the -authentication scheme and parameters applicable to the requested URI. - -=item $h->proxy_authenticate - -This header must be included in a C<407 Proxy Authentication Required> -response. - -=item $h->authorization - -=item $h->proxy_authorization - -A user agent that wishes to authenticate itself with a server or a -proxy, may do so by including these headers. - -=item $h->authorization_basic - -This method is used to get or set an authorization header that use the -"Basic Authentication Scheme". In array context it will return two -values; the user name and the password. In scalar context it will -return I<"uname:password"> as a single string value. - -When used to set the header value, it expects two arguments. I<E.g.>: - - $h->authorization_basic($uname, $password); - -The method will croak if the $uname contains a colon ':'. - -=item $h->proxy_authorization_basic - -Same as authorization_basic() but will set the "Proxy-Authorization" -header instead. - -=back - -=head1 NON-CANONICALIZED FIELD NAMES - -The header field name spelling is normally canonicalized including the -'_' to '-' translation. There are some application where this is not -appropriate. Prefixing field names with ':' allow you to force a -specific spelling. For example if you really want a header field name -to show up as C<foo_bar> instead of "Foo-Bar", you might set it like -this: - - $h->header(":foo_bar" => 1); - -These field names are returned with the ':' intact for -$h->header_field_names and the $h->scan callback, but the colons do -not show in $h->as_string. - -=head1 COPYRIGHT - -Copyright 1995-2005 Gisle Aas. - -This library is free software; you can redistribute it and/or -modify it under the same terms as Perl itself. - |