diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/HTTP')
-rw-r--r-- | Master/tlpkg/tlperl/lib/HTTP/Config.pm | 2 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/HTTP/Cookies.pm | 2 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/HTTP/Cookies/Microsoft.pm | 2 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/HTTP/Cookies/Netscape.pm | 2 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/HTTP/Daemon.pm | 7 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/HTTP/Date.pm | 11 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/HTTP/Headers.pm | 2 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/HTTP/Headers/Auth.pm | 2 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/HTTP/Headers/ETag.pm | 2 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/HTTP/Headers/Util.pm | 4 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/HTTP/Message.pm | 39 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/HTTP/Negotiate.pm | 3 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/HTTP/Request.pm | 2 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/HTTP/Request/Common.pm | 11 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/HTTP/Response.pm | 17 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/HTTP/Status.pm | 25 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/HTTP/Tiny.pm | 1098 |
17 files changed, 1174 insertions, 57 deletions
diff --git a/Master/tlpkg/tlperl/lib/HTTP/Config.pm b/Master/tlpkg/tlperl/lib/HTTP/Config.pm index c7d9df53711..931f63db69d 100644 --- a/Master/tlpkg/tlperl/lib/HTTP/Config.pm +++ b/Master/tlpkg/tlperl/lib/HTTP/Config.pm @@ -4,7 +4,7 @@ use strict; use URI; use vars qw($VERSION); -$VERSION = "5.835"; +$VERSION = "6.00"; sub new { my $class = shift; diff --git a/Master/tlpkg/tlperl/lib/HTTP/Cookies.pm b/Master/tlpkg/tlperl/lib/HTTP/Cookies.pm index 831a4ace15c..79ac4f27f84 100644 --- a/Master/tlpkg/tlperl/lib/HTTP/Cookies.pm +++ b/Master/tlpkg/tlperl/lib/HTTP/Cookies.pm @@ -5,7 +5,7 @@ use HTTP::Date qw(str2time parse_date time2str); use HTTP::Headers::Util qw(_split_header_words join_header_words); use vars qw($VERSION $EPOCH_OFFSET); -$VERSION = "5.837"; +$VERSION = "6.01"; # Legacy: because "use "HTTP::Cookies" used be the ONLY way # to load the class HTTP::Cookies::Netscape. diff --git a/Master/tlpkg/tlperl/lib/HTTP/Cookies/Microsoft.pm b/Master/tlpkg/tlperl/lib/HTTP/Cookies/Microsoft.pm index c5a0bf77087..9c69fa364cf 100644 --- a/Master/tlpkg/tlperl/lib/HTTP/Cookies/Microsoft.pm +++ b/Master/tlpkg/tlperl/lib/HTTP/Cookies/Microsoft.pm @@ -4,7 +4,7 @@ use strict; use vars qw(@ISA $VERSION); -$VERSION = "5.821"; +$VERSION = "6.00"; require HTTP::Cookies; @ISA=qw(HTTP::Cookies); diff --git a/Master/tlpkg/tlperl/lib/HTTP/Cookies/Netscape.pm b/Master/tlpkg/tlperl/lib/HTTP/Cookies/Netscape.pm index f19c517f946..5972029e558 100644 --- a/Master/tlpkg/tlperl/lib/HTTP/Cookies/Netscape.pm +++ b/Master/tlpkg/tlperl/lib/HTTP/Cookies/Netscape.pm @@ -3,7 +3,7 @@ package HTTP::Cookies::Netscape; use strict; use vars qw(@ISA $VERSION); -$VERSION = "5.832"; +$VERSION = "6.00"; require HTTP::Cookies; @ISA=qw(HTTP::Cookies); diff --git a/Master/tlpkg/tlperl/lib/HTTP/Daemon.pm b/Master/tlpkg/tlperl/lib/HTTP/Daemon.pm index cf61147d077..27a7bf4e173 100644 --- a/Master/tlpkg/tlperl/lib/HTTP/Daemon.pm +++ b/Master/tlpkg/tlperl/lib/HTTP/Daemon.pm @@ -3,9 +3,9 @@ package HTTP::Daemon; use strict; use vars qw($VERSION @ISA $PROTO $DEBUG); -$VERSION = "5.827"; +$VERSION = "6.01"; -use IO::Socket qw(AF_INET INADDR_ANY inet_ntoa); +use IO::Socket qw(AF_INET INADDR_ANY INADDR_LOOPBACK inet_ntoa); @ISA=qw(IO::Socket::INET); $PROTO = "HTTP/1.1"; @@ -44,6 +44,9 @@ sub url require Sys::Hostname; $url .= lc Sys::Hostname::hostname(); } + elsif ($addr eq INADDR_LOOPBACK) { + $url .= inet_ntoa($addr); + } else { $url .= gethostbyaddr($addr, AF_INET) || inet_ntoa($addr); } diff --git a/Master/tlpkg/tlperl/lib/HTTP/Date.pm b/Master/tlpkg/tlperl/lib/HTTP/Date.pm index 7756214af98..d05d21605ae 100644 --- a/Master/tlpkg/tlperl/lib/HTTP/Date.pm +++ b/Master/tlpkg/tlperl/lib/HTTP/Date.pm @@ -1,8 +1,7 @@ package HTTP::Date; -$VERSION = "5.831"; +$VERSION = "6.02"; -require 5.004; require Exporter; @ISA = qw(Exporter); @EXPORT = qw(time2str str2time); @@ -107,7 +106,7 @@ sub parse_date ($) \s* ([-+]?\d{2,4}|(?![APap][Mm]\b)[A-Za-z]+)? # timezone \s* - (?:\(\w+\))? # ASCII representation of timezone in parens. + (?:\(\w+\)|\w{3,})? # ASCII representation of timezone. \s*$ /x) @@ -316,13 +315,13 @@ to get the date recognized. This function will try to parse a date string, and then return it as a list of numerical values followed by a (possible undefined) time zone specifier; ($year, $month, $day, $hour, $min, $sec, $tz). The $year -returned will B<not> have the number 1900 subtracted from it and the -$month numbers start with 1. +will be the full 4-digit year, and $month numbers start with 1 (for January). In scalar context the numbers are interpolated in a string of the "YYYY-MM-DD hh:mm:ss TZ"-format and returned. -If the date is unrecognized, then the empty list is returned. +If the date is unrecognized, then the empty list is returned (C<undef> in +scalar context). The function is able to parse the following formats: diff --git a/Master/tlpkg/tlperl/lib/HTTP/Headers.pm b/Master/tlpkg/tlperl/lib/HTTP/Headers.pm index 1e9198cd3c7..67f1d2e6406 100644 --- a/Master/tlpkg/tlperl/lib/HTTP/Headers.pm +++ b/Master/tlpkg/tlperl/lib/HTTP/Headers.pm @@ -4,7 +4,7 @@ use strict; use Carp (); use vars qw($VERSION $TRANSLATE_UNDERSCORE); -$VERSION = "5.835"; +$VERSION = "6.00"; # The $TRANSLATE_UNDERSCORE variable controls whether '_' can be used # as a replacement for '-' in header field names. diff --git a/Master/tlpkg/tlperl/lib/HTTP/Headers/Auth.pm b/Master/tlpkg/tlperl/lib/HTTP/Headers/Auth.pm index 1e416e2dd9a..64e204ce388 100644 --- a/Master/tlpkg/tlperl/lib/HTTP/Headers/Auth.pm +++ b/Master/tlpkg/tlperl/lib/HTTP/Headers/Auth.pm @@ -2,7 +2,7 @@ package HTTP::Headers::Auth; use strict; use vars qw($VERSION); -$VERSION = "5.817"; +$VERSION = "6.00"; use HTTP::Headers; diff --git a/Master/tlpkg/tlperl/lib/HTTP/Headers/ETag.pm b/Master/tlpkg/tlperl/lib/HTTP/Headers/ETag.pm index 743da463de4..e0b2c7e255c 100644 --- a/Master/tlpkg/tlperl/lib/HTTP/Headers/ETag.pm +++ b/Master/tlpkg/tlperl/lib/HTTP/Headers/ETag.pm @@ -2,7 +2,7 @@ package HTTP::Headers::ETag; use strict; use vars qw($VERSION); -$VERSION = "5.810"; +$VERSION = "6.00"; require HTTP::Date; diff --git a/Master/tlpkg/tlperl/lib/HTTP/Headers/Util.pm b/Master/tlpkg/tlperl/lib/HTTP/Headers/Util.pm index 9ae65e7faf5..fdcf501b8e5 100644 --- a/Master/tlpkg/tlperl/lib/HTTP/Headers/Util.pm +++ b/Master/tlpkg/tlperl/lib/HTTP/Headers/Util.pm @@ -3,7 +3,7 @@ package HTTP::Headers::Util; use strict; use vars qw($VERSION @ISA @EXPORT_OK); -$VERSION = "5.817"; +$VERSION = "6.03"; require Exporter; @ISA=qw(Exporter); @@ -153,7 +153,7 @@ the requirement for tokens). Each I<header> is represented by an anonymous array of key/value pairs. The keys will be all be forced to lower case. The value for a simple token (not part of a parameter) is C<undef>. -Syntactically incorrect headers will not necessary be parsed as you +Syntactically incorrect headers will not necessarily be parsed as you would want. This is easier to describe with some examples: diff --git a/Master/tlpkg/tlperl/lib/HTTP/Message.pm b/Master/tlpkg/tlperl/lib/HTTP/Message.pm index 944e88d1899..4aae3f2c8a1 100644 --- a/Master/tlpkg/tlperl/lib/HTTP/Message.pm +++ b/Master/tlpkg/tlperl/lib/HTTP/Message.pm @@ -2,7 +2,7 @@ package HTTP::Message; use strict; use vars qw($VERSION $AUTOLOAD); -$VERSION = "5.837"; +$VERSION = "6.03"; require HTTP::Headers; require Carp; @@ -307,7 +307,7 @@ sub decoded_content $content_ref = \$output; $content_ref_iscopy++; } - elsif ($ce eq "x-bzip2") { + elsif ($ce eq "x-bzip2" or $ce eq "bzip2") { require IO::Uncompress::Bunzip2; my $output; IO::Uncompress::Bunzip2::bunzip2($content_ref, \$output, Transparent => 0) @@ -364,16 +364,21 @@ sub decoded_content $self->content_charset || "ISO-8859-1" ); - unless ($charset =~ /^(?:none|us-ascii|iso-8859-1)\z/) { - require Encode; - if (do{my $v = $Encode::VERSION; $v =~ s/_//g; $v} < 2.0901 && - !$content_ref_iscopy) - { - # LEAVE_SRC did not work before Encode-2.0901 - my $copy = $$content_ref; - $content_ref = \$copy; - $content_ref_iscopy++; + if ($charset eq "none") { + # leave it asis + } + elsif ($charset eq "us-ascii" || $charset eq "iso-8859-1") { + if ($$content_ref =~ /[^\x00-\x7F]/ && defined &utf8::upgrade) { + unless ($content_ref_iscopy) { + my $copy = $$content_ref; + $content_ref = \$copy; + $content_ref_iscopy++; + } + utf8::upgrade($$content_ref); } + } + else { + require Encode; eval { $content_ref = \Encode::decode($charset, $$content_ref, ($opt{charset_strict} ? Encode::FB_CROAK() : 0) | Encode::LEAVE_SRC()); @@ -386,7 +391,7 @@ sub decoded_content # Retry decoding with the alternative charset $content_ref = \Encode::decode($alt_charset, $$content_ref, ($opt{charset_strict} ? Encode::FB_CROAK() : 0) | Encode::LEAVE_SRC()) - unless $alt_charset =~ /^(?:none|us-ascii|iso-8859-1)\z/; + unless $alt_charset eq "none"; $retried++; } } @@ -869,10 +874,10 @@ for details about how charset is determined. =item $mess->decoded_content( %options ) -Returns the content with any C<Content-Encoding> undone and the raw -content encoded to perl's Unicode strings. If the C<Content-Encoding> -or C<charset> of the message is unknown this method will fail by -returning C<undef>. +Returns the content with any C<Content-Encoding> undone and for textual content +the raw content encoded to Perl's Unicode strings. If the C<Content-Encoding> +or C<charset> of the message is unknown this method will fail by returning +C<undef>. The following options can be specified. @@ -976,7 +981,7 @@ one part returned. If the content type is C<message/http>, then the return value will be either an C<HTTP::Request> or an C<HTTP::Response> object. -If an @parts argument is given, then the content of the message will be +If a @parts argument is given, then the content of the message will be modified. The array reference form is provided so that an empty list can be provided. The @parts array should contain C<HTTP::Message> objects. The @parts objects are owned by $mess after this call and diff --git a/Master/tlpkg/tlperl/lib/HTTP/Negotiate.pm b/Master/tlpkg/tlperl/lib/HTTP/Negotiate.pm index 7ded7e6d5a5..d293ce86d97 100644 --- a/Master/tlpkg/tlperl/lib/HTTP/Negotiate.pm +++ b/Master/tlpkg/tlperl/lib/HTTP/Negotiate.pm @@ -1,9 +1,8 @@ package HTTP::Negotiate; -$VERSION = "5.835"; +$VERSION = "6.01"; sub Version { $VERSION; } -require 5.002; require Exporter; @ISA = qw(Exporter); @EXPORT = qw(choose); diff --git a/Master/tlpkg/tlperl/lib/HTTP/Request.pm b/Master/tlpkg/tlperl/lib/HTTP/Request.pm index ac7dc65af43..154ea2f926c 100644 --- a/Master/tlpkg/tlperl/lib/HTTP/Request.pm +++ b/Master/tlpkg/tlperl/lib/HTTP/Request.pm @@ -2,7 +2,7 @@ package HTTP::Request; require HTTP::Message; @ISA = qw(HTTP::Message); -$VERSION = "5.827"; +$VERSION = "6.00"; use strict; diff --git a/Master/tlpkg/tlperl/lib/HTTP/Request/Common.pm b/Master/tlpkg/tlperl/lib/HTTP/Request/Common.pm index 7e3e03a861b..626e048d65f 100644 --- a/Master/tlpkg/tlperl/lib/HTTP/Request/Common.pm +++ b/Master/tlpkg/tlperl/lib/HTTP/Request/Common.pm @@ -13,7 +13,7 @@ require Exporter; require HTTP::Request; use Carp(); -$VERSION = "5.824"; +$VERSION = "6.03"; my $CRLF = "\015\012"; # "\r\n" is not portable @@ -81,6 +81,9 @@ sub POST my $url = URI->new('http:'); $url->query_form(ref($content) eq "HASH" ? %$content : @$content); $content = $url->query; + + # HTML/4.01 says that line breaks are represented as "CR LF" pairs (i.e., `%0D%0A') + $content =~ s/(?<!%0D)%0A/%0D%0A/g; } } @@ -389,7 +392,7 @@ the $form_ref this way. The $form_ref argument can be used to pass key/value pairs for the form content. By default we will initialize a request using the C<application/x-www-form-urlencoded> content type. This means that -you can emulate a HTML E<lt>form> POSTing like this: +you can emulate an HTML E<lt>form> POSTing like this: POST 'http://www.perl.org/survey.cgi', [ name => 'Gisle Aas', @@ -399,7 +402,7 @@ you can emulate a HTML E<lt>form> POSTing like this: perc => '3%', ]; -This will create a HTTP::Request object that looks like this: +This will create an HTTP::Request object that looks like this: POST http://www.perl.org/survey.cgi Content-Length: 66 @@ -445,7 +448,7 @@ achieved by this: init => ["$ENV{HOME}/.profile"], ] -This will create a HTTP::Request object that almost looks this (the +This will create an HTTP::Request object that almost looks this (the boundary and the content of your F<~/.profile> is likely to be different): diff --git a/Master/tlpkg/tlperl/lib/HTTP/Response.pm b/Master/tlpkg/tlperl/lib/HTTP/Response.pm index b60f06fc09a..8bdb1c5bd1e 100644 --- a/Master/tlpkg/tlperl/lib/HTTP/Response.pm +++ b/Master/tlpkg/tlperl/lib/HTTP/Response.pm @@ -2,7 +2,7 @@ package HTTP::Response; require HTTP::Message; @ISA = qw(HTTP::Message); -$VERSION = "5.836"; +$VERSION = "6.03"; use strict; use HTTP::Status (); @@ -143,12 +143,8 @@ sub filename } require Encode; - require encoding; - # This is ugly use of non-public API, but is there - # a better way to accomplish what we want (locally - # as-is usable filename string)? - my $locale_charset = encoding::_get_locale_encoding(); - Encode::from_to($encfile, $charset, $locale_charset); + require Encode::Locale; + Encode::from_to($encfile, $charset, "locale_fs"); }; $file = $encfile unless $@; @@ -221,10 +217,11 @@ sub is_error { HTTP::Status::is_error (shift->{'_rc'}); } sub error_as_HTML { - require HTML::Entities; my $self = shift; my $title = 'An Error Occurred'; - my $body = HTML::Entities::encode($self->status_line); + my $body = $self->status_line; + $body =~ s/&/&/g; + $body =~ s/</</g; return <<EOM; <html> <head><title>$title</title></head> @@ -395,7 +392,7 @@ This constructs a new response object by parsing the given string. =item $r->code( $code ) This is used to get/set the code attribute. The code is a 3 digit -number that encode the overall outcome of a HTTP response. The +number that encode the overall outcome of an HTTP response. The C<HTTP::Status> module provide constants that provide mnemonic names for the code attribute. diff --git a/Master/tlpkg/tlperl/lib/HTTP/Status.pm b/Master/tlpkg/tlperl/lib/HTTP/Status.pm index 930bd878858..f229af6c226 100644 --- a/Master/tlpkg/tlperl/lib/HTTP/Status.pm +++ b/Master/tlpkg/tlperl/lib/HTTP/Status.pm @@ -9,7 +9,7 @@ require Exporter; @ISA = qw(Exporter); @EXPORT = qw(is_info is_success is_redirect is_error status_message); @EXPORT_OK = qw(is_client_error is_server_error); -$VERSION = "5.817"; +$VERSION = "6.03"; # Note also addition of mnemonics to @EXPORT below @@ -28,6 +28,7 @@ my %StatusCode = ( 205 => 'Reset Content', 206 => 'Partial Content', 207 => 'Multi-Status', # RFC 2518 (WebDAV) + 208 => 'Already Reported', # RFC 5842 300 => 'Multiple Choices', 301 => 'Moved Permanently', 302 => 'Found', @@ -53,11 +54,15 @@ my %StatusCode = ( 415 => 'Unsupported Media Type', 416 => 'Request Range Not Satisfiable', 417 => 'Expectation Failed', + 418 => 'I\'m a teapot', # RFC 2324 422 => 'Unprocessable Entity', # RFC 2518 (WebDAV) 423 => 'Locked', # RFC 2518 (WebDAV) 424 => 'Failed Dependency', # RFC 2518 (WebDAV) 425 => 'No code', # WebDAV Advanced Collections 426 => 'Upgrade Required', # RFC 2817 + 428 => 'Precondition Required', + 429 => 'Too Many Requests', + 431 => 'Request Header Fields Too Large', 449 => 'Retry with', # unofficial Microsoft 500 => 'Internal Server Error', 501 => 'Not Implemented', @@ -69,12 +74,14 @@ my %StatusCode = ( 507 => 'Insufficient Storage', # RFC 2518 (WebDAV) 509 => 'Bandwidth Limit Exceeded', # unofficial 510 => 'Not Extended', # RFC 2774 + 511 => 'Network Authentication Required', ); my $mnemonicCode = ''; my ($code, $message); while (($code, $message) = each %StatusCode) { # create mnemonic subroutines + $message =~ s/I'm/I am/; $message =~ tr/a-z \-/A-Z__/; $mnemonicCode .= "sub HTTP_$message () { $code }\n"; $mnemonicCode .= "*RC_$message = \\&HTTP_$message;\n"; # legacy @@ -128,7 +135,7 @@ HTTP::Status - HTTP Status code processing I<HTTP::Status> is a library of routines for defining and classifying HTTP status codes for libwww-perl. Status codes are -used to encode the overall outcome of a HTTP response message. Codes +used to encode the overall outcome of an HTTP response message. Codes correspond to those defined in RFC 2616 and RFC 2518. =head1 CONSTANTS @@ -149,6 +156,7 @@ tag to import them all. HTTP_RESET_CONTENT (205) HTTP_PARTIAL_CONTENT (206) HTTP_MULTI_STATUS (207) + HTTP_ALREADY_REPORTED (208) HTTP_MULTIPLE_CHOICES (300) HTTP_MOVED_PERMANENTLY (301) @@ -176,11 +184,15 @@ tag to import them all. HTTP_UNSUPPORTED_MEDIA_TYPE (415) HTTP_REQUEST_RANGE_NOT_SATISFIABLE (416) HTTP_EXPECTATION_FAILED (417) + HTTP_I_AM_A_TEAPOT (418) HTTP_UNPROCESSABLE_ENTITY (422) HTTP_LOCKED (423) HTTP_FAILED_DEPENDENCY (424) HTTP_NO_CODE (425) HTTP_UPGRADE_REQUIRED (426) + HTTP_PRECONDITION_REQUIRED (428) + HTTP_TOO_MANY_REQUESTS (429) + HTTP_REQUEST_HEADER_FIELDS_TOO_LARGE (431) HTTP_RETRY_WITH (449) HTTP_INTERNAL_SERVER_ERROR (500) @@ -193,6 +205,7 @@ tag to import them all. HTTP_INSUFFICIENT_STORAGE (507) HTTP_BANDWIDTH_LIMIT_EXCEEDED (509) HTTP_NOT_EXTENDED (510) + HTTP_NETWORK_AUTHENTICATION_REQUIRED (511) =head1 FUNCTIONS @@ -227,11 +240,11 @@ user agent in order to fulfill the request. =item is_error( $code ) Return TRUE if C<$code> is an I<Error> status code (4xx or 5xx). The function -return TRUE for both client error or a server error status codes. +returns TRUE for both client and server error status codes. =item is_client_error( $code ) -Return TRUE if C<$code> is an I<Client Error> status code (4xx). This class +Return TRUE if C<$code> is a I<Client Error> status code (4xx). This class of status code is intended for cases in which the client seems to have erred. @@ -239,7 +252,7 @@ This function is B<not> exported by default. =item is_server_error( $code ) -Return TRUE if C<$code> is an I<Server Error> status code (5xx). This class +Return TRUE if C<$code> is a I<Server Error> status code (5xx). This class of status codes is intended for cases in which the server is aware that it has erred or is incapable of performing the request. @@ -250,5 +263,5 @@ This function is B<not> exported by default. =head1 BUGS For legacy reasons all the C<HTTP_> constants are exported by default -with the prefix C<RC_>. It's recommended to use explict imports and +with the prefix C<RC_>. It's recommended to use explicit imports and the C<:constants> tag instead of relying on this. diff --git a/Master/tlpkg/tlperl/lib/HTTP/Tiny.pm b/Master/tlpkg/tlperl/lib/HTTP/Tiny.pm new file mode 100644 index 00000000000..b4f6bd733c5 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/HTTP/Tiny.pm @@ -0,0 +1,1098 @@ +# vim: ts=4 sts=4 sw=4 et: +# +# This file is part of HTTP-Tiny +# +# This software is copyright (c) 2011 by Christian Hansen. +# +# This is free software; you can redistribute it and/or modify it under +# the same terms as the Perl 5 programming language system itself. +# +package HTTP::Tiny; +BEGIN { + $HTTP::Tiny::VERSION = '0.012'; +} +use strict; +use warnings; +# ABSTRACT: A small, simple, correct HTTP/1.1 client + +use Carp (); + + +my @attributes; +BEGIN { + @attributes = qw(agent default_headers max_redirect max_size proxy timeout); + no strict 'refs'; + for my $accessor ( @attributes ) { + *{$accessor} = sub { + @_ > 1 ? $_[0]->{$accessor} = $_[1] : $_[0]->{$accessor}; + }; + } +} + +sub new { + my($class, %args) = @_; + (my $agent = $class) =~ s{::}{-}g; + my $self = { + agent => $agent . "/" . ($class->VERSION || 0), + max_redirect => 5, + timeout => 60, + }; + for my $key ( @attributes ) { + $self->{$key} = $args{$key} if exists $args{$key} + } + return bless $self, $class; +} + + +sub get { + my ($self, $url, $args) = @_; + @_ == 2 || (@_ == 3 && ref $args eq 'HASH') + or Carp::croak(q/Usage: $http->get(URL, [HASHREF])/); + return $self->request('GET', $url, $args || {}); +} + + +sub mirror { + my ($self, $url, $file, $args) = @_; + @_ == 3 || (@_ == 4 && ref $args eq 'HASH') + or Carp::croak(q/Usage: $http->mirror(URL, FILE, [HASHREF])/); + if ( -e $file and my $mtime = (stat($file))[9] ) { + $args->{headers}{'if-modified-since'} ||= $self->_http_date($mtime); + } + my $tempfile = $file . int(rand(2**31)); + open my $fh, ">", $tempfile + or Carp::croak(qq/Error: Could not open temporary file $tempfile for downloading: $!/); + binmode $fh; + $args->{data_callback} = sub { print {$fh} $_[0] }; + my $response = $self->request('GET', $url, $args); + close $fh + or Carp::croak(qq/Error: Could not close temporary file $tempfile: $!/); + if ( $response->{success} ) { + rename $tempfile, $file + or Carp::croak "Error replacing $file with $tempfile: $!\n"; + my $lm = $response->{headers}{'last-modified'}; + if ( $lm and my $mtime = $self->_parse_http_date($lm) ) { + utime $mtime, $mtime, $file; + } + } + $response->{success} ||= $response->{status} eq '304'; + unlink $tempfile; + return $response; +} + + +my %idempotent = map { $_ => 1 } qw/GET HEAD PUT DELETE OPTIONS TRACE/; + +sub request { + my ($self, $method, $url, $args) = @_; + @_ == 3 || (@_ == 4 && ref $args eq 'HASH') + or Carp::croak(q/Usage: $http->request(METHOD, URL, [HASHREF])/); + $args ||= {}; # we keep some state in this during _request + + # RFC 2616 Section 8.1.4 mandates a single retry on broken socket + my $response; + for ( 0 .. 1 ) { + $response = eval { $self->_request($method, $url, $args) }; + last unless $@ && $idempotent{$method} + && $@ =~ m{^(?:Socket closed|Unexpected end)}; + } + + if (my $e = "$@") { + $response = { + success => q{}, + status => 599, + reason => 'Internal Exception', + content => $e, + headers => { + 'content-type' => 'text/plain', + 'content-length' => length $e, + } + }; + } + return $response; +} + +my %DefaultPort = ( + http => 80, + https => 443, +); + +sub _request { + my ($self, $method, $url, $args) = @_; + + my ($scheme, $host, $port, $path_query) = $self->_split_url($url); + + my $request = { + method => $method, + scheme => $scheme, + host_port => ($port == $DefaultPort{$scheme} ? $host : "$host:$port"), + uri => $path_query, + headers => {}, + }; + + my $handle = HTTP::Tiny::Handle->new(timeout => $self->{timeout}); + + if ($self->{proxy}) { + $request->{uri} = "$scheme://$request->{host_port}$path_query"; + croak(qq/HTTPS via proxy is not supported/) + if $request->{scheme} eq 'https'; + $handle->connect(($self->_split_url($self->{proxy}))[0..2]); + } + else { + $handle->connect($scheme, $host, $port); + } + + $self->_prepare_headers_and_cb($request, $args); + $handle->write_request($request); + + my $response; + do { $response = $handle->read_response_header } + until (substr($response->{status},0,1) ne '1'); + + if ( my @redir_args = $self->_maybe_redirect($request, $response, $args) ) { + $handle->close; + return $self->_request(@redir_args, $args); + } + + if ($method eq 'HEAD' || $response->{status} =~ /^[23]04/) { + # response has no message body + } + else { + my $data_cb = $self->_prepare_data_cb($response, $args); + $handle->read_body($data_cb, $response); + } + + $handle->close; + $response->{success} = substr($response->{status},0,1) eq '2'; + return $response; +} + +sub _prepare_headers_and_cb { + my ($self, $request, $args) = @_; + + for ($self->{default_headers}, $args->{headers}) { + next unless defined; + while (my ($k, $v) = each %$_) { + $request->{headers}{lc $k} = $v; + } + } + $request->{headers}{'host'} = $request->{host_port}; + $request->{headers}{'connection'} = "close"; + $request->{headers}{'user-agent'} ||= $self->{agent}; + + if (defined $args->{content}) { + $request->{headers}{'content-type'} ||= "application/octet-stream"; + if (ref $args->{content} eq 'CODE') { + $request->{headers}{'transfer-encoding'} = 'chunked' + unless $request->{headers}{'content-length'} + || $request->{headers}{'transfer-encoding'}; + $request->{cb} = $args->{content}; + } + else { + my $content = $args->{content}; + if ( $] ge '5.008' ) { + utf8::downgrade($content, 1) + or Carp::croak(q/Wide character in request message body/); + } + $request->{headers}{'content-length'} = length $content + unless $request->{headers}{'content-length'} + || $request->{headers}{'transfer-encoding'}; + $request->{cb} = sub { substr $content, 0, length $content, '' }; + } + $request->{trailer_cb} = $args->{trailer_callback} + if ref $args->{trailer_callback} eq 'CODE'; + } + return; +} + +sub _prepare_data_cb { + my ($self, $response, $args) = @_; + my $data_cb = $args->{data_callback}; + $response->{content} = ''; + + if (!$data_cb || $response->{status} !~ /^2/) { + if (defined $self->{max_size}) { + $data_cb = sub { + $_[1]->{content} .= $_[0]; + die(qq/Size of response body exceeds the maximum allowed of $self->{max_size}\n/) + if length $_[1]->{content} > $self->{max_size}; + }; + } + else { + $data_cb = sub { $_[1]->{content} .= $_[0] }; + } + } + return $data_cb; +} + +sub _maybe_redirect { + my ($self, $request, $response, $args) = @_; + my $headers = $response->{headers}; + my ($status, $method) = ($response->{status}, $request->{method}); + if (($status eq '303' or ($status =~ /^30[127]/ && $method =~ /^GET|HEAD$/)) + and $headers->{location} + and ++$args->{redirects} <= $self->{max_redirect} + ) { + my $location = ($headers->{location} =~ /^\//) + ? "$request->{scheme}://$request->{host_port}$headers->{location}" + : $headers->{location} ; + return (($status eq '303' ? 'GET' : $method), $location); + } + return; +} + +sub _split_url { + my $url = pop; + + # URI regex adapted from the URI module + my ($scheme, $authority, $path_query) = $url =~ m<\A([^:/?#]+)://([^/?#]*)([^#]*)> + or Carp::croak(qq/Cannot parse URL: '$url'/); + + $scheme = lc $scheme; + $path_query = "/$path_query" unless $path_query =~ m<\A/>; + + my $host = (length($authority)) ? lc $authority : 'localhost'; + $host =~ s/\A[^@]*@//; # userinfo + my $port = do { + $host =~ s/:([0-9]*)\z// && length $1 + ? $1 + : ($scheme eq 'http' ? 80 : $scheme eq 'https' ? 443 : undef); + }; + + return ($scheme, $host, $port, $path_query); +} + +# Date conversions adapted from HTTP::Date +my $DoW = "Sun|Mon|Tue|Wed|Thu|Fri|Sat"; +my $MoY = "Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec"; +sub _http_date { + my ($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime($_[1]); + return sprintf("%s, %02d %s %04d %02d:%02d:%02d GMT", + substr($DoW,$wday*4,3), + $mday, substr($MoY,$mon*4,3), $year+1900, + $hour, $min, $sec + ); +} + +sub _parse_http_date { + my ($self, $str) = @_; + require Time::Local; + my @tl_parts; + if ($str =~ /^[SMTWF][a-z]+, +(\d{1,2}) ($MoY) +(\d\d\d\d) +(\d\d):(\d\d):(\d\d) +GMT$/) { + @tl_parts = ($6, $5, $4, $1, (index($MoY,$2)/4), $3); + } + elsif ($str =~ /^[SMTWF][a-z]+, +(\d\d)-($MoY)-(\d{2,4}) +(\d\d):(\d\d):(\d\d) +GMT$/ ) { + @tl_parts = ($6, $5, $4, $1, (index($MoY,$2)/4), $3); + } + elsif ($str =~ /^[SMTWF][a-z]+ +($MoY) +(\d{1,2}) +(\d\d):(\d\d):(\d\d) +(?:[^0-9]+ +)?(\d\d\d\d)$/ ) { + @tl_parts = ($5, $4, $3, $2, (index($MoY,$1)/4), $6); + } + return eval { + my $t = @tl_parts ? Time::Local::timegm(@tl_parts) : -1; + $t < 0 ? undef : $t; + }; +} + +package + HTTP::Tiny::Handle; # hide from PAUSE/indexers +use strict; +use warnings; + +use Carp qw[croak]; +use Errno qw[EINTR EPIPE]; +use IO::Socket qw[SOCK_STREAM]; + +sub BUFSIZE () { 32768 } + +my $Printable = sub { + local $_ = shift; + s/\r/\\r/g; + s/\n/\\n/g; + s/\t/\\t/g; + s/([^\x20-\x7E])/sprintf('\\x%.2X', ord($1))/ge; + $_; +}; + +my $Token = qr/[\x21\x23-\x27\x2A\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5E-\x7A\x7C\x7E]/; + +sub new { + my ($class, %args) = @_; + return bless { + rbuf => '', + timeout => 60, + max_line_size => 16384, + max_header_lines => 64, + %args + }, $class; +} + +my $ssl_verify_args = { + check_cn => "when_only", + wildcards_in_alt => "anywhere", + wildcards_in_cn => "anywhere" +}; + +sub connect { + @_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/); + my ($self, $scheme, $host, $port) = @_; + + if ( $scheme eq 'https' ) { + eval "require IO::Socket::SSL" + unless exists $INC{'IO/Socket/SSL.pm'}; + croak(qq/IO::Socket::SSL must be installed for https support\n/) + unless $INC{'IO/Socket/SSL.pm'}; + } + elsif ( $scheme ne 'http' ) { + croak(qq/Unsupported URL scheme '$scheme'/); + } + + $self->{fh} = 'IO::Socket::INET'->new( + PeerHost => $host, + PeerPort => $port, + Proto => 'tcp', + Type => SOCK_STREAM, + Timeout => $self->{timeout} + ) or croak(qq/Could not connect to '$host:$port': $@/); + + binmode($self->{fh}) + or croak(qq/Could not binmode() socket: '$!'/); + + if ( $scheme eq 'https') { + IO::Socket::SSL->start_SSL($self->{fh}); + ref($self->{fh}) eq 'IO::Socket::SSL' + or die(qq/SSL connection failed for $host\n/); + $self->{fh}->verify_hostname( $host, $ssl_verify_args ) + or die(qq/SSL certificate not valid for $host\n/); + } + + $self->{host} = $host; + $self->{port} = $port; + + return $self; +} + +sub close { + @_ == 1 || croak(q/Usage: $handle->close()/); + my ($self) = @_; + CORE::close($self->{fh}) + or croak(qq/Could not close socket: '$!'/); +} + +sub write { + @_ == 2 || croak(q/Usage: $handle->write(buf)/); + my ($self, $buf) = @_; + + if ( $] ge '5.008' ) { + utf8::downgrade($buf, 1) + or croak(q/Wide character in write()/); + } + + my $len = length $buf; + my $off = 0; + + local $SIG{PIPE} = 'IGNORE'; + + while () { + $self->can_write + or croak(q/Timed out while waiting for socket to become ready for writing/); + my $r = syswrite($self->{fh}, $buf, $len, $off); + if (defined $r) { + $len -= $r; + $off += $r; + last unless $len > 0; + } + elsif ($! == EPIPE) { + croak(qq/Socket closed by remote server: $!/); + } + elsif ($! != EINTR) { + croak(qq/Could not write to socket: '$!'/); + } + } + return $off; +} + +sub read { + @_ == 2 || @_ == 3 || croak(q/Usage: $handle->read(len [, allow_partial])/); + my ($self, $len, $allow_partial) = @_; + + my $buf = ''; + my $got = length $self->{rbuf}; + + if ($got) { + my $take = ($got < $len) ? $got : $len; + $buf = substr($self->{rbuf}, 0, $take, ''); + $len -= $take; + } + + while ($len > 0) { + $self->can_read + or croak(q/Timed out while waiting for socket to become ready for reading/); + my $r = sysread($self->{fh}, $buf, $len, length $buf); + if (defined $r) { + last unless $r; + $len -= $r; + } + elsif ($! != EINTR) { + croak(qq/Could not read from socket: '$!'/); + } + } + if ($len && !$allow_partial) { + croak(q/Unexpected end of stream/); + } + return $buf; +} + +sub readline { + @_ == 1 || croak(q/Usage: $handle->readline()/); + my ($self) = @_; + + while () { + if ($self->{rbuf} =~ s/\A ([^\x0D\x0A]* \x0D?\x0A)//x) { + return $1; + } + if (length $self->{rbuf} >= $self->{max_line_size}) { + croak(qq/Line size exceeds the maximum allowed size of $self->{max_line_size}/); + } + $self->can_read + or croak(q/Timed out while waiting for socket to become ready for reading/); + my $r = sysread($self->{fh}, $self->{rbuf}, BUFSIZE, length $self->{rbuf}); + if (defined $r) { + last unless $r; + } + elsif ($! != EINTR) { + croak(qq/Could not read from socket: '$!'/); + } + } + croak(q/Unexpected end of stream while looking for line/); +} + +sub read_header_lines { + @_ == 1 || @_ == 2 || croak(q/Usage: $handle->read_header_lines([headers])/); + my ($self, $headers) = @_; + $headers ||= {}; + my $lines = 0; + my $val; + + while () { + my $line = $self->readline; + + if (++$lines >= $self->{max_header_lines}) { + croak(qq/Header lines exceeds maximum number allowed of $self->{max_header_lines}/); + } + elsif ($line =~ /\A ([^\x00-\x1F\x7F:]+) : [\x09\x20]* ([^\x0D\x0A]*)/x) { + my ($field_name) = lc $1; + if (exists $headers->{$field_name}) { + for ($headers->{$field_name}) { + $_ = [$_] unless ref $_ eq "ARRAY"; + push @$_, $2; + $val = \$_->[-1]; + } + } + else { + $val = \($headers->{$field_name} = $2); + } + } + elsif ($line =~ /\A [\x09\x20]+ ([^\x0D\x0A]*)/x) { + $val + or croak(q/Unexpected header continuation line/); + next unless length $1; + $$val .= ' ' if length $$val; + $$val .= $1; + } + elsif ($line =~ /\A \x0D?\x0A \z/x) { + last; + } + else { + croak(q/Malformed header line: / . $Printable->($line)); + } + } + return $headers; +} + +sub write_request { + @_ == 2 || croak(q/Usage: $handle->write_request(request)/); + my($self, $request) = @_; + $self->write_request_header(@{$request}{qw/method uri headers/}); + $self->write_body($request) if $request->{cb}; + return; +} + +my %HeaderCase = ( + 'content-md5' => 'Content-MD5', + 'etag' => 'ETag', + 'te' => 'TE', + 'www-authenticate' => 'WWW-Authenticate', + 'x-xss-protection' => 'X-XSS-Protection', +); + +sub write_header_lines { + (@_ == 2 && ref $_[1] eq 'HASH') || croak(q/Usage: $handle->write_header_lines(headers)/); + my($self, $headers) = @_; + + my $buf = ''; + while (my ($k, $v) = each %$headers) { + my $field_name = lc $k; + if (exists $HeaderCase{$field_name}) { + $field_name = $HeaderCase{$field_name}; + } + else { + $field_name =~ /\A $Token+ \z/xo + or croak(q/Invalid HTTP header field name: / . $Printable->($field_name)); + $field_name =~ s/\b(\w)/\u$1/g; + $HeaderCase{lc $field_name} = $field_name; + } + for (ref $v eq 'ARRAY' ? @$v : $v) { + /[^\x0D\x0A]/ + or croak(qq/Invalid HTTP header field value ($field_name): / . $Printable->($_)); + $buf .= "$field_name: $_\x0D\x0A"; + } + } + $buf .= "\x0D\x0A"; + return $self->write($buf); +} + +sub read_body { + @_ == 3 || croak(q/Usage: $handle->read_body(callback, response)/); + my ($self, $cb, $response) = @_; + my $te = $response->{headers}{'transfer-encoding'} || ''; + if ( grep { /chunked/i } ( ref $te eq 'ARRAY' ? @$te : $te ) ) { + $self->read_chunked_body($cb, $response); + } + else { + $self->read_content_body($cb, $response); + } + return; +} + +sub write_body { + @_ == 2 || croak(q/Usage: $handle->write_body(request)/); + my ($self, $request) = @_; + if ($request->{headers}{'content-length'}) { + return $self->write_content_body($request); + } + else { + return $self->write_chunked_body($request); + } +} + +sub read_content_body { + @_ == 3 || @_ == 4 || croak(q/Usage: $handle->read_content_body(callback, response, [read_length])/); + my ($self, $cb, $response, $content_length) = @_; + $content_length ||= $response->{headers}{'content-length'}; + + if ( $content_length ) { + my $len = $content_length; + while ($len > 0) { + my $read = ($len > BUFSIZE) ? BUFSIZE : $len; + $cb->($self->read($read, 0), $response); + $len -= $read; + } + } + else { + my $chunk; + $cb->($chunk, $response) while length( $chunk = $self->read(BUFSIZE, 1) ); + } + + return; +} + +sub write_content_body { + @_ == 2 || croak(q/Usage: $handle->write_content_body(request)/); + my ($self, $request) = @_; + + my ($len, $content_length) = (0, $request->{headers}{'content-length'}); + while () { + my $data = $request->{cb}->(); + + defined $data && length $data + or last; + + if ( $] ge '5.008' ) { + utf8::downgrade($data, 1) + or croak(q/Wide character in write_content()/); + } + + $len += $self->write($data); + } + + $len == $content_length + or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/); + + return $len; +} + +sub read_chunked_body { + @_ == 3 || croak(q/Usage: $handle->read_chunked_body(callback, $response)/); + my ($self, $cb, $response) = @_; + + while () { + my $head = $self->readline; + + $head =~ /\A ([A-Fa-f0-9]+)/x + or croak(q/Malformed chunk head: / . $Printable->($head)); + + my $len = hex($1) + or last; + + $self->read_content_body($cb, $response, $len); + + $self->read(2) eq "\x0D\x0A" + or croak(q/Malformed chunk: missing CRLF after chunk data/); + } + $self->read_header_lines($response->{headers}); + return; +} + +sub write_chunked_body { + @_ == 2 || croak(q/Usage: $handle->write_chunked_body(request)/); + my ($self, $request) = @_; + + my $len = 0; + while () { + my $data = $request->{cb}->(); + + defined $data && length $data + or last; + + if ( $] ge '5.008' ) { + utf8::downgrade($data, 1) + or croak(q/Wide character in write_chunked_body()/); + } + + $len += length $data; + + my $chunk = sprintf '%X', length $data; + $chunk .= "\x0D\x0A"; + $chunk .= $data; + $chunk .= "\x0D\x0A"; + + $self->write($chunk); + } + $self->write("0\x0D\x0A"); + $self->write_header_lines($request->{trailer_cb}->()) + if ref $request->{trailer_cb} eq 'CODE'; + return $len; +} + +sub read_response_header { + @_ == 1 || croak(q/Usage: $handle->read_response_header()/); + my ($self) = @_; + + my $line = $self->readline; + + $line =~ /\A (HTTP\/(0*\d+\.0*\d+)) [\x09\x20]+ ([0-9]{3}) [\x09\x20]+ ([^\x0D\x0A]*) \x0D?\x0A/x + or croak(q/Malformed Status-Line: / . $Printable->($line)); + + my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4); + + croak (qq/Unsupported HTTP protocol: $protocol/) + unless $version =~ /0*1\.0*[01]/; + + return { + status => $status, + reason => $reason, + headers => $self->read_header_lines, + protocol => $protocol, + }; +} + +sub write_request_header { + @_ == 4 || croak(q/Usage: $handle->write_request_header(method, request_uri, headers)/); + my ($self, $method, $request_uri, $headers) = @_; + + return $self->write("$method $request_uri HTTP/1.1\x0D\x0A") + + $self->write_header_lines($headers); +} + +sub _do_timeout { + my ($self, $type, $timeout) = @_; + $timeout = $self->{timeout} + unless defined $timeout && $timeout >= 0; + + my $fd = fileno $self->{fh}; + defined $fd && $fd >= 0 + or croak(q/select(2): 'Bad file descriptor'/); + + my $initial = time; + my $pending = $timeout; + my $nfound; + + vec(my $fdset = '', $fd, 1) = 1; + + while () { + $nfound = ($type eq 'read') + ? select($fdset, undef, undef, $pending) + : select(undef, $fdset, undef, $pending) ; + if ($nfound == -1) { + $! == EINTR + or croak(qq/select(2): '$!'/); + redo if !$timeout || ($pending = $timeout - (time - $initial)) > 0; + $nfound = 0; + } + last; + } + $! = 0; + return $nfound; +} + +sub can_read { + @_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_read([timeout])/); + my $self = shift; + return $self->_do_timeout('read', @_) +} + +sub can_write { + @_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_write([timeout])/); + my $self = shift; + return $self->_do_timeout('write', @_) +} + +1; + + + +__END__ +=pod + +=head1 NAME + +HTTP::Tiny - A small, simple, correct HTTP/1.1 client + +=head1 VERSION + +version 0.012 + +=head1 SYNOPSIS + + use HTTP::Tiny; + + my $response = HTTP::Tiny->new->get('http://example.com/'); + + die "Failed!\n" unless $response->{success}; + + print "$response->{status} $response->{reason}\n"; + + while (my ($k, $v) = each %{$response->{headers}}) { + for (ref $v eq 'ARRAY' ? @$v : $v) { + print "$k: $_\n"; + } + } + + print $response->{content} if length $response->{content}; + +=head1 DESCRIPTION + +This is a very simple HTTP/1.1 client, designed primarily for doing simple GET +requests without the overhead of a large framework like L<LWP::UserAgent>. + +It is more correct and more complete than L<HTTP::Lite>. It supports +proxies (currently only non-authenticating ones) and redirection. It +also correctly resumes after EINTR. + +=head1 METHODS + +=head2 new + + $http = HTTP::Tiny->new( %attributes ); + +This constructor returns a new HTTP::Tiny object. Valid attributes include: + +=over 4 + +=item * + +agent + +A user-agent string (defaults to 'HTTP::Tiny/$VERSION') + +=item * + +default_headers + +A hashref of default headers to apply to requests + +=item * + +max_redirect + +Maximum number of redirects allowed (defaults to 5) + +=item * + +max_size + +Maximum response size (only when not using a data callback). If defined, +responses larger than this will die with an error message + +=item * + +proxy + +URL of a proxy server to use. + +=item * + +timeout + +Request timeout in seconds (default is 60) + +=back + +=head2 get + + $response = $http->get($url); + $response = $http->get($url, \%options); + +Executes a C<GET> request for the given URL. The URL must have unsafe +characters escaped and international domain names encoded. Internally, it just +calls C<request()> with 'GET' as the method. See C<request()> for valid +options and a description of the response. + +=head2 mirror + + $response = $http->mirror($url, $file, \%options) + if ( $response->{success} ) { + print "$file is up to date\n"; + } + +Executes a C<GET> request for the URL and saves the response body to the file +name provided. The URL must have unsafe characters escaped and international +domain names encoded. If the file already exists, the request will includes an +C<If-Modified-Since> header with the modification timestamp of the file. You +may specificy a different C<If-Modified-Since> header yourself in the C<< +$options->{headers} >> hash. + +The C<success> field of the response will be true if the status code is 2XX +or 304 (unmodified). + +If the file was modified and the server response includes a properly +formatted C<Last-Modified> header, the file modification time will +be updated accordingly. + +=head2 request + + $response = $http->request($method, $url); + $response = $http->request($method, $url, \%options); + +Executes an HTTP request of the given method type ('GET', 'HEAD', 'POST', +'PUT', etc.) on the given URL. The URL must have unsafe characters escaped and +international domain names encoded. A hashref of options may be appended to +modify the request. + +Valid options are: + +=over 4 + +=item * + +headers + +A hashref containing headers to include with the request. If the value for +a header is an array reference, the header will be output multiple times with +each value in the array. These headers over-write any default headers. + +=item * + +content + +A scalar to include as the body of the request OR a code reference +that will be called iteratively to produce the body of the response + +=item * + +trailer_callback + +A code reference that will be called if it exists to provide a hashref +of trailing headers (only used with chunked transfer-encoding) + +=item * + +data_callback + +A code reference that will be called for each chunks of the response +body received. + +=back + +If the C<content> option is a code reference, it will be called iteratively +to provide the content body of the request. It should return the empty +string or undef when the iterator is exhausted. + +If the C<data_callback> option is provided, it will be called iteratively until +the entire response body is received. The first argument will be a string +containing a chunk of the response body, the second argument will be the +in-progress response hash reference, as described below. (This allows +customizing the action of the callback based on the C<status> or C<headers> +received prior to the content body.) + +The C<request> method returns a hashref containing the response. The hashref +will have the following keys: + +=over 4 + +=item * + +success + +Boolean indicating whether the operation returned a 2XX status code + +=item * + +status + +The HTTP status code of the response + +=item * + +reason + +The response phrase returned by the server + +=item * + +content + +The body of the response. If the response does not have any content +or if a data callback is provided to consume the response body, +this will be the empty string + +=item * + +headers + +A hashref of header fields. All header field names will be normalized +to be lower case. If a header is repeated, the value will be an arrayref; +it will otherwise be a scalar string containing the value + +=back + +On an exception during the execution of the request, the C<status> field will +contain 599, and the C<content> field will contain the text of the exception. + +=for Pod::Coverage agent +default_headers +max_redirect +max_size +proxy +timeout + +=head1 LIMITATIONS + +HTTP::Tiny is I<conditionally compliant> with the +L<HTTP/1.1 specification|http://www.w3.org/Protocols/rfc2616/rfc2616.html>. +It attempts to meet all "MUST" requirements of the specification, but does not +implement all "SHOULD" requirements. + +Some particular limitations of note include: + +=over + +=item * + +HTTP::Tiny focuses on correct transport. Users are responsible for ensuring +that user-defined headers and content are compliant with the HTTP/1.1 +specification. + +=item * + +Users must ensure that URLs are properly escaped for unsafe characters and that +international domain names are properly encoded to ASCII. See L<URI::Escape>, +L<URI::_punycode> and L<Net::IDN::Encode>. + +=item * + +Redirection is very strict against the specification. Redirection is only +automatic for response codes 301, 302 and 307 if the request method is 'GET' or +'HEAD'. Response code 303 is always converted into a 'GET' redirection, as +mandated by the specification. There is no automatic support for status 305 +("Use proxy") redirections. + +=item * + +Persistant connections are not supported. The C<Connection> header will +always be set to C<close>. + +=item * + +Direct C<https> connections are supported only if L<IO::Socket::SSL> is +installed. There is no support for C<https> connections via proxy. +Any SSL certificate that matches the host is accepted -- SSL certificates +are not verified against certificate authorities. + +=item * + +Cookies are not directly supported. Users that set a C<Cookie> header +should also set C<max_redirect> to zero to ensure cookies are not +inappropriately re-transmitted. + +=item * + +Proxy environment variables are not supported. + +=item * + +There is no provision for delaying a request body using an C<Expect> header. +Unexpected C<1XX> responses are silently ignored as per the specification. + +=item * + +Only 'chunked' C<Transfer-Encoding> is supported. + +=item * + +There is no support for a Request-URI of '*' for the 'OPTIONS' request. + +=back + +=head1 SEE ALSO + +=over 4 + +=item * + +L<LWP::UserAgent> + +=back + +=for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders + +=head1 SUPPORT + +=head2 Bugs / Feature Requests + +Please report any bugs or feature requests by email to C<bug-http-tiny at rt.cpan.org>, or through +the web interface at L<http://rt.cpan.org/Public/Dist/Display.html?Name=HTTP-Tiny>. You will be automatically notified of any +progress on the request by the system. + +=head2 Source Code + +This is open source software. The code repository is available for +public review and contribution under the terms of the license. + +L<http://github.com/dagolden/p5-http-tiny/tree> + + git clone git://github.com/dagolden/p5-http-tiny.git + +=head1 AUTHORS + +=over 4 + +=item * + +Christian Hansen <chansen@cpan.org> + +=item * + +David Golden <dagolden@cpan.org> + +=back + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2011 by Christian Hansen. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut + |