[Jifty-commit] r3774 - in Test-WWW-Declare: lib/Test/WWW/Declare t

Fri Aug 3 15:43:37 EDT 2007

Author: sartak
Date: Fri Aug  3 15:43:37 2007
New Revision: 3774

Added:
   Test-WWW-Declare/lib/Test/WWW/Declare/
   Test-WWW-Declare/lib/Test/WWW/Declare/Tester.pm
   Test-WWW-Declare/t/00-load.t
   Test-WWW-Declare/t/01-basic.t
Modified:
   Test-WWW-Declare/   (props changed)
   Test-WWW-Declare/Makefile.PL

Log:
 r29872 at caladan:  sartak | 2007-08-03 15:43:04 -0400
 Real tests of the module. Uses a local server.


Modified: Test-WWW-Declare/Makefile.PL
==============================================================================

--- Test-WWW-Declare/Makefile.PL	(original)
+++ Test-WWW-Declare/Makefile.PL	Fri Aug  3 15:43:37 2007
@@ -1,10 +1,11 @@
 use inc::Module::Install;
-name('Test-WWW-Declare');
-license('perl');
-version_from('lib/Test/WWW/Declare.pm');
-requires (
-'WWW::Mechanize' => 0,
-'Test::Builder' => 0
-);
+
+name         'Test-WWW-Declare';
+license      'perl';
+version_from 'lib/Test/WWW/Declare.pm';
+
+requires 'WWW::Mechanize';
+requires 'Test::Builder';
 
 WriteAll;
+

Added: Test-WWW-Declare/lib/Test/WWW/Declare/Tester.pm
==============================================================================
--- (empty file)
+++ Test-WWW-Declare/lib/Test/WWW/Declare/Tester.pm	Fri Aug  3 15:43:37 2007
@@ -0,0 +1,71 @@
+#!perl
+package Test::WWW::Declare::Tester::Server;
+use strict;
+use warnings;
+use base 'HTTP::Server::Simple::CGI';
+
+my %content = (
+   index => << "INDEX",
+<h1>This is an index</h1>
+<a href="good">good link</a>
+<a href="bad">bad link</a>
+<a href="good">same good link</a>
+INDEX
+
+   good => << "GOOD",
+<h1>This is a good page</h1>
+<a href="index">index</a>
+<a href="bad">bad link</a>
+<a href="good">infinite recursion</a>
+GOOD
+
+);
+
+for (values %content)
+{
+    s/^/        /mg;
+
+    $_ = << "WRAPPER";
+<html>
+    <body>
+$_
+    </body>
+</html>
+WRAPPER
+
+}
+
+sub handle_request {
+    my $self = shift;
+    my $cgi = shift;
+
+    my $page = (split '/', $cgi->path_info)[-1];
+    $page ||= 'index';
+    $page =~ s/\s+//g;
+
+    if (my $content = $content{$page}) {
+        print "HTTP/1.0 200 OK\r\n";
+        print "Content-Type: text/html\r\nContent-Length: ",
+              length($content),
+              "\r\n\r\n",
+              $content;
+        return;
+    }
+
+    print "HTTP/1.0 404 Not Found\r\n\r\n";
+}
+
+package Test::WWW::Declare::Tester;
+use base 'Exporter';
+our @EXPORT = qw($PORT $SERVER $PID);
+
+our $PORT = 12321;
+our $SERVER = Test::WWW::Declare::Tester::Server->new($PORT);
+our $PID = $SERVER->background or die "Cannot start the server";
+
+END {
+    kill(9, $PID);
+}
+
+1;
+

Added: Test-WWW-Declare/t/00-load.t
==============================================================================
--- (empty file)
+++ Test-WWW-Declare/t/00-load.t	Fri Aug  3 15:43:37 2007
@@ -0,0 +1,6 @@
+#!perl
+use Test::More tests => 2;
+
+use_ok 'Test::WWW::Declare';
+use_ok 'Test::WWW::Declare::Tester';
+

Added: Test-WWW-Declare/t/01-basic.t
==============================================================================
--- (empty file)
+++ Test-WWW-Declare/t/01-basic.t	Fri Aug  3 15:43:37 2007
@@ -0,0 +1,28 @@
+#!perl
+use Test::Tester tests => 5;
+use Test::WWW::Declare;
+use Test::WWW::Declare::Tester;
+use warnings;
+use strict;
+
+my @results = run_tests(
+    sub {
+        session "check logins" => run {
+            flow "basic connectivity" => check {
+                get "http://localhost:$PORT/";
+                content should match qr{This is an index};
+                click href qr{good};
+                content should match qr{This is a good page}i;
+            };
+        };
+    }
+);
+
+shift @results; # Test::Tester gives 1-based arrays
+is(@results, 2, "had two tests");
+ok($results[0]{ok}, "1st test passed");
+ok($results[1]{ok}, "2nd test passed");
+
+is($results[0]{name}, "basic connectivity", "1st test was flow");
+is($results[1]{name}, "check logins", "1st test was flow");
+
