test http server for static files via Mojo::Server::Daemon

http-mojo-server-test.pl

#!/usr/bin/perl

=head1 NAME

http-mojo-server-test.pl

=head1 DESCRIPTION

test http server via Mojo::Server::Daemon

=head1 SYNOPSIS

    http-mojo-server-test.pl [--host=localhost] [--port=8000] [--document-root=./]
    Options:
        --host, -s          server host (default - localhost)
        --port, -p          server port (default - 8000)
        --document-root, -d document root (default - current dir)
        --access-log, -a    log to this file
        --help, -h          help
        --version, -v       print version

=cut

use strict;
use warnings;

use Data::Dumper;
use Mojo::Server::Daemon;
use Mojolicious::Types;
use URI::Escape;
use Getopt::Long;
use Pod::Usage;

our $VERSION = 0.02;

# -------------------------------------------------------------------
sub main {
    my $host = 'localhost';
    my $port = 8000;
    my $document_root = '.';
    my $access_log;
    my $ext2mimetype = Mojolicious::Types->new->types();

    GetOptions(
        "host|s=s" => \$host
        , "port|p=i" => \$port
        , "document-root|d=s" => \$document_root
        , "access-log|a=s" => \$access_log
        , "help|h" => sub {
            pod2usage(-exitval => 0, -verbose => 99, -sections => [qw/NAME DESCRIPTION SYNOPSIS/]);
        }
        , "version|v" => sub {
            print "$VERSION\n";
            exit 0;
        }
    );

    my $daemon = Mojo::Server::Daemon->new(listen => ["http://$host:$port"]);
    $daemon->on(request => sub {
        my ($daemon, $tx) = @_;

        # Request
        my $method = $tx->req->method;
        my $path = $tx->req->url->path;
        my $file_name = $document_root . uri_unescape($path);
        $file_name =~ s/\.\././g;
        my $user_agent = $tx->req->headers->{headers}->{'user-agent'}->[0]->[0] || '-';
        my $status_code = 200;
        my $content_type = $ext2mimetype->{html};
        my $content;

        # Response
        if (-e $file_name) {

            if (! -r $file_name) {
                $status_code = 403;
                $content = '<h1 style="font-size: 500%;">403 Forbidden.</h1>';
            } elsif (-f $file_name) {
                my ($ext) = $file_name =~ /\.([a-z]+)$/i;

                if ($ext && $ext2mimetype->{lc $ext}) {
                    $content_type = $ext2mimetype->{lc $ext};
                } else {
                    open my $F, '-|', 'file', '--brief', '--mime-type', $file_name or die "error on exec 'file $file_name': $!\n";
                    $content_type = join('', <$F>);
                    $content_type =~ s/\s+//g;
                    close $F;
                }

            } elsif (-d $file_name && ! -e "$file_name/index.html") {
                $content = "<h1>Directory listing:</h1>\n";
                $content .= join("<br>\n",
                    map {my $size = -s $_;
                         s/^\.//;
                         s|//|/|g;
                         qq|<a href="$_">$_</a> - $size|
                    }
                    sort
                    glob("$file_name/*")
                );
            } elsif (-d $file_name && -e "$file_name/index.html" && -r "$file_name/index.html") {
                $file_name = "$file_name/index.html";
            } else {
                $status_code = 500;
                $content = '<h1 style="font-size: 500%;">500 Error.</h1>';
            }

        } else {
            $status_code = 404;
            if (-f "$document_root/404.html" && -r "$document_root/404.html") {
                $file_name = "$document_root/404.html";
            } else {
                $content = '<h1 style="font-size: 500%;">404 Not found.</h1>';
            }
        }

        if (! defined $content && defined $file_name) {
            open my $F, '<', $file_name or die "error open $file_name: $!\n";
            binmode $F, ':raw';
            local $/;
            $content = <$F>;
            close $F;
        }

        $tx->res->code($status_code);
        $tx->res->headers->content_type($content_type);
        $tx->res->body($content);

        # logging
        my $time = localtime() . "";
        my $log_line = "[$time] $method $path ($content_type) - $status_code\n";
        if (defined $access_log) {
            open my $FH, '>>', $access_log or die "Error open file: $!\n";
            print $FH $log_line;
            close $FH;
        } else {
            print STDERR $log_line;
        }

        # Resume transaction
        $tx->resume;
    });

    $daemon->run;
}

# -------------------------------------------------------------------
main();