view release on metacpan or  search on metacpan

inc/Test/HTTP/AnyEvent/Server.pm  view on Meta::CPAN

package Test::HTTP::AnyEvent::Server;
# ABSTRACT: the async counterpart to Test::HTTP::Server


use feature qw(state switch);
use strict;
use utf8;
use warnings qw(all);

use AnyEvent;
use AnyEvent::Handle;
use AnyEvent::Log;
use AnyEvent::Socket;
use AnyEvent::Util;
use HTTP::Headers;
use HTTP::Request;
use HTTP::Response;
use Moo;
use MooX::Types::MooseLike::Base qw(:all);
use POSIX;

no if ($] >= 5.017010), warnings => q(experimental);

#$AnyEvent::Log::FILTER->level('debug');

our $VERSION = '0.007'; # VERSION

my %pool;


has address     => (is => 'ro', isa => Str, default => sub { '127.0.0.1' }, writer => 'set_address');


has port        => (is => 'ro', isa => Int, writer => 'set_port');


has maxconn     => (is => 'ro', isa => Int, default => sub { 10 });


has timeout     => (is => 'ro', isa => Int, default => sub { 60 });


has disable_proxy => (is => 'ro', isa => Bool, default => sub { 1 });


has forked      => (is => 'ro', isa => Bool, default => sub { 0 });


has forked_pid  => (is => 'ro', isa => Int, writer => 'set_forked_pid');


has server      => (is => 'ro', isa => Ref, writer => 'set_server');


sub BUILD {
    my ($self) = @_;

    ## no critic (RequireLocalizedPunctuationVars)
    @ENV{qw(no_proxy http_proxy ftp_proxy all_proxy)} = (q(localhost,127.0.0.1), (q()) x 3)
        if $self->disable_proxy;

    unless ($self->forked) {
        $self->set_server(
            $self->start_server(sub {
                my (undef, $address, $port) = @_;
                $self->set_address($address);
                $self->set_port($port);

inc/Test/HTTP/AnyEvent/Server.pm  view on Meta::CPAN

        200 => 'OK',
        HTTP::Headers->new(
            Connection      => 'close',
            Content_Type    => 'text/plain',
            Server          => __PACKAGE__ . "/$Test::HTTP::AnyEvent::Server::VERSION AnyEvent/$AE::VERSION Perl/$] ($^O)",
        )
    );
    $res->date(time);
    $res->protocol('HTTP/1.0');

    if ($req =~ m{^(GET|POST)\s+(.+)\s+(HTTP/1\.[01])$}ix) {
        my ($method, $uri, $protocol) = ($1, $2, $3);
        AE::log debug => "sending response to $method ($protocol)\n";
        for ($uri) {
            when (m{^/repeat/(\d+)/(.+)}x) {
                $res->content($2 x $1);
            } when (m{^/echo/head$}x) {
                $res->content(
                    join(
                        "\015\012",
                        $req,
                        $hdr,
                    )
                );
            } when (m{^/echo/body$}x) {
                $res->content($content);
            } when (m{^/delay/(\d+)$}x) {
                $res->content(sprintf(qq(issued %s\n), scalar gmtime));
                $timer->{$h} = AE::timer $1, 0, sub {
                    delete $timer->{$h};
                    AE::log debug => "delayed response\n";
                    $h->push_write($res->as_string("\015\012"));
                    _cleanup($h);
                };
                return;
            } default {
                $res->code(404);
                $res->message('Not Found');
                $res->content('Not Found');
            }
        }
    } else {
        AE::log error => "bad request\n";
        $res->code(400);
        $res->message('Bad Request');
        $res->content('Bad Request');
    }

    $h->push_write($res->as_string("\015\012"));
    _cleanup($h);
    return;
}


1;

__END__

=pod

=encoding utf8

=head1 NAME

Test::HTTP::AnyEvent::Server - the async counterpart to Test::HTTP::Server

=head1 VERSION

version 0.007

=head1 SYNOPSIS

    #!/usr/bin/env perl
    use common::sense;

    use AnyEvent::HTTP;
    use Test::HTTP::AnyEvent::Server;

    my $server = Test::HTTP::AnyEvent::Server->new;
    my $cv = AE::cv;

    $cv->begin;
    http_request GET => $server->uri . q(echo/head), sub {
        my ($body, $hdr) = @_;
        say $body;
        $cv->end;
    };

    $cv->wait;

=head1 DESCRIPTION

This package provides a simple B<NON>-forking HTTP server which can be used for testing HTTP clients.

=head1 ATTRIBUTES

=head2 address

Address to bind the server.
Defaults to C<127.0.0.1>.

=head2 port

Port to bind the server.
Picks the first available by default.

=head2 maxconn

Limit the number of accepted connections to this.
Default: 10.

=head2 timeout

Timeout connection after this number of seconds.
Default: 60.

=head2 disable_proxy

Reset the proxy-controlling environment variables (C<no_proxy>/C<http_proxy>/C<ftp_proxy>/C<all_proxy>).
I guess you don't need a proxy to connect to yourself.
Default: true.