A tiny Mojolicious server in a test program

tags: mojolicious 

I originally wrote this quickly to see about posting to my reddit profile: the post

Sometimes I need a simple web server to do something in a test. Most often this web server needs to simulate some error condition, such as a timeout or other server error.

In this test program I fork. In the child, I start a Mojolicious server where the / path has a 10 second delay. This will be longer than the time-out I set for the user-agent in the parent. The magic is the Mojo::IOLoop->start that keeps the server going at the end of the program.

In the parent I do whatever I want to test, which is usually something much more complicated. When I’m done, I shut down the server and get on in life.

#!perl
use v5.40;

use Mojolicious::Lite;
use Mojo::Server::Daemon;
use Mojo::UserAgent;

my $port = 3000;

my $pid = fork;

if( $pid == 0 ) {
    local $SIG{INT} = sub {exit};
    local $SIG{TERM} = sub {exit};
    local $SIG{__WARN__} = sub {1};

    get '/' => sub ($c) {
      sleep 10;
      $c->render(text => 'Hello from inside the program!');
    };

    local *STDOUT;
    open STDOUT, '>>', '/dev/null';
    my $app = app->log( Mojo::Log->new(path => '/dev/null') );
    my $daemon = Mojo::Server::Daemon->new(app => $app, listen => ["http://127.0.0.1:$port"]);
    $daemon->start;
    Mojo::IOLoop->start;
    }
else {
    sleep 2; # let server start
    my $ua = Mojo::UserAgent->new->inactivity_timeout(3);
    my $tx = $ua->get( "http://127.0.0.1:$port/" );

    if( eval {$tx->result} ) {
        say "BODY: " . $tx->res->body;
        }
    else {
        say "ERROR: $@";
        }

    kill 9, $pid;
    waitpid $pid, 0;
    }

Previously, I also used HTTP::Daemon, which was fine too, but I often am dealing with Mojolicious so it’s already there.