summary refs log tree commit diff
diff options
context:
space:
mode:
authorfranck cuny <franck@lumberjaph.net>2010-11-01 09:36:31 +0100
committerfranck cuny <franck@lumberjaph.net>2010-11-01 09:36:31 +0100
commit730f149906a80efcf2a662450ee522af740a0cc9 (patch)
tree4d776f9b7da3301310a4302dfbebf28c5fc38673
parentfix method name (diff)
parentadd headers (diff)
downloadnet-http-spore-730f149906a80efcf2a662450ee522af740a0cc9.tar.gz
merge
-rw-r--r--lib/Net/HTTP/Spore/Meta/Method.pm5
-rw-r--r--lib/Net/HTTP/Spore/Middleware/FileUpload.pm12
-rw-r--r--lib/Net/HTTP/Spore/Middleware/ParanoidAgent.pm13
-rw-r--r--lib/Net/HTTP/Spore/Middleware/Redirection.pm44
-rw-r--r--lib/Net/HTTP/Spore/Role/Request.pm38
-rw-r--r--lib/Net/HTTP/Spore/Role/UserAgent.pm1
-rw-r--r--t/spore-middleware/redirection.t27
7 files changed, 128 insertions, 12 deletions
diff --git a/lib/Net/HTTP/Spore/Meta/Method.pm b/lib/Net/HTTP/Spore/Meta/Method.pm
index 8a1e0a4..10132ed 100644
--- a/lib/Net/HTTP/Spore/Meta/Method.pm
+++ b/lib/Net/HTTP/Spore/Meta/Method.pm
@@ -76,6 +76,11 @@ has formats => (
     isa       => ArrayRef [Str],
     predicate => 'has_formats',
 );
+has headers => (
+    is        => 'ro',
+    isa       => HashRef [Str],
+    predicate => 'has_headers',
+);
 has expected_status => (
     traits     => ['Array'],
     is         => 'ro',
diff --git a/lib/Net/HTTP/Spore/Middleware/FileUpload.pm b/lib/Net/HTTP/Spore/Middleware/FileUpload.pm
new file mode 100644
index 0000000..6677e54
--- /dev/null
+++ b/lib/Net/HTTP/Spore/Middleware/FileUpload.pm
@@ -0,0 +1,12 @@
+package Net::HTTP::Spore::Middleware::FileUpload;
+
+use Moose;
+extends 'Net::HTTP::Spore::Middleware';
+
+use LWP::MediaTypes qw/read_media_types/;
+
+sub call {
+    my ($self, $request) = @_;
+}
+
+1;
diff --git a/lib/Net/HTTP/Spore/Middleware/ParanoidAgent.pm b/lib/Net/HTTP/Spore/Middleware/ParanoidAgent.pm
new file mode 100644
index 0000000..c1cce0c
--- /dev/null
+++ b/lib/Net/HTTP/Spore/Middleware/ParanoidAgent.pm
@@ -0,0 +1,13 @@
+package Net::HTTP::Spore::Middleware::ParanoidAgent;
+
+use Moose;
+extends 'Net::HTTP::Spore::Middleware';
+
+has black_list => ();
+has white_list => ();
+
+sub call {
+    my ($self, $request) = @_;
+}
+
+1;
diff --git a/lib/Net/HTTP/Spore/Middleware/Redirection.pm b/lib/Net/HTTP/Spore/Middleware/Redirection.pm
new file mode 100644
index 0000000..07046d8
--- /dev/null
+++ b/lib/Net/HTTP/Spore/Middleware/Redirection.pm
@@ -0,0 +1,44 @@
+package Net::HTTP::Spore::Middleware::Redirection;
+
+use Moose;
+
+extends 'Net::HTTP::Spore::Middleware';
+
+with 'Net::HTTP::Spore::Role::Request', 'Net::HTTP::Spore::Role::UserAgent';
+
+has max_redirect => ( is => 'rw', isa => 'Int', lazy => 1, default => 5 );
+
+sub call {
+    my ( $self, $req ) = @_;
+
+    my $nredirect = 0;
+
+    return $self->response_cb(
+        sub {
+            my $res      = shift;
+            while ( $nredirect < $self->max_redirect ) {
+                my $location = $res->header('location');
+                my $status   = $res->status;
+                if (
+                    $location
+                    and (  $status == 301
+                        or $status == 302
+                        or $status == 303
+                        or $status == 307 )
+                  )
+                {
+                    my $uri = URI->new($location);
+                    $req->env->{HTTP_HOST} = $uri->host;
+                    $req->env->{PATH_INFO} = $uri->path;
+                    $res = $self->_request($req);
+                    $nredirect++;
+                }else{
+                    last;
+                }
+            }
+            return $res;
+        }
+    );
+}
+
+1;
diff --git a/lib/Net/HTTP/Spore/Role/Request.pm b/lib/Net/HTTP/Spore/Role/Request.pm
index 7fbb290..a0d61b1 100644
--- a/lib/Net/HTTP/Spore/Role/Request.pm
+++ b/lib/Net/HTTP/Spore/Role/Request.pm
@@ -33,27 +33,41 @@ sub http_request {
         }
     }
 
-    if (defined $response) {
-        map { $_->($response) } reverse @middlewares;
-        return $response;
+    return
+      $self->_execute_middlewares_on_response( $response, @middlewares )
+      if defined $response;
+
+    $response = $self->_request($request);
+
+    return $self->_execute_middlewares_on_response( $response, @middlewares );
+}
+
+sub _execute_middlewares_on_response {
+    my ($self, $response, @middlewares) = @_;
+
+    foreach my $mw ( reverse @middlewares ) {
+        my $res = $mw->($response);
+        $response = $res
+          if ( defined $res
+            && Scalar::Util::blessed($res)
+            && $res->isa('Net::HTTP::Spore::Response') );
     }
 
-    my $final = $request->finalize;
-    $self->_trace_msg("<- ".$request->method. " => ".$request->uri);
+    $response;
+}
+
+sub _request {
+    my ($self, $request) = @_;
 
-    my $result = $self->request($final);
+    my $result = $self->request($request->finalize);
 
-    $response = $request->new_response(
+    my $response = $request->new_response(
         $result->code,
         $result->headers,
         $result->content,
     );
 
-    $self->_trace_msg("<- HTTP Status".$result->code );
-    
-    map { $_->($response) } reverse @middlewares;
-
-    $response;
+    return $response;
 }
 
 1;
diff --git a/lib/Net/HTTP/Spore/Role/UserAgent.pm b/lib/Net/HTTP/Spore/Role/UserAgent.pm
index 6bfaa5a..9b99ab8 100644
--- a/lib/Net/HTTP/Spore/Role/UserAgent.pm
+++ b/lib/Net/HTTP/Spore/Role/UserAgent.pm
@@ -15,6 +15,7 @@ has api_useragent => (
         my $ua = LWP::UserAgent->new();
         $ua->agent( "Net::HTTP::Spore v" . $Net::HTTP::Spore::VERSION . " (Perl)" );
         $ua->env_proxy;
+        $ua->max_redirect(0);
         return $ua;
     }
 );
diff --git a/t/spore-middleware/redirection.t b/t/spore-middleware/redirection.t
new file mode 100644
index 0000000..fe239f9
--- /dev/null
+++ b/t/spore-middleware/redirection.t
@@ -0,0 +1,27 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+plan tests => 2;
+
+use Net::HTTP::Spore;
+
+SKIP: {
+    skip "require RUN_HTTP_TEST", 2 unless $ENV{RUN_HTTP_TEST};
+    my $client = Net::HTTP::Spore->new_from_string(
+        '{
+    "base_url" : "http://fperrad.googlepages.com",
+      "name"   : "googlepages",
+      "methods"
+      : { "get_home"
+        : { "path" : "/home", "method" : "GET", "expected_status" : [200] } }
+    }');
+
+    $client->enable('Redirection');
+
+    my $r = $client->get_home();
+    is $r->status, 200;
+    is $r->request->uri,
+      'http://sites.google.com/site/fperrad/home';
+}