s/to_psgi/to_app/g; and tests

gfx · Aug 11, 2010 · 2933c14 · 2933c14
1 parent 10980d4
commit 2933c14
Show file tree

Hide file tree

Showing 4 changed files with 41 additions and 14 deletions.
diff --git a/lib/Web/Weaver.pm b/lib/Web/Weaver.pm
@@ -9,14 +9,14 @@ our $VERSION = '0.0001';
 #use XSLoader;
 #XSLoader::load(__PACKAGE__, $VERSION);
 
-my $agent = sprintf '%s/%s', __PACKAGE__, $VERSION;
+sub default_user_agent {
+    return sprintf '%s/%s', __PACKAGE__, $VERSION;
+}
 
-sub to_psgi {
+sub to_app{
     my($class, $request_rewriter) = @_;
 
-    my $self = $class->new(
-        agent => $agent,
-    );
+    my $self = ref($class) ? $class : $class->new();
 
     return sub {
         my($env) = @_;
@@ -51,7 +51,7 @@ This document describes Web::Weaver version 0.0001.
     #!psgi
     use Web::Weaver::Curl; # or ::LWP
 
-    my $app = Web::Weaver::Curl->to_psgi(sub {
+    my $app = Web::Weaver::Curl->to_app(sub {
         my($env) = @_;
         # rewrite $env
         $env->{REMOTE_ADDR} = MY_APP_REMOTE_ADDR();

diff --git a/lib/Web/Weaver/Curl.pm b/lib/Web/Weaver/Curl.pm
@@ -20,10 +20,13 @@ sub new {
     }
 
     my $curl = WWW::Curl::Easy->new();
-    $curl->setopt(CURLOPT_USERAGENT, $agent)   if defined $agent;
-    $curl->setopt(CURLOPT_TIMEOUT,   $timeout) if defined $timeout;
     $curl->setopt(CURLOPT_HEADER, 0);
 
+    $curl->setopt(CURLOPT_USERAGENT,
+        $agent || $class->default_user_agent);
+
+    $curl->setopt(CURLOPT_TIMEOUT,   $timeout) if defined $timeout;
+
     return bless { curl => $curl }, $class;
 }
 

diff --git a/lib/Web/Weaver/LWP.pm b/lib/Web/Weaver/LWP.pm
@@ -4,6 +4,12 @@ use warnings;
 
 use parent qw(Web::Weaver LWP::UserAgent);
 
+sub new {
+    my($self, %args) = @_;
+    $args{agent} ||= $self->default_user_agent;
+    return $self->SUPER::new(%args);
+}
+
 sub request {
     my($self, $env) = @_;
 

diff --git a/lib/Web/Weaver/TestSuite.pm b/lib/Web/Weaver/TestSuite.pm
@@ -31,32 +31,50 @@ sub test_web_weaver {
     my($port, $module) = @_;
     test_psgi(
         # proxy server
-        app => $module->to_psgi(sub {
+        app => $module->new(timeout => 1)->to_app(sub {
             my($env) = @_;
             $env->{SERVER_PORT} = $port;
         }),
 
         # client 
         client => sub {
             my $cb = shift;
+
+            note 'normal request';
             my $req = HTTP::Request->new(GET => "http://localhost/hello?xxx");
             my $res = $cb->($req);
 
-            ok $res->is_success;
-            is $res->content_type, 'application/x-perl';
+            ok $res;
+            ok $res->is_success, '... is success';
+            is $res->code, 200, 'status: 200';
+            is $res->content_type, 'application/x-perl',
+                '... with correct content_type';
 
             #note $res->content;
             my $env = eval 'no strict qw(vars refs); ' . $res->content;
             diag "Eval error: " . $@ if $@;
-            is $env->{SERVER_PORT}, $port;
-            is $env->{REQUEST_URI}, "/hello?xxx";
+            is $env->{SERVER_PORT}, $port, ' ... correct port';
+            is $env->{REQUEST_URI}, "/hello?xxx", '... correct uri';
+            like $env->{HTTP_USER_AGENT}, qr/Web::Weaver/, '... correct user ageent';
 
+            note 'request not found';
             $req = HTTP::Request->new(GET => "http://localhost/hello?not_found=1");
             $res = $cb->($req);
 
-            ok !$res->is_success;
+            ok !$res->is_success, 'not found';
+            is $res->code, 404, 'status: 404';
             is $res->content_type, 'text/plain';
             is $res->content, 'not_found';
+
+            note 'request timeout';
+            my $t0 = time();
+            $req = HTTP::Request->new(GET => "http://localhost/hello?sleep=10");
+            $res = $cb->($req);
+            my $t1 = time();
+
+            ok !$res->is_success, 'timeout';
+            is $res->code, 500, 'status: 500';
+            cmp_ok $t1 - $t0, '<', 2;
         },
     );
 }