[Bps-public-commit] plient branch, master, updated. e9ceafee02ae17014c0a1d8410ae637fb007e404
? sunnavy
sunnavy at bestpractical.com
Sat May 28 10:38:20 EDT 2011
The branch, master has been updated
via e9ceafee02ae17014c0a1d8410ae637fb007e404 (commit)
from 107e3c2d111e0b29a856bfec461f46e7ee568ddb (commit)
Summary of changes:
lib/Plient.pm | 4 +-
lib/Plient/Handler/{HTTPLite.pm => HTTPTiny.pm} | 73 ++++++++++++++---------
t/http/get.t | 4 +-
t/http/post.t | 4 +-
4 files changed, 50 insertions(+), 35 deletions(-)
copy lib/Plient/Handler/{HTTPLite.pm => HTTPTiny.pm} (54%)
- Log -----------------------------------------------------------------
commit e9ceafee02ae17014c0a1d8410ae637fb007e404
Author: sunnavy <sunnavy at gmail.com>
Date: Sat May 28 22:37:40 2011 +0800
support HTTP::Tiny
diff --git a/lib/Plient.pm b/lib/Plient.pm
index afcfe4c..958098c 100644
--- a/lib/Plient.pm
+++ b/lib/Plient.pm
@@ -227,8 +227,8 @@ sub find_handlers {
}
my %handler_preference = (
- http => [qw/curl wget HTTPLite LWP/],
- https => [qw/curl wget LWP/],
+ http => [qw/curl wget HTTPTiny HTTPLite LWP/],
+ https => [qw/curl wget HTTPTiny LWP/],
);
if ( my $env = $ENV{PLIENT_HANDLER_PREFERENCE} ) {
my %entry = map { split /:/, $_, 2 } split /;/, $env;
diff --git a/lib/Plient/Handler/HTTPTiny.pm b/lib/Plient/Handler/HTTPTiny.pm
new file mode 100644
index 0000000..6f33010
--- /dev/null
+++ b/lib/Plient/Handler/HTTPTiny.pm
@@ -0,0 +1,144 @@
+package Plient::Handler::HTTPTiny;
+use strict;
+use warnings;
+
+require Plient::Handler unless $Plient::bundle_mode;
+our @ISA = 'Plient::Handler';
+my ( $HTTPTiny, %all_protocol, %protocol, %method );
+
+%all_protocol = ( http => undef );
+sub all_protocol { return \%all_protocol }
+sub protocol { return \%protocol }
+sub method { return \%method }
+
+sub support_method {
+ my ( $class, $method, $args ) = @_;
+ if ( $args
+ && $args->{content_type}
+ && $args->{content_type} =~ 'form-data' )
+ {
+ return;
+ }
+
+ if ( $ENV{http_proxy} && $ENV{http_proxy} =~ /@/ ) {
+
+ # HTTPTiny doesn't support proxy auth
+ return;
+ }
+
+ return $class->SUPER::support_method(@_);
+}
+
+my $inited;
+
+sub init {
+ return if $inited;
+ $inited = 1;
+ eval { require HTTP::Tiny } or return;
+ undef $protocol{http};
+ $method{http_get} = sub {
+ my ( $uri, $args ) = @_;
+ my $http = HTTP::Tiny->new;
+ add_headers( $http, $uri, $args );
+ $http->{proxy} = $ENV{http_proxy} if $ENV{http_proxy};
+ my $res = $http->get($uri);
+
+ if ( $res->{success} ) {
+ return $res->{content};
+ }
+ else {
+ warn "failed to get $uri with HTTP::Tiny: " . $res;
+ return;
+ }
+ };
+
+ $method{http_post} = sub {
+ my ( $uri, $args ) = @_;
+ my $http = HTTP::Tiny->new;
+ $http->proxy( $ENV{http_proxy} ) if $ENV{http_proxy};
+ add_headers( $http, $uri, $args );
+ add_body( $http, $args->{body_hash} ) if $args->{body_hash};
+ $http->{default_headers}{'Content-Type'} =
+ 'application/x-www-form-urlencoded'
+ unless $http->{default_headers}{'Content-Type'};
+
+ my $res = $http->request( 'POST', $uri );
+ if ( $res->{success} ) {
+ return $res->{content};
+ }
+ else {
+ warn "failed to post $uri with HTTP::Tiny: " . $res;
+ return;
+ }
+ };
+
+ return 1;
+}
+
+sub add_headers {
+ my ( $http, $uri, $args ) = @_;
+ my $headers = $args->{headers} || {};
+ for my $k ( keys %$headers ) {
+ $http->{default_headers}{$k} = $headers->{$k};
+ }
+
+ if ( $args->{user} && defined $args->{password} ) {
+ my $method = lc $args->{auth_method} || 'basic';
+ if ( $method eq 'basic' ) {
+ require MIME::Base64;
+ $http->{default_headers}{"Authorization"} = 'Basic '
+ . MIME::Base64::encode_base64( "$args->{user}:$args->{password}",
+ '' );
+ }
+ else {
+ die "aborting: unsupported auth method: $method";
+ }
+ }
+}
+
+sub add_body {
+ my $http = shift;
+ my $hash = shift;
+
+ my $body = '';
+ for my $key ( keys %$hash ) {
+
+ # TODO uri escape key and value
+ my $val = $hash->{$key};
+ $body .= $body ? "&$key=$val" : "$key=$val";
+ }
+ $http->{content} = $body;
+}
+
+__PACKAGE__->_add_to_plient if $Plient::bundle_mode;
+
+1;
+
+__END__
+
+=head1 NAME
+
+Plient::Handler::HTTPTiny -
+
+
+=head1 SYNOPSIS
+
+ use Plient::Handler::HTTPTiny;
+
+=head1 DESCRIPTION
+
+
+=head1 INTERFACE
+
+=head1 AUTHOR
+
+sunnavy C<< <sunnavy at bestpractical.com> >>
+
+
+=head1 LICENCE AND COPYRIGHT
+
+Copyright 2010 Best Practical Solutions.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
diff --git a/t/http/get.t b/t/http/get.t
index 6647b10..5dd0cb4 100644
--- a/t/http/get.t
+++ b/t/http/get.t
@@ -1,7 +1,7 @@
use strict;
use warnings;
-use Test::More tests => 8;
+use Test::More tests => 10;
use Plient;
use Plient::Test;
@@ -10,7 +10,7 @@ my $url = start_http_server();
SKIP: {
skip 'no plackup available', 4 unless $url;
# to test each handler, set env PLIENT_HANDLER_PREFERENCE_ONLY to true
- for my $handler (qw/curl wget HTTPLite LWP/) {
+ for my $handler (qw/curl wget HTTPLite HTTPTiny LWP/) {
Plient->handler_preference( http => [$handler] );
is( plient( GET => "$url/hello" ), 'hello', "get /hello using $handler" );
is(
diff --git a/t/http/post.t b/t/http/post.t
index c88311c..77458b1 100644
--- a/t/http/post.t
+++ b/t/http/post.t
@@ -1,7 +1,7 @@
use strict;
use warnings;
-use Test::More tests => 4;
+use Test::More tests => 5;
use Plient;
use Plient::Test;
@@ -10,7 +10,7 @@ my $url = start_http_server();
SKIP: {
skip 'no plackup available', 4 unless $url;
# to test each handler, set env PLIENT_HANDLER_PREFERENCE_ONLY to true
- for my $handler (qw/curl wget HTTPLite LWP/) {
+ for my $handler (qw/curl wget HTTPTiny HTTPLite LWP/) {
Plient->handler_preference( http => [$handler] );
is( plient( POST => "$url/hello", { body => { name => 'foo' } } ),
'hello foo', "post /hello using $handler" );
-----------------------------------------------------------------------
More information about the Bps-public-commit
mailing list