The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# This is by no means any where close to a real web server but a rather quick
# solution for testing purposes.

use warnings;
use strict;
use IO::Socket;
use File::stat;
use File::Basename;

my $server = IO::Socket::INET->new(
    Proto     => 'tcp',
    Listen    => SOMAXCONN,
    LocalPort => 63636,
    ReuseAddr => 1
);

my $server_root = "t/";

die "Server failed.\n" unless $server;

while ( my $client = $server->accept() ) {
    $client->autoflush(1);
    
    my $request = <$client>;
    
    my $filename;
    my $filesize;
    my $content_type;
    my $success = 1;

    if ( $request =~ m|^GET /(.+) HTTP/1.| || $request =~ m|^GET / HTTP/1.| ) {
        if ( $1 && -e $server_root . 'www/' . $1 ) {
            $filename = $server_root . 'www/' . $1;
        }
        else {
            $success  = 0;
            $filename = $server_root . 'www/404.html';
        }

        my ( undef, undef, $ftype ) = fileparse( $filename, qr/\.[^.]*/ );

        $filesize = stat($filename)->size;
        $content_type = "text/html";

        if ($success) {
            print $client
"HTTP/1.1 200 OK\nContent-Type: $content_type; charset=utf-8\nContent-Length: $filesize\nServer: \n\n";
        }
        else {
            print $client
"HTTP/1.1 404 Not Found\nContent-Type: $content_type; charset=utf-8\nContent-Length: $filesize\nServer: Perl Test Server\n\n";
        }

        open( my $f, "<$filename" );
        while (<$f>) { print $client $_ }
    }
    else {
        print $client 'HTTP/1.1 400 Bad Request\n';
    }

    close $client;
}