ua-parse.pl

#!/usr/bin/perl

# ------------------------------------------------------------------------
# Тестовое задание. Mojolicious:
# Напишите веб-приложение при запросе GET /user/info с "Accept: application/json" 
# отдающее json в формате { ip : "IP address", os : "Operation system", browser : "Browser name" }
# Без "Accept: application/json" отдающее html в формате:
# IP: IP address
# OS: Operation system
# Browser: Browser name
# Для определения ОС и браузера из хедера User-Agent используйте одну из библиотек с CPAN.
# ------------------------------------------------------------------------
use Modern::Perl;
use utf8;
use open qw/:std :utf8/;

use Const::Fast;
use HTML::ParseBrowser;
use HTTP::Status qw/:constants/;
use Mojo::JSON qw/encode_json/;
use Mojo::Server::Prefork;

const my $LISTEN   => ['http://127.0.0.1:9090'];
const my $CHILDREN => 10;
const my $APP_JSON => 'application/json';
const my $CHARSET  => ';charset=UTF-8';

my $daemon = _create_daemon();

$daemon->on
(
    request => sub 
    {
        my ( $parent, $tx ) = @_;
        my $path = $tx->req->url->path->to_string;
        if ( $path eq '/user/info' && $tx->req->method eq 'GET' ) {

            my ( $accept, $body ) = ( $tx->req->headers->accept );
            my $ua = HTML::ParseBrowser->new( $tx->req->headers->user_agent );

            if ( $accept && index( $accept, $APP_JSON ) != -1 ) {
                $body = encode_json {
                    IP      => $tx->remote_address,
                    OS      => $ua->os,
                    Browser => $ua->name,
                    Accept =>  $accept,
                };
                $tx->res->headers->content_type("$APP_JSON$CHARSET");
            }
            else {
                $body
                    = 'IP: ' . $tx->remote_address . "\nOS: " . $ua->os . "\nBrowser: " . $ua->name;
                $tx->res->headers->content_type("text/plain$CHARSET");
            }

            $tx->res->headers->content_length( length $body );
            $tx->res->body($body);
            $tx->res->code(HTTP_OK);
        }
        else {
            $tx->res->code(HTTP_NOT_FOUND);
        }
        $tx->resume;
    }
);

$daemon->run;

sub _create_daemon 
{
    my $daemon = Mojo::Server::Prefork->new( listen => $LISTEN );

    # Без особых изысков:
    $daemon->workers($CHILDREN);
    $daemon->silent(1);
    $daemon->accepts(0);
    $daemon->inactivity_timeout(0);

    return $daemon;
}