cpan/HTTP-Tiny/t/050_chunked_body.t
cpan/HTTP-Tiny/t/060_http_date.t
cpan/HTTP-Tiny/t/100_get.t
+cpan/HTTP-Tiny/t/101_head.t
+cpan/HTTP-Tiny/t/102_put.t
+cpan/HTTP-Tiny/t/103_delete.t
+cpan/HTTP-Tiny/t/104_post.t
cpan/HTTP-Tiny/t/110_mirror.t
-cpan/HTTP-Tiny/t/120_put.t
cpan/HTTP-Tiny/t/130_redirect.t
cpan/HTTP-Tiny/t/140_proxy.t
+cpan/HTTP-Tiny/t/150_post_form.t
+cpan/HTTP-Tiny/t/cases/delete-01.txt
+cpan/HTTP-Tiny/t/cases/form-01.txt
+cpan/HTTP-Tiny/t/cases/form-02.txt
+cpan/HTTP-Tiny/t/cases/form-03.txt
+cpan/HTTP-Tiny/t/cases/form-04.txt
cpan/HTTP-Tiny/t/cases/get-01.txt
cpan/HTTP-Tiny/t/cases/get-02.txt
cpan/HTTP-Tiny/t/cases/get-03.txt
cpan/HTTP-Tiny/t/cases/get-19.txt
cpan/HTTP-Tiny/t/cases/get-20.txt
cpan/HTTP-Tiny/t/cases/get-21.txt
+cpan/HTTP-Tiny/t/cases/head-01.txt
cpan/HTTP-Tiny/t/cases/mirror-01.txt
cpan/HTTP-Tiny/t/cases/mirror-02.txt
cpan/HTTP-Tiny/t/cases/mirror-03.txt
cpan/HTTP-Tiny/t/cases/mirror-04.txt
cpan/HTTP-Tiny/t/cases/mirror-05.txt
+cpan/HTTP-Tiny/t/cases/post-01.txt
cpan/HTTP-Tiny/t/cases/put-01.txt
cpan/HTTP-Tiny/t/cases/put-02.txt
cpan/HTTP-Tiny/t/cases/put-03.txt
'HTTP::Tiny' =>
{
'MAINTAINER' => 'dagolden',
- 'DISTRIBUTION' => 'DAGOLDEN/HTTP-Tiny-0.013.tar.gz',
+ 'DISTRIBUTION' => 'DAGOLDEN/HTTP-Tiny-0.014.tar.gz',
'FILES' => q[cpan/HTTP-Tiny],
'EXCLUDED' => [
't/200_live.t',
package HTTP::Tiny;
use strict;
use warnings;
-our $VERSION = '0.013'; # VERSION
+# ABSTRACT: A small, simple, correct HTTP/1.1 client
+our $VERSION = '0.014'; # VERSION
use Carp ();
}
-sub get {
- my ($self, $url, $args) = @_;
- @_ == 2 || (@_ == 3 && ref $args eq 'HASH')
- or Carp::croak(q/Usage: $http->get(URL, [HASHREF])/ . "\n");
- return $self->request('GET', $url, $args || {});
+for my $sub_name ( qw/get head put post delete/ ) {
+ my $req_method = uc $sub_name;
+ no strict 'refs';
+ eval <<"HERE";
+ sub $sub_name {
+ my (\$self, \$url, \$args) = \@_;
+ \@_ == 2 || (\@_ == 3 && ref \$args eq 'HASH')
+ or Carp::croak(q/Usage: \$http->$sub_name(URL, [HASHREF])/ . "\n");
+ return \$self->request('$req_method', \$url, \$args || {});
+ }
+HERE
+}
+
+
+sub post_form {
+ my ($self, $url, $data, $args) = @_;
+ (@_ == 3 || @_ == 4 && ref $args eq 'HASH')
+ or Carp::croak(q/Usage: $http->post_form(URL, DATAREF, [HASHREF])/ . "\n");
+
+ my $headers = {};
+ while ( my ($key, $value) = each %{$args->{headers} || {}} ) {
+ $headers->{lc $key} = $value;
+ }
+ delete $args->{headers};
+
+ return $self->request('POST', $url, {
+ %$args,
+ content => $self->www_form_urlencode($data),
+ headers => {
+ %$headers,
+ 'content-type' => 'application/x-www-form-urlencoded'
+ },
+ }
+ );
}
return $response;
}
+
+sub www_form_urlencode {
+ my ($self, $data) = @_;
+ (@_ == 2 && ref $data)
+ or Carp::croak(q/Usage: $http->www_form_urlencode(DATAREF)/ . "\n");
+ (ref $data eq 'HASH' || ref $data eq 'ARRAY')
+ or Carp::croak("form data must be a hash or array reference");
+
+ my @params = ref $data eq 'HASH' ? %$data : @$data;
+ @params % 2 == 0
+ or Carp::croak("form data reference must have an even number of terms\n");
+
+ my @terms;
+ while( @params ) {
+ my ($key, $value) = splice(@params, 0, 2);
+ if ( ref $value eq 'ARRAY' ) {
+ unshift @params, map { $key => $_ } @$value;
+ }
+ else {
+ push @terms, join("=", map { $self->_uri_escape($_) } $key, $value);
+ }
+ }
+
+ return join("&", sort @terms);
+}
+
+#--------------------------------------------------------------------------#
+# private methods
+#--------------------------------------------------------------------------#
+
my %DefaultPort = (
http => 80,
https => 443,
};
}
+# URI escaping adapted from URI::Escape
+# c.f. http://www.w3.org/TR/html4/interact/forms.html#h-17.13.4.1
+my %escapes = map { chr($_) => sprintf("%%%02X", $_) } 0..255;
+$escapes{' '}="+";
+my $unsafe_char = qr/[^A-Za-z0-9\-\._~]/;
+
+sub _uri_escape {
+ my ($self, $str) = @_;
+ utf8::encode($str);
+ $str =~ s/($unsafe_char)/$escapes{$1}/ge;
+ return $str;
+}
+
package
HTTP::Tiny::Handle; # hide from PAUSE/indexers
use strict;
1;
-# ABSTRACT: A small, simple, correct HTTP/1.1 client
-
__END__
=head1 VERSION
-version 0.013
+version 0.014
=head1 SYNOPSIS
=head1 DESCRIPTION
-This is a very simple HTTP/1.1 client, designed primarily for doing simple GET
+This is a very simple HTTP/1.1 client, designed 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
=back
-=head2 get
+=head2 get|head|put|post|delete
$response = $http->get($url);
$response = $http->get($url, \%options);
+ $response = $http->head($url);
+
+These methods are shorthand for calling C<request()> for the given method. The
+URL must have unsafe characters escaped and international domain names encoded.
+See C<request()> for valid options and a description of the response.
+
+=head2 post_form
+
+ $response = $http->post_form($url, $form_data);
+ $response = $http->post_form($url, $form_data, \%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.
+This method executes a C<POST> request and sends the key/value pairs from a
+form data hash or array reference to the given URL with a C<content-type> of
+C<application/x-www-form-urlencoded>. See documentation for the
+C<www_form_urlencode> method for details on the encoding.
+
+The URL must have unsafe characters escaped and international domain names
+encoded. See C<request()> for valid options and a description of the response.
+Any C<content-type> header or content in the options hashref will be ignored.
=head2 mirror
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.
+=head2 www_form_urlencode
+
+ $params = $http->www_form_urlencode( $data );
+ $response = $http->get("http://example.com/query?$params");
+
+This method converts the key/value pairs from a data hash or array reference
+into a C<x-www-form-urlencoded> string. The keys and values from the data
+reference will be UTF-8 encoded and escaped per RFC 3986. If a value is an
+array reference, the key will be repeated with each of the values of the array
+reference. The key/value pairs in the resulting string will be sorted by key
+and value.
+
=for Pod::Coverage agent
default_headers
max_redirect
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>
+L<https://github.com/dagolden/p5-http-tiny>
- git clone http://github.com/dagolden/p5-http-tiny
+ git clone https://github.com/dagolden/p5-http-tiny.git
=head1 AUTHORS
use HTTP::Tiny;
my @accessors = qw(agent default_headers max_redirect max_size proxy timeout);
-my @methods = qw(new get request mirror);
+my @methods = qw(
+ new get head put post delete post_form request mirror www_form_urlencode
+);
my %api;
@api{@accessors} = (1) x @accessors;
-@api{@methods} = (1) x @accessors;
+@api{@methods} = (1) x @methods;
can_ok('HTTP::Tiny', @methods, @accessors);
--- /dev/null
+#!perl
+
+use strict;
+use warnings;
+
+use File::Basename;
+use Test::More 0.88;
+use t::Util qw[tmpfile rewind slurp monkey_patch dir_list parse_case
+ set_socket_source sort_headers $CRLF $LF];
+use HTTP::Tiny;
+BEGIN { monkey_patch() }
+
+for my $file ( dir_list("t/cases", qr/^head/ ) ) {
+ my $data = do { local (@ARGV,$/) = $file; <> };
+ my ($params, $expect_req, $give_res) = split /--+\n/, $data;
+ # cleanup source data
+ my $version = HTTP::Tiny->VERSION || 0;
+ $expect_req =~ s{VERSION}{$version};
+ s{\n}{$CRLF}g for ($expect_req, $give_res);
+
+ # figure out what request to make
+ my $case = parse_case($params);
+ my $url = $case->{url}[0];
+ my %options;
+
+ my %headers;
+ for my $line ( @{ $case->{headers} } ) {
+ my ($k,$v) = ($line =~ m{^([^:]+): (.*)$}g);
+ $headers{$k} = $v;
+ }
+ $options{headers} = \%headers if %headers;
+
+ if ( $case->{content} ) {
+ $options{content} = $case->{content}[0];
+ }
+ elsif ( $case->{content_cb} ) {
+ $options{content} = eval join "\n", @{$case->{content_cb}};
+ }
+
+ if ( $case->{trailer_cb} ) {
+ $options{trailer_callback} = eval join "\n", @{$case->{trailer_cb}};
+ }
+
+ # setup mocking and test
+ my $res_fh = tmpfile($give_res);
+ my $req_fh = tmpfile();
+
+ my $http = HTTP::Tiny->new;
+ set_socket_source($req_fh, $res_fh);
+
+ (my $url_basename = $url) =~ s{.*/}{};
+
+ my @call_args = %options ? ($url, \%options) : ($url);
+ my $response = $http->head(@call_args);
+
+ my $got_req = slurp($req_fh);
+
+ my $label = basename($file);
+
+ is( sort_headers($got_req), sort_headers($expect_req), "$label request" );
+
+ my ($rc) = $give_res =~ m{\S+\s+(\d+)}g;
+ is( $response->{status}, $rc, "$label response code $rc" )
+ or diag $response->{content};
+
+ if ( substr($rc,0,1) eq '2' ) {
+ ok( $response->{success}, "$label success flag true" );
+ }
+ else {
+ ok( ! $response->{success}, "$label success flag false" );
+ }
+}
+
+done_testing;
(my $url_basename = $url) =~ s{.*/}{};
my @call_args = %options ? ($url, \%options) : ($url);
- my $response = $http->request('PUT',@call_args);
+ my $response = $http->put(@call_args);
my $got_req = slurp($req_fh);
--- /dev/null
+#!perl
+
+use strict;
+use warnings;
+
+use File::Basename;
+use Test::More 0.88;
+use t::Util qw[tmpfile rewind slurp monkey_patch dir_list parse_case
+ set_socket_source sort_headers $CRLF $LF];
+use HTTP::Tiny;
+BEGIN { monkey_patch() }
+
+for my $file ( dir_list("t/cases", qr/^delete/ ) ) {
+ my $data = do { local (@ARGV,$/) = $file; <> };
+ my ($params, $expect_req, $give_res) = split /--+\n/, $data;
+ # cleanup source data
+ my $version = HTTP::Tiny->VERSION || 0;
+ $expect_req =~ s{VERSION}{$version};
+ s{\n}{$CRLF}g for ($expect_req, $give_res);
+
+ # figure out what request to make
+ my $case = parse_case($params);
+ my $url = $case->{url}[0];
+ my %options;
+
+ my %headers;
+ for my $line ( @{ $case->{headers} } ) {
+ my ($k,$v) = ($line =~ m{^([^:]+): (.*)$}g);
+ $headers{$k} = $v;
+ }
+ $options{headers} = \%headers if %headers;
+
+ if ( $case->{content} ) {
+ $options{content} = $case->{content}[0];
+ }
+ elsif ( $case->{content_cb} ) {
+ $options{content} = eval join "\n", @{$case->{content_cb}};
+ }
+
+ if ( $case->{trailer_cb} ) {
+ $options{trailer_callback} = eval join "\n", @{$case->{trailer_cb}};
+ }
+
+ # setup mocking and test
+ my $res_fh = tmpfile($give_res);
+ my $req_fh = tmpfile();
+
+ my $http = HTTP::Tiny->new;
+ set_socket_source($req_fh, $res_fh);
+
+ (my $url_basename = $url) =~ s{.*/}{};
+
+ my @call_args = %options ? ($url, \%options) : ($url);
+ my $response = $http->delete(@call_args);
+
+ my $got_req = slurp($req_fh);
+
+ my $label = basename($file);
+
+ is( sort_headers($got_req), sort_headers($expect_req), "$label request" );
+
+ my ($rc) = $give_res =~ m{\S+\s+(\d+)}g;
+ is( $response->{status}, $rc, "$label response code $rc" )
+ or diag $response->{content};
+
+ if ( substr($rc,0,1) eq '2' ) {
+ ok( $response->{success}, "$label success flag true" );
+ }
+ else {
+ ok( ! $response->{success}, "$label success flag false" );
+ }
+}
+
+done_testing;
--- /dev/null
+#!perl
+
+use strict;
+use warnings;
+
+use File::Basename;
+use Test::More 0.88;
+use t::Util qw[tmpfile rewind slurp monkey_patch dir_list parse_case
+ set_socket_source sort_headers $CRLF $LF];
+use HTTP::Tiny;
+BEGIN { monkey_patch() }
+
+for my $file ( dir_list("t/cases", qr/^post/ ) ) {
+ my $data = do { local (@ARGV,$/) = $file; <> };
+ my ($params, $expect_req, $give_res) = split /--+\n/, $data;
+ # cleanup source data
+ my $version = HTTP::Tiny->VERSION || 0;
+ $expect_req =~ s{VERSION}{$version};
+ s{\n}{$CRLF}g for ($expect_req, $give_res);
+
+ # figure out what request to make
+ my $case = parse_case($params);
+ my $url = $case->{url}[0];
+ my %options;
+
+ my %headers;
+ for my $line ( @{ $case->{headers} } ) {
+ my ($k,$v) = ($line =~ m{^([^:]+): (.*)$}g);
+ $headers{$k} = $v;
+ }
+ $options{headers} = \%headers if %headers;
+
+ if ( $case->{content} ) {
+ $options{content} = $case->{content}[0];
+ }
+ elsif ( $case->{content_cb} ) {
+ $options{content} = eval join "\n", @{$case->{content_cb}};
+ }
+
+ if ( $case->{trailer_cb} ) {
+ $options{trailer_callback} = eval join "\n", @{$case->{trailer_cb}};
+ }
+
+ # setup mocking and test
+ my $res_fh = tmpfile($give_res);
+ my $req_fh = tmpfile();
+
+ my $http = HTTP::Tiny->new;
+ set_socket_source($req_fh, $res_fh);
+
+ (my $url_basename = $url) =~ s{.*/}{};
+
+ my @call_args = %options ? ($url, \%options) : ($url);
+ my $response = $http->post(@call_args);
+
+ my $got_req = slurp($req_fh);
+
+ my $label = basename($file);
+
+ is( sort_headers($got_req), sort_headers($expect_req), "$label request" );
+
+ my ($rc) = $give_res =~ m{\S+\s+(\d+)}g;
+ is( $response->{status}, $rc, "$label response code $rc" )
+ or diag $response->{content};
+
+ if ( substr($rc,0,1) eq '2' ) {
+ ok( $response->{success}, "$label success flag true" );
+ }
+ else {
+ ok( ! $response->{success}, "$label success flag false" );
+ }
+}
+
+done_testing;
--- /dev/null
+#!perl
+
+use strict;
+use warnings;
+
+use File::Basename;
+use Test::More 0.88;
+use t::Util qw[tmpfile rewind slurp monkey_patch dir_list parse_case
+ set_socket_source sort_headers $CRLF $LF];
+use HTTP::Tiny;
+BEGIN { monkey_patch() }
+
+for my $file ( dir_list("t/cases", qr/^form/ ) ) {
+ my $data = do { local (@ARGV,$/) = $file; <> };
+ my ($params, $expect_req, $give_res) = split /--+\n/, $data;
+ # cleanup source data
+ my $version = HTTP::Tiny->VERSION || 0;
+ $expect_req =~ s{VERSION}{$version};
+ s{\n}{$CRLF}g for ($expect_req, $give_res);
+
+ # figure out what request to make
+ my $case = parse_case($params);
+ my $url = $case->{url}[0];
+ my %options;
+
+ my %headers;
+ for my $line ( @{ $case->{headers} } ) {
+ my ($k,$v) = ($line =~ m{^([^:]+): (.*)$}g);
+ $headers{$k} = $v;
+ }
+ $options{headers} = \%headers if %headers;
+
+ my @params = split "\\|", $case->{content}[0];
+ my $formdata;
+ if ( $case->{datatype} eq 'HASH' ) {
+ while ( @params ) {
+ my ($key, $value) = splice( @params, 0, 2 );
+ if ( ref $formdata->{$key} ) {
+ push @{$formdata->{$key}}, $value;
+ }
+ elsif ( exists $formdata->{$key} ) {
+ $formdata->{$key} = [ $formdata->{$key}, $value ];
+ }
+ else {
+ $formdata->{$key} = $value;
+ }
+ }
+ }
+ else {
+ $formdata = [ @params ];
+ }
+
+ # setup mocking and test
+ my $res_fh = tmpfile($give_res);
+ my $req_fh = tmpfile();
+
+ my $http = HTTP::Tiny->new;
+ set_socket_source($req_fh, $res_fh);
+
+ (my $url_basename = $url) =~ s{.*/}{};
+
+ my $response = $http->post_form( $url, $formdata, %options ? (\%options) : ());
+
+ my $got_req = slurp($req_fh);
+
+ my $label = basename($file);
+
+ is( sort_headers($got_req), sort_headers($expect_req), "$label request" );
+
+ my ($rc) = $give_res =~ m{\S+\s+(\d+)}g;
+ is( $response->{status}, $rc, "$label response code $rc" )
+ or diag $response->{content};
+
+ if ( substr($rc,0,1) eq '2' ) {
+ ok( $response->{success}, "$label success flag true" );
+ }
+ else {
+ ok( ! $response->{success}, "$label success flag false" );
+ }
+}
+
+done_testing;
--- /dev/null
+url
+ http://example.com/index.html
+expected
+ abcdefghijklmnopqrstuvwxyz1234567890abcdef
+----------
+DELETE /index.html HTTP/1.1
+Host: example.com
+Connection: close
+User-Agent: HTTP-Tiny/VERSION
+
+----------
+HTTP/1.1 200 OK
+Date: Thu, 03 Feb 1994 00:00:00 GMT
+Content-Length: 0
+
--- /dev/null
+url
+ http://example.com/new
+headers
+ Content-Type: text/plain
+content
+ key|value|name|John Doe|noise|!@#$%^&*()
+datatype
+ ARRAY
+----------
+POST /new HTTP/1.1
+Host: example.com
+Connection: close
+User-Agent: HTTP-Tiny/VERSION
+Content-Type: application/x-www-form-urlencoded
+Content-Length: 60
+
+key=value&name=John+Doe&noise=%21%40%23%24%25%5E%26%2A%28%29
+----------
+HTTP/1.1 201 Created
+Date: Thu, 03 Feb 1994 00:00:00 GMT
+Location: http://example.com/new/01.txt
+Content-Length: 0
+
--- /dev/null
+url
+ http://example.com/new
+content
+ key|value|name|John Doe|noise|!@#$%^&*()
+datatype
+ HASH
+----------
+POST /new HTTP/1.1
+Host: example.com
+Connection: close
+User-Agent: HTTP-Tiny/VERSION
+Content-Type: application/x-www-form-urlencoded
+Content-Length: 60
+
+key=value&name=John+Doe&noise=%21%40%23%24%25%5E%26%2A%28%29
+----------
+HTTP/1.1 201 Created
+Date: Thu, 03 Feb 1994 00:00:00 GMT
+Location: http://example.com/new/01.txt
+Content-Length: 0
+
--- /dev/null
+url
+ http://example.com/new
+content
+ bar|baz|ack|foo
+datatype
+ ARRAY
+----------
+POST /new HTTP/1.1
+Host: example.com
+Connection: close
+User-Agent: HTTP-Tiny/VERSION
+Content-Type: application/x-www-form-urlencoded
+Content-Length: 15
+
+ack=foo&bar=baz
+----------
+HTTP/1.1 201 Created
+Date: Thu, 03 Feb 1994 00:00:00 GMT
+Location: http://example.com/new/01.txt
+Content-Length: 0
+
--- /dev/null
+url
+ http://example.com/new
+content
+ utf8|☺
+datatype
+ ARRAY
+----------
+POST /new HTTP/1.1
+Host: example.com
+Connection: close
+User-Agent: HTTP-Tiny/VERSION
+Content-Type: application/x-www-form-urlencoded
+Content-Length: 23
+
+utf8=%C3%A2%C2%98%C2%BA
+----------
+HTTP/1.1 201 Created
+Date: Thu, 03 Feb 1994 00:00:00 GMT
+Location: http://example.com/new/01.txt
+Content-Length: 0
+
--- /dev/null
+url
+ http://example.com/index.html
+expected
+ abcdefghijklmnopqrstuvwxyz1234567890abcdef
+----------
+HEAD /index.html HTTP/1.1
+Host: example.com
+Connection: close
+User-Agent: HTTP-Tiny/VERSION
+
+----------
+HTTP/1.1 200 OK
+Date: Thu, 03 Feb 1994 00:00:00 GMT
+Content-Type: text/plain
+Content-Length: 44
+
--- /dev/null
+url
+ http://example.com/index.html
+headers
+ Content-Type: text/plain
+ Content-Length: 42
+content
+ abcdefghijklmnopqrstuvwxyz1234567890abcdef
+----------
+POST /index.html HTTP/1.1
+Host: example.com
+Connection: close
+User-Agent: HTTP-Tiny/VERSION
+Content-Type: text/plain
+Content-Length: 42
+
+abcdefghijklmnopqrstuvwxyz1234567890abcdef
+
+----------
+HTTP/1.1 200 OK
+Date: Thu, 03 Feb 1994 00:00:00 GMT
+Content-Type: text/plain
+Content-Length: 42
+
+abcdefghijklmnopqrstuvwxyz1234567890abcdef
=item *
-L<XXX> has been upgraded from version 0.69 to version 0.70.
+L<HTTP::Tiny> has been upgraded from version 0.013 to version 0.014.
+
+Adds additional shorthand methods for all common HTTP verbs,
+a C<post_form()> method for POST-ing x-www-form-urlencoded data and
+a C<www_form_urlencode()> utility method.
=back
projects / platform / upstream / perl.git / commitdiff