[Rt-commit] r3232 - in Test-HTTP-Server-Simple: . lib lib/Test lib/Test/HTTP lib/Test/HTTP/Server t

glasser at bestpractical.com glasser at bestpractical.com
Mon Jun 20 15:25:01 EDT 2005


Author: glasser
Date: Mon Jun 20 15:25:01 2005
New Revision: 3232

Added:
   Test-HTTP-Server-Simple/Build.PL
   Test-HTTP-Server-Simple/Changes
   Test-HTTP-Server-Simple/MANIFEST
   Test-HTTP-Server-Simple/META.yml
   Test-HTTP-Server-Simple/Makefile.PL
   Test-HTTP-Server-Simple/README
   Test-HTTP-Server-Simple/lib/
   Test-HTTP-Server-Simple/lib/Test/
   Test-HTTP-Server-Simple/lib/Test/HTTP/
   Test-HTTP-Server-Simple/lib/Test/HTTP/Server/
   Test-HTTP-Server-Simple/lib/Test/HTTP/Server/Simple.pm
   Test-HTTP-Server-Simple/t/
   Test-HTTP-Server-Simple/t/00.load.t
   Test-HTTP-Server-Simple/t/01.basic.t
   Test-HTTP-Server-Simple/t/pod-coverage.t
   Test-HTTP-Server-Simple/t/pod.t
Log:
Add first version of Test::HTTP::Server::Simple

Added: Test-HTTP-Server-Simple/Build.PL
==============================================================================
--- (empty file)
+++ Test-HTTP-Server-Simple/Build.PL	Mon Jun 20 15:25:01 2005
@@ -0,0 +1,18 @@
+use strict;
+use warnings;
+use Module::Build;
+
+my $builder = Module::Build->new(
+    module_name         => 'Test::HTTP::Server::Simple',
+    license             => 'perl',
+    dist_author         => 'David Glasser <glasser at bestpractical.com>',
+    dist_version_from   => 'lib/Test/HTTP/Server/Simple.pm',
+    requires => {
+        'Test::More' => 0,
+        'Test::Builder' => 0,
+        'HTTP::Server::Simple' => 0,
+    },
+    add_to_cleanup      => [ 'Test-HTTP-Server-Simple-*' ],
+);
+
+$builder->create_build_script();

Added: Test-HTTP-Server-Simple/Changes
==============================================================================
--- (empty file)
+++ Test-HTTP-Server-Simple/Changes	Mon Jun 20 15:25:01 2005
@@ -0,0 +1,5 @@
+Revision history for Test-HTTP-Server-Simple
+
+0.0.1  Thu Jun 16 18:16:56 2005
+       Initial release.
+

Added: Test-HTTP-Server-Simple/MANIFEST
==============================================================================
--- (empty file)
+++ Test-HTTP-Server-Simple/MANIFEST	Mon Jun 20 15:25:01 2005
@@ -0,0 +1,11 @@
+Build.PL
+Changes
+lib/Test/HTTP/Server/Simple.pm
+Makefile.PL
+MANIFEST
+META.yml			# Will be created by "make dist"
+README
+t/00.load.t
+t/01.basic.t
+t/pod-coverage.t
+t/pod.t

Added: Test-HTTP-Server-Simple/META.yml
==============================================================================
--- (empty file)
+++ Test-HTTP-Server-Simple/META.yml	Mon Jun 20 15:25:01 2005
@@ -0,0 +1,14 @@
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!!  It will change in the future!!! XXXXX#
+name:         Test-HTTP-Server-Simple
+version:      0.01
+version_from: lib/Test/HTTP/Server/Simple.pm
+installdirs:  site
+requires:
+    HTTP::Cookies:                 0
+    Test::Builder:                 0
+    Test::More:                    0
+    Test::WWW::Mechanize:          0
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.17

Added: Test-HTTP-Server-Simple/Makefile.PL
==============================================================================
--- (empty file)
+++ Test-HTTP-Server-Simple/Makefile.PL	Mon Jun 20 15:25:01 2005
@@ -0,0 +1,18 @@
+use strict;
+use warnings;
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+    NAME                => 'Test::HTTP::Server::Simple',
+    AUTHOR              => 'David Glasser <glasser at bestpractical.com>',
+    VERSION_FROM        => 'lib/Test/HTTP/Server/Simple.pm',
+    ABSTRACT_FROM       => 'lib/Test/HTTP/Server/Simple.pm',
+    PL_FILES            => {},
+    PREREQ_PM => {
+        'Test::More' => 0,
+        'Test::Builder' => 0,
+	'HTTP::Server::Simple' => 0,
+    },
+    dist                => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
+    clean               => { FILES => 'Test-HTTP-Server-Simple-*' },
+);

Added: Test-HTTP-Server-Simple/README
==============================================================================
--- (empty file)
+++ Test-HTTP-Server-Simple/README	Mon Jun 20 15:25:01 2005
@@ -0,0 +1,34 @@
+Test-HTTP-Server-Simple version 0.0.1
+
+Provides some very basic test functions for HTTP::Server::Simple.
+Currently, just deals with cleanly backgrounding and killing a child
+server process.
+
+
+INSTALLATION
+
+To install this module, run the following commands:
+
+    perl Makefile.PL
+    make
+    make test
+    make install
+
+
+Alternatively, to install with Module::Build, you can use the following commands:
+
+    perl Build.PL
+    ./Build
+    ./Build test
+    ./Build install
+
+
+
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2005, Best Practical Solutions LLC.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+

Added: Test-HTTP-Server-Simple/lib/Test/HTTP/Server/Simple.pm
==============================================================================
--- (empty file)
+++ Test-HTTP-Server-Simple/lib/Test/HTTP/Server/Simple.pm	Mon Jun 20 15:25:01 2005
@@ -0,0 +1,161 @@
+package Test::HTTP::Server::Simple;
+
+our $VERSION = '0.01';
+
+use warnings;
+use strict;
+use Carp;
+
+use Exporter;
+our @ISA = qw/Exporter/;
+our @EXPORT = qw/started_ok/;
+
+use Test::Builder;
+my $Tester = Test::Builder->new;
+
+=head1 NAME
+
+Test::HTTP::Server::Simple - Test::More functions for HTTP::Server::Simple
+
+
+=head1 SYNOPSIS
+
+    use Test::More tests => 42;
+    use Test::HTTP::Server::Simple;
+
+    my $s = My::WebServer->new;
+
+    my $url_root = started_ok($s, "start up my web server);
+
+    # connect to "$url_root/cool/site" and test with Test::WWW::Mechanize,
+    # Test::HTML::Tidy, etc
+
+  
+=head1 DESCRIPTION
+
+This module provides functions to test an L<HTTP::Server::Simple>-based web
+server.  Currently, it provides only one such function: C<started_ok>.
+
+=over 4 
+
+=item started_ok $server, [$text]
+
+C<started_ok> takes an instance of a subclass of L<HTTP::Server::Simple> and
+an optional test description.  The server needs to have been configured (specifically,
+its port needs to have been set), but it should not have been run or backgrounded.
+C<started_ok> calls C<background> on the server, which forks it to run in the background.
+L<Test::HTTP::Server::Simple> takes care of killing the server when your test script dies,
+even if you kill your test script with an interrupt.  C<started_ok> returns the URL 
+C<http://localhost:$port> which you can use to connect to your server.
+
+=cut
+
+my @CHILD_PIDS;
+
+# If an interrupt kills perl, END blocks are not run.  This
+# essentially converts interrupts (like CTRL-C) into a standard
+# perl exit (even if we're inside an eval {}).
+$SIG{INT} = sub { exit };
+
+END {
+    kill 9, @CHILD_PIDS if @CHILD_PIDS;
+} 
+
+sub started_ok {
+    my $server = shift;
+    my $text   = shift;
+    $text = 'started server' unless defined $text;
+
+    unless (UNIVERSAL::isa($server, 'HTTP::Server::Simple')) {
+	$Tester->ok(0, $text);
+	$Tester->diag("$server is not an HTTP::Server::Simple");
+	return;
+    } 
+
+    my $port = $server->port;
+    my $pid;
+    
+    eval { $pid = $server->background; };
+
+    if ($@) {
+	my $error_text = $@;  # In case the next line changes it.
+	$Tester->ok(0, $text);
+	$Tester->diag("HTTP::Server::Simple->background failed: $error_text");
+	return;
+    }
+
+    unless ($pid =~ /^-?\d+$/) {
+	$Tester->ok(0, $text);
+	$Tester->diag("HTTP::Server::Simple->background didn't return a valid PID");
+	return;
+    } 
+
+    push @CHILD_PIDS, $pid;
+
+    $Tester->ok(1, $text);
+
+    return "http://localhost:$port";
+} 
+
+=back
+
+=head1 DEPENDENCIES
+
+L<Test::Builder>, L<HTTP::Server::Simple>.
+
+
+=head1 INCOMPATIBILITIES
+
+None reported.
+
+
+=head1 BUGS AND LIMITATIONS
+
+Installs an interrupt signal handler, which may override any that another part
+of your program has installed.
+
+Please report any bugs or feature requests to
+C<bug-test-http-server-simple at rt.cpan.org>, or through the web interface at
+L<http://rt.cpan.org>.
+
+
+=head1 AUTHOR
+
+David Glasser  C<< <glasser at bestpractical.com> >>
+
+
+=head1 LICENCE AND COPYRIGHT
+
+Copyright (c) 2005, Best Practical Solutions, LLC.  All rights reserved.
+
+This module is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself. See L<perlartistic>.
+
+
+=head1 DISCLAIMER OF WARRANTY
+
+BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
+EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
+ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
+YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
+NECESSARY SERVICING, REPAIR, OR CORRECTION.
+
+IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
+REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
+LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
+OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
+THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
+RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
+FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
+SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
+SUCH DAMAGES.
+
+=cut
+
+1;
+

Added: Test-HTTP-Server-Simple/t/00.load.t
==============================================================================
--- (empty file)
+++ Test-HTTP-Server-Simple/t/00.load.t	Mon Jun 20 15:25:01 2005
@@ -0,0 +1,7 @@
+use Test::More tests => 1;
+
+BEGIN {
+use_ok( 'Test::HTTP::Server::Simple' );
+}
+
+diag( "Testing Test::HTTP::Server::Simple $Test::HTTP::Server::Simple::VERSION" );

Added: Test-HTTP-Server-Simple/t/01.basic.t
==============================================================================
--- (empty file)
+++ Test-HTTP-Server-Simple/t/01.basic.t	Mon Jun 20 15:25:01 2005
@@ -0,0 +1,56 @@
+#!/usr/bin/perl
+
+use Test::More tests => 11;
+use Test::Builder::Tester;
+
+BEGIN { use_ok "Test::HTTP::Server::Simple" }
+
+BEGIN { use_ok "HTTP::Server::Simple" }
+
+ok(defined(&started_ok), "function 'started_ok' exported");
+
+test_out("not ok 1 - bar");
+test_fail(+2);
+test_diag("foo is not an HTTP::Server::Simple");
+started_ok("foo", "bar");
+test_test("first arg to started_ok must be an HTTP::Server::Simple");
+
+test_out("not ok 1 - baz");
+test_fail(+2);
+test_diag("HTTP::Server::Simple->background failed: random failure");
+started_ok(THSS::FailOnBackground->new(1234), "baz");
+test_test("detect background failure");
+
+test_out("not ok 1 - blop");
+test_fail(+2);
+test_diag("HTTP::Server::Simple->background didn't return a valid PID");
+started_ok(THSS::ReturnInvalidPid->new(4194), "blop");
+test_test("detect bad pid");
+
+BEGIN { use_ok "HTTP::Server::Simple::CGI" }
+
+test_out("ok 1 - beep");
+my $URL = started_ok(HTTP::Server::Simple::CGI->new(9583), "beep");
+test_test("start up correctly");
+
+is($URL, "http://localhost:9583");
+
+test_out("ok 1 - started server");
+$URL = started_ok(HTTP::Server::Simple::CGI->new(9384));
+test_test("start up correctly (with default message)");
+
+is($URL, "http://localhost:9384");
+
+
+# unfortunately we do not test the child-killing properties of THHS,
+# even though that's the main point of the module
+
+
+package THSS::FailOnBackground;
+use base qw/HTTP::Server::Simple/;
+sub background { die "random failure\n" }
+
+package THSS::ReturnInvalidPid;
+use base qw/HTTP::Server::Simple/;
+sub background { return "" }
+

Added: Test-HTTP-Server-Simple/t/pod-coverage.t
==============================================================================
--- (empty file)
+++ Test-HTTP-Server-Simple/t/pod-coverage.t	Mon Jun 20 15:25:01 2005
@@ -0,0 +1,6 @@
+#!perl -T
+
+use Test::More;
+eval "use Test::Pod::Coverage 1.04";
+plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@;
+all_pod_coverage_ok();

Added: Test-HTTP-Server-Simple/t/pod.t
==============================================================================
--- (empty file)
+++ Test-HTTP-Server-Simple/t/pod.t	Mon Jun 20 15:25:01 2005
@@ -0,0 +1,6 @@
+#!perl -T
+
+use Test::More;
+eval "use Test::Pod 1.14";
+plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
+all_pod_files_ok();


More information about the Rt-commit mailing list