diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/HTTP/Tiny.pm')
-rw-r--r-- | Master/tlpkg/tlperl/lib/HTTP/Tiny.pm | 1098 |
1 files changed, 1098 insertions, 0 deletions
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 + |