File Coverage

blib/lib/Test/WWW/Declare/Tester.pm

Criterion	Covered	Total	%
statement	22	40	55.0
branch	0	6	0.0
condition	0	2	0.0
subroutine	8	11	72.7
pod	1	1	100.0
total	31	60	51.6

#!perl
package Test::WWW::Declare::Tester::Server;
use strict;
use warnings;
use base 'HTTP::Server::Simple::CGI';

my %content = (
   index => << "INDEX",
This is an index
good link
bad link
same good link
INDEX

   good => << "GOOD",
This is a good page
index
bad link
infinite recursion
GOOD

   formy => << "FORMY",
This page has two forms!








FORMY

    result1 => sub {
        my $cgi = shift; my $clever = $cgi->param('clever');
        return "\U$clever\E";
    },

    result2 => sub {
        my $cgi = shift; my $clever = $cgi->param('clever');
        return "\L$clever\E";
    },

);

sub wrap_content
{
    my ($url, $content) = @_;
    $content =~ s/^/        /mg;

    $content = << "WRAPPER";


        \U$url\E


$content


WRAPPER

    return $content;
}

sub get {
    my $page = (split '/', shift)[-1];
    $page ||= 'index';
    $page =~ s/\s+//g;

    my $content = $content{$page};

    return if !defined($content);
    return wrap_content($page, $content->(@_)) if ref($content) eq 'CODE';
    return wrap_content($page, $content);
}

sub handle_request {
    my $self = shift;
    my $cgi = shift;

    if (my $content = get($cgi->path_info, $cgi)) {
        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 Test::Tester;
use Test::WWW::Declare;
use base 'Test::More';

our $VERSION = '0.02';
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";
sleep 1;

sub import_extra {
    Test::Tester->export_to_level(2);
    Test::WWW::Declare->export_to_level(2);
    Test::More->export_to_level(2);
}

END {
    kill(9, $PID);
}

1;