[Bps-public-commit] plient branch, master, updated. f8cbaf58606ca52f443da53214ef2c8161dd1398
? sunnavy
sunnavy at bestpractical.com
Tue Apr 20 18:22:57 EDT 2010
The branch, master has been updated
via f8cbaf58606ca52f443da53214ef2c8161dd1398 (commit)
via 396ee0575611d047bd0454831f6512c528e5e2dc (commit)
via 9e7c5c93b739f9a12f3e51b0bd163889d1719dbd (commit)
via ede3f27ed49bfd945208896fa9a51b410d67512f (commit)
via 91a1712b30aadb46563ae4d6aa9c492655ed95a4 (commit)
via af558c06550d3da8ad72c2f53a7b3ca78d311bd4 (commit)
via d713b21d6d0d18081f8160b432d69d3de6dae09d (commit)
from a8a465b0733f23d1c57542b6afb1d928878f7b3d (commit)
Summary of changes:
lib/Plient/Handler/LWP.pm | 21 +++++++++++++++++++++
lib/Plient/Handler/curl.pm | 13 +++++++++++++
lib/Plient/Handler/wget.pm | 30 ++++++++++++++++++++++++++++++
t/http/app.psgi | 15 ++++++++++++++-
t/http/{get.t => head.t} | 8 ++++----
5 files changed, 82 insertions(+), 5 deletions(-)
copy t/http/{get.t => head.t} (52%)
- Log -----------------------------------------------------------------
commit d713b21d6d0d18081f8160b432d69d3de6dae09d
Author: sunnavy <sunnavy at bestpractical.com>
Date: Wed Apr 21 02:20:24 2010 +0800
forgot to add https_post for lwp
diff --git a/lib/Plient/Handler/LWP.pm b/lib/Plient/Handler/LWP.pm
index cd7786f..b0c7ad1 100644
--- a/lib/Plient/Handler/LWP.pm
+++ b/lib/Plient/Handler/LWP.pm
@@ -58,6 +58,7 @@ sub init {
if ( exists $protocol{https} ) {
# have you seen https is available while http is not?
$method{https_get} = $method{http_get};
+ $method{https_post} = $method{http_post};
}
return 1;
}
commit af558c06550d3da8ad72c2f53a7b3ca78d311bd4
Author: sunnavy <sunnavy at bestpractical.com>
Date: Wed Apr 21 02:46:51 2010 +0800
http head tests
diff --git a/t/http/app.psgi b/t/http/app.psgi
index f096db9..504b0be 100644
--- a/t/http/app.psgi
+++ b/t/http/app.psgi
@@ -11,12 +11,25 @@ my $app = sub {
return [ 200, [ 'Content-Type' => 'text/plain' ], ['hello'] ]
}
}
- if ( $req->method eq 'POST' ) {
+ elsif ( $req->method eq 'POST' ) {
my $name = $req->body_parameters->get_all('name');
if ( $req->path eq '/hello' ) {
return [ 200, [ 'Content-Type' => 'text/plain' ], ["hello $name"] ];
}
}
+ elsif ( $req->method eq 'HEAD' ) {
+ if ( $req->path eq '/hello' ) {
+ return [
+ 200,
+ [
+ 'Content-Type' => 'text/plain',
+ 'Plient-Head-Path' => '/hello'
+ ],
+ []
+ ];
+ }
+ }
+
[ 200, [], ['ok']];
};
diff --git a/t/http/head.t b/t/http/head.t
new file mode 100644
index 0000000..b05c8cd
--- /dev/null
+++ b/t/http/head.t
@@ -0,0 +1,17 @@
+use strict;
+use warnings;
+
+use Test::More tests => 4;
+
+use_ok('Plient');
+use_ok('Plient::Test');
+
+my $url = start_http_server();
+SKIP: {
+ skip 'no plackup available', 2 unless $url;
+ # to test each handler, set env PLIENT_HANDLER_PREFERENCE_ONLY to true
+ for my $handler (qw/curl LWP/) {
+ Plient->handler_preference( http => [$handler] );
+ like( plient( HEAD => "$url/hello" ), qr/Plient-Head-Path: \/hello/, "get head /hello using $handler" );
+ }
+}
commit 91a1712b30aadb46563ae4d6aa9c492655ed95a4
Author: sunnavy <sunnavy at bestpractical.com>
Date: Wed Apr 21 02:48:59 2010 +0800
http_head for our handlers: orz, only curl supports the HTTP HEAD at the api level
diff --git a/lib/Plient/Handler/LWP.pm b/lib/Plient/Handler/LWP.pm
index b0c7ad1..edc5bd8 100644
--- a/lib/Plient/Handler/LWP.pm
+++ b/lib/Plient/Handler/LWP.pm
@@ -55,6 +55,22 @@ sub init {
}
};
+ $method{http_head} = sub {
+ my ( $uri, $args ) = @_;
+
+ # XXX TODO tweak the new arguments
+ my $ua = LWP::UserAgent->new;
+ my $res = $ua->head($uri);
+ # there is no official way to get the *origin* header output :/
+ if ( $res->is_success ) {
+ return $res->headers->as_string;
+ }
+ else {
+ warn "failed to get head of $uri with lwp: " . $res->status_line;
+ return;
+ }
+ };
+
if ( exists $protocol{https} ) {
# have you seen https is available while http is not?
$method{https_get} = $method{http_get};
diff --git a/lib/Plient/Handler/curl.pm b/lib/Plient/Handler/curl.pm
index 6e46ec0..cc2c575 100644
--- a/lib/Plient/Handler/curl.pm
+++ b/lib/Plient/Handler/curl.pm
@@ -74,6 +74,17 @@ sub init {
return;
}
};
+ $method{http_head} = sub {
+ my ( $uri, $args ) = @_;
+ if ( open my $fh, "$curl -s -I -L $uri |" ) {
+ local $/;
+ <$fh>;
+ }
+ else {
+ warn "failed to get head of $uri with curl: $!";
+ return;
+ }
+ };
}
if ( exists $protocol{https} ) {
diff --git a/lib/Plient/Handler/wget.pm b/lib/Plient/Handler/wget.pm
index d5afe97..ccad0ad 100644
--- a/lib/Plient/Handler/wget.pm
+++ b/lib/Plient/Handler/wget.pm
@@ -78,6 +78,10 @@ sub init {
}
};
+ # actually, wget doesn't have an official head api, --spider
+ # does the similar job, but this behavior varies in different versions.
+ # let's not support head for wget for now
+
if ( exists $protocol{https} ) {
for my $m (qw/get post head put/) {
$method{"https_$m"} = $method{"http_$m"}
commit ede3f27ed49bfd945208896fa9a51b410d67512f
Author: sunnavy <sunnavy at bestpractical.com>
Date: Wed Apr 21 06:17:39 2010 +0800
remove the trailing empty line in curl's head output
diff --git a/lib/Plient/Handler/curl.pm b/lib/Plient/Handler/curl.pm
index cc2c575..858d603 100644
--- a/lib/Plient/Handler/curl.pm
+++ b/lib/Plient/Handler/curl.pm
@@ -78,7 +78,9 @@ sub init {
my ( $uri, $args ) = @_;
if ( open my $fh, "$curl -s -I -L $uri |" ) {
local $/;
- <$fh>;
+ my $head = <$fh>;
+ $head =~ s/\r\n$//;
+ return $head;
}
else {
warn "failed to get head of $uri with curl: $!";
commit 9e7c5c93b739f9a12f3e51b0bd163889d1719dbd
Author: sunnavy <sunnavy at bestpractical.com>
Date: Wed Apr 21 06:20:49 2010 +0800
need a better way to get http head for lwp
diff --git a/lib/Plient/Handler/LWP.pm b/lib/Plient/Handler/LWP.pm
index edc5bd8..d0bf7d0 100644
--- a/lib/Plient/Handler/LWP.pm
+++ b/lib/Plient/Handler/LWP.pm
@@ -55,21 +55,25 @@ sub init {
}
};
- $method{http_head} = sub {
- my ( $uri, $args ) = @_;
-
- # XXX TODO tweak the new arguments
- my $ua = LWP::UserAgent->new;
- my $res = $ua->head($uri);
- # there is no official way to get the *origin* header output :/
- if ( $res->is_success ) {
- return $res->headers->as_string;
- }
- else {
- warn "failed to get head of $uri with lwp: " . $res->status_line;
- return;
- }
- };
+# XXX there is no official way to get the *origin* header output :/
+# $res->headers->as_string isn't exactly the same head output
+# e.g. it adds Client-... headers, and lacking the first line:
+# HTTP/1.0 200 OK
+#
+#
+# $method{http_head} = sub {
+# my ( $uri, $args ) = @_;
+#
+# my $ua = LWP::UserAgent->new;
+# my $res = $ua->head($uri);
+# if ( $res->is_success ) {
+# return $res->headers->as_string;
+# }
+# else {
+# warn "failed to get head of $uri with lwp: " . $res->status_line;
+# return;
+# }
+# };
if ( exists $protocol{https} ) {
# have you seen https is available while http is not?
commit 396ee0575611d047bd0454831f6512c528e5e2dc
Author: sunnavy <sunnavy at bestpractical.com>
Date: Wed Apr 21 06:22:01 2010 +0800
hack the wget's http_head
diff --git a/lib/Plient/Handler/wget.pm b/lib/Plient/Handler/wget.pm
index ccad0ad..f05632a 100644
--- a/lib/Plient/Handler/wget.pm
+++ b/lib/Plient/Handler/wget.pm
@@ -78,9 +78,35 @@ sub init {
}
};
- # actually, wget doesn't have an official head api, --spider
- # does the similar job, but this behavior varies in different versions.
- # let's not support head for wget for now
+ $method{http_head} = sub {
+ my ( $uri, $args ) = @_;
+ # we can't use -q here, or some version may not show the header
+ if ( open my $fh, "$wget -S --spider $uri 2>&1 |" ) {
+ my $head = '';
+ my $flag;
+ while ( my $line = <$fh>) {
+ # yeah, the head output has 2 spaces as indents
+ if ( $line =~ m{^\s{2}HTTP} ) {
+ $flag = 1;
+ }
+
+ if ($flag) {
+ if ($line =~ s/^\s{2}(?=\S)//) {
+ $head .= $line;
+ }
+ else {
+ undef $flag;
+ last;
+ }
+ }
+ }
+ return $head;
+ }
+ else {
+ warn "failed to get head of $uri with wget: $!";
+ return;
+ }
+ };
if ( exists $protocol{https} ) {
for my $m (qw/get post head put/) {
commit f8cbaf58606ca52f443da53214ef2c8161dd1398
Author: sunnavy <sunnavy at bestpractical.com>
Date: Wed Apr 21 06:22:46 2010 +0800
update head tests
diff --git a/t/http/head.t b/t/http/head.t
index b05c8cd..71cd466 100644
--- a/t/http/head.t
+++ b/t/http/head.t
@@ -10,7 +10,7 @@ my $url = start_http_server();
SKIP: {
skip 'no plackup available', 2 unless $url;
# to test each handler, set env PLIENT_HANDLER_PREFERENCE_ONLY to true
- for my $handler (qw/curl LWP/) {
+ for my $handler (qw/curl wget/) {
Plient->handler_preference( http => [$handler] );
like( plient( HEAD => "$url/hello" ), qr/Plient-Head-Path: \/hello/, "get head /hello using $handler" );
}
-----------------------------------------------------------------------
More information about the Bps-public-commit
mailing list