view release on metacpan or  search on metacpan

lib/AxKit2/Test.pm  view on Meta::CPAN

    status_is is_redirect no_redirect header_is
    skip plan);
our $VERSION = 0.01;

# Module to assist with testing

my $ua = LWP::UserAgent->new;
$ua->agent(__PACKAGE__."/".$VERSION);

my $server_port = 54000;

sub get_free_port {
    die "No ports free" if $server_port == 65534;
    
    while (IO::Socket::INET->new(PeerAddr => "localhost:$server_port")) {
        $server_port++;
    }
    if (IO::Socket::INET->new(PeerAddr => "localhost", PeerPort => $server_port+1)) {
        # server port free, console port isn't
        $server_port += 2;
        return get_free_port();
    }
    return $server_port;
}

my $server;

=head2 start_server <config> | <docroot> <plugins> <directives>

This takes either a configuration file excerpt as a string (anything that goes inside a <Server></Server> block),
or the document root, a list of plugins to load and a list of other configuration directives.

=cut

sub start_server {
    my ($docroot, $plugins, $directives) = @_;
    
    my $port = get_free_port();
    
    if (defined $plugins) {
        $directives ||= [];
        $docroot = File::Spec->rel2abs($docroot);
        $server = AxKit2::Test::Server->new($port,"DocumentRoot '$docroot'\n" . 
            join("\n",map { "Plugin $_" } @$plugins) . "\n" . 
            join("\n",@$directives) . "\n");
    } else {
        $server = AxKit2::Test::Server->new($port, $docroot);
    }

    return $server;
}

sub stop_server {
    $server->shutdown();
    undef $server;
}

sub http_get {
    my ($url) = @_;
    $url = "http://localhost:$server_port$url" if $url !~ m/^[a-z0-9]{1,6}:/i;
    my $req = new HTTP::Request(GET => $url);
    return ($req, $ua->request($req));
}

sub plan {
    my $builder = __PACKAGE__->builder;
    return $builder->plan(@_);
}

sub skip {
    my $builder = __PACKAGE__->builder;
    return $builder->skip(@_);
}

sub content_is {
    my ($url, $content, $name, $ignore) = @_;
    my $builder = __PACKAGE__->builder;
    my $res = http_get($url);
    if (!$ignore && !$res->is_success) {
        $builder->ok(0,$name);
        $builder->diag("Request for '${url}' failed with error code ".$res->status_line);
        return 0;
    }
    my $got = $res->content;
    $got =~ s/[\r\n]*$//;
    $content =~ s/[\r\n]*$//;
    $builder->is_eq($got, $content, $name) or $builder->diag("Request URL: ${url}");
}

sub header_is {
    my ($url, $header, $content, $name, $ignore) = @_;
    my $builder = __PACKAGE__->builder;
    my $res = http_get($url);
    if (!$ignore && !$res->is_success) {
        $builder->ok(0,$name);
        $builder->diag("Request for '${url}' failed with error code ".$res->status_line);
        return 0;
    }
    my $got = $res->header($header);
    $builder->is_eq($got, $content, $name) or $builder->diag("Request URL: ${url}");
}

sub content_matches {
    my ($url, $regex, $name, $ignore) = @_;
    my $builder = __PACKAGE__->builder;
    my $res = http_get($url);
    if (!$ignore && !$res->is_success) {
        $builder->ok(0,$name);
        $builder->diag("Request for '${url}' failed with error code ".$res->status_line);
        return 0;
    }
    my $got = decode_utf8($res->content);
    $got =~ s/[\r\n]*$//;
    $regex = qr($regex) unless ref($regex);
    $builder->like($got, $regex, $name) or $builder->diag("Request URL: ${url}");
}

sub content_doesnt_match {
    my ($url, $regex, $name, $ignore) = @_;
    my $builder = __PACKAGE__->builder;
    my $res = http_get($url);