Использование фреймворка Mojolicious для Perl при создании API

cpan Mojolicious

cpanm Mojolicious

mojo generate app APIApp
cd apiapp

cpan DBI DBD::mysql Digest::SHA

{
    # Настройки Mojolicious
    hypnotoad => {
        listen  => ['http://*:3000'],
        workers => 4,
    },
   
    # Настройки базы данных
    database => {
        driver   => 'mysql',
        database => 'api_app_db',
        host     => 'localhost',
        port     => 3306,
        user     => 'root',
        password => '',
        options  => {
            mysql_enable_utf8 => 1,
            RaiseError        => 1,
            AutoCommit        => 1,
        }
    },
   
    # Настройки приложения
    app_name => 'APIApp',
    secret   => 'your-secret-key-change-this-in-production',
}

#!/usr/bin/env perl

use strict;
use warnings;

use FindBin;
BEGIN { unshift @INC, "$FindBin::Bin/../lib" }

use APIApp;

# Запуск приложения
my $app = APIApp->new;
$app->start;

package APIApp;
use Mojo::Base 'Mojolicious';

use DBI;

sub startup {
    my $self = shift;
   
    # Чтение конфигурации
    $self->plugin('Config');
   
    # Подключение к базе данным
    $self->helper(db => sub {
        my $c = shift;
        my $config = $c->app->config->{database};
       
        state $dbh = DBI->connect(
            "DBI:$config->{driver}:database=$config->{database};host=$config->{host};port=$config->{port}",
            $config->{user},
            $config->{password},
            $config->{options}
        ) or die "Could not connect to database: $DBI::errstr";
       
        return $dbh;
    });
   
    # Хелперы для моделей
    $self->helper(users => sub {
        my $c = shift;
        require APIApp::Model::User;
        state $model = APIApp::Model::User->new(dbh => $c->db);
        return $model;
    });
   
    $self->helper(articles => sub {
        my $c = shift;
        require APIApp::Model::Article;
        state $model = APIApp::Model::Article->new(dbh => $c->db);
        return $model;
    });
   
    # Настройка маршрутов
    my $r = $self->routes;
   
    # Health check
    $r->get('/')->to(cb => sub {
        my $c = shift;
        $c->render(json => {
            app     => 'APIApp',
            version => '1.0',
            status  => 'running',
            time    => scalar localtime
        });
    });
   
    # API маршруты
    my $api = $r->under('/api/v1');
   
    # Пользователи
    $api->get('/users')->to('users#list');
    $api->get('/users/:id')->to('users#show');
    $api->post('/users')->to('users#create');
    $api->put('/users/:id')->to('users#update');
    $api->delete('/users/:id')->to('users#delete');
   
    # Статьи
    $api->get('/articles')->to('articles#list');
    $api->get('/articles/:id')->to('articles#show');
    $api->post('/articles')->to('articles#create');
    $api->put('/articles/:id')->to('articles#update');
    $api->delete('/articles/:id')->to('articles#delete');
   
    # Статьи пользователя
    $api->get('/users/:user_id/articles')->to('articles#list_by_user');
   
    # Статьи по статусу
    $api->get('/articles/status/:status')->to('articles#list_by_status');
   
    # Хелпер для JSON ответов
    $self->helper(json_response => sub {
        my ($c, $success, $data, $error, $status) = @_;
        $status ||= $success ? 200 : 400;
       
        my $response = { success => $success };
        $response->{data} = $data if defined $data;
        $response->{error} = $error if defined $error;
       
        $c->render(json => $response, status => $status);
    });
}

1;

#!/usr/bin/env perl

use strict;
use warnings;
use utf8;
use open qw(:utf8 :std);
use FindBin;
use lib "$FindBin::Bin/../lib";

# Загружаем Mojolicious и Config
use Mojolicious::Commands;
use Mojolicious;

# Создаем приложение Mojolicious
my $app = Mojolicious->new;

# Устанавливаем путь к конфигурационному файлу
$app->config(hypnotoad => {});

# Загружаем конфигурацию
my $config_file = "$FindBin::Bin/../a_p_i_app.conf";
$app->plugin('Config' => {file => $config_file});

# Получаем конфигурацию БД
my $db_config = $app->config('database') || {};

# Настройки базы данных
my %db_config = (
    host     => $db_config->{host} || 'localhost',
    port     => $db_config->{port} || 3306,
    user     => $db_config->{user} || 'root',
    password => $db_config->{password} || '',
    database => $db_config->{database} || 'api_app_db'
);

# Обработка аргументов командной строки
my $seed_data = 0;
foreach my $arg (@ARGV) {
    if ($arg eq '--seed') {
        $seed_data = 1;
    }
    elsif ($arg eq '--help') {
        usage();
        exit 0;
    }
}

# Подключаем DBI
use DBI;

# Подключение к MySQL
my $dbh = DBI->connect(
    "DBI:mysql:host=$db_config{host};port=$db_config{port}",
    $db_config{user},
    $db_config{password},
    {
        RaiseError => 1,
        PrintError => 0,
        mysql_enable_utf8 => 1,
    }
) or die "Cannot connect to MySQL: $DBI::errstr";
print "=" x 60 . "\n";
print "API App Database Setup\n";
print "Config file: $config_file\n";
print "=" x 60 . "\n\n";
print "Creating database '$db_config{database}'...\n";

# Создание базы данных
$dbh->do("CREATE DATABASE IF NOT EXISTS $db_config{database} CHARACTER SET utf8mb4 COLLATE utf8mb4_unicode_ci");
$dbh->do("USE $db_config{database}");

# Таблица пользователей
print "Creating 'users' table...\n";
$dbh->do("
    CREATE TABLE IF NOT EXISTS users (
        id INT AUTO_INCREMENT PRIMARY KEY,
        username VARCHAR(50) UNIQUE NOT NULL,
        email VARCHAR(100) UNIQUE NOT NULL,
        password VARCHAR(255) NOT NULL,
        full_name VARCHAR(100),
        created_at TIMESTAMP DEFAULT CURRENT_TIMESTAMP,
        updated_at TIMESTAMP DEFAULT CURRENT_TIMESTAMP ON UPDATE CURRENT_TIMESTAMP,
        INDEX idx_username (username),
        INDEX idx_email (email)
    ) ENGINE=InnoDB DEFAULT CHARSET=utf8mb4 COLLATE=utf8mb4_unicode_ci
");

# Таблица статей
print "Creating 'articles' table...\n";
$dbh->do("
    CREATE TABLE IF NOT EXISTS articles (
        id INT AUTO_INCREMENT PRIMARY KEY,
        user_id INT NOT NULL,
        title VARCHAR(255) NOT NULL,
        slug VARCHAR(255),
        content TEXT NOT NULL,
        excerpt VARCHAR(500),
        status ENUM('draft', 'published', 'archived') DEFAULT 'draft',
        created_at TIMESTAMP DEFAULT CURRENT_TIMESTAMP,
        updated_at TIMESTAMP DEFAULT CURRENT_TIMESTAMP ON UPDATE CURRENT_TIMESTAMP,
        published_at TIMESTAMP NULL,
        FOREIGN KEY (user_id) REFERENCES users(id) ON DELETE CASCADE,
        INDEX idx_user_id (user_id),
        INDEX idx_status (status),
        INDEX idx_slug (slug),
        INDEX idx_published_at (published_at)
    ) ENGINE=InnoDB DEFAULT CHARSET=utf8mb4 COLLATE=utf8mb4_unicode_ci
");

# Создание индексов с проверкой существования
print "\nCreating indexes...\n";
create_index_if_not_exists($dbh, 'articles', 'idx_articles_title', 'title(100)');
create_index_if_not_exists($dbh, 'users', 'idx_users_created_at', 'created_at');

# Создание тестовых данных
if ($seed_data) {
    print "\n" . "=" x 60 . "\n";
    print "Seeding with test data...\n";
    print "=" x 60 . "\n";
   
    seed_test_data($dbh, $db_config{database});
}
print "\n" . "=" x 60 . "\n";
print "Database setup completed successfully!\n";
print "Database: $db_config{database}\n";
print "Host: $db_config{host}:$db_config{port}\n";
print "=" x 60 . "\n";
$dbh->disconnect;

# Функция для создания индекса только если он не существует
sub create_index_if_not_exists {
    my ($dbh, $table, $index_name, $columns) = @_;
   
    my $sth = $dbh->prepare("
        SELECT COUNT(1)
        FROM INFORMATION_SCHEMA.STATISTICS
        WHERE table_schema = DATABASE()
          AND table_name = ?
          AND index_name = ?
    ");
    $sth->execute($table, $index_name);
   
    if ($sth->fetchrow_array() == 0) {
        eval {
            $dbh->do("CREATE INDEX $index_name ON $table($columns)");
            print "  Created index $index_name on $table\n";
        };
        if ($@) {
            warn "  Failed to create index $index_name: $@\n";
        }
    } else {
        print "  Index $index_name already exists on $table\n";
    }
}

# Функция для заполнения тестовыми данными
sub seed_test_data {
    my ($dbh, $database) = @_;
   
    # Используем указанную базу данных
    $dbh->do("USE $database");
     # Устанавливаем кодировку соединения
    $dbh->do("SET NAMES utf8mb4");
   
    # Список тестовых пользователей
    my @test_users = (
        {
            username => 'admin',
            email    => 'admin@example.ru',
            password => 'admin123',
            full_name => 'Administrator'
        },
        {
            username => 'eugene_starodubtsev',
            email    => 'eugene@example.ru',
            password => 'password123',
            full_name => 'Eugene Starodubtsev'
        },
        {
            username => 'julia_ivanova',
            email    => 'julia@example.ru',
            password => 'password123',
            full_name => 'Juila Ivanova'
        }
    );
   
    # Вставляем пользователей
    foreach my $user (@test_users) {
        my $sth = $dbh->prepare("SELECT id FROM users WHERE username = ? OR email = ?");
        $sth->execute($user->{username}, $user->{email});
       
        if (my $existing_id = $sth->fetchrow_array()) {
            print "  User '$user->{username}' already exists (ID: $existing_id)\n";
            $user->{id} = $existing_id;
        } else {
            $dbh->do("
                INSERT INTO users (username, email, password, full_name)
                VALUES (?, ?, SHA2(?, 256), ?)
            ", undef,
                $user->{username},
                $user->{email},
                $user->{password},
                $user->{full_name});
           
            $user->{id} = $dbh->last_insert_id(undef, undef, undef, undef);
            print "  Created user '$user->{username}' (ID: $user->{id})\n";
        }
    }
   
    # Тестовые статьи для каждого пользователя
    my @articles = (
        {
            title => 'Начало работы с Perl',
            slug  => 'getting-started-with-perl',
            content => 'Perl — мощный язык программирования...',
            excerpt => 'Изучите основы программирования на Perl',
            status => 'published'
        },
        {
            title => 'Веб-фреймворк Mojolicious',
            slug  => 'mojolicious-web-framework',
            content => 'Mojolicious — веб-фреймворк реального времени...',
            excerpt => 'Введение в фреймворк Mojolicious',
            status => 'published'
        },
        {
            title => 'Лучшие практики MySQL',
            slug  => 'mysql-best-practices',
            content => 'MySQL — популярная реляционная база данных...',
            excerpt => 'Советы для оптимизация производительности MySQL',
            status => 'published'
        },
        {
            title => 'Принципы проектирования API',
            slug  => 'api-design-principles',
            content => 'Хороший дизайн API имеет решающее значение для успеха...',
            excerpt => 'Ключевые принципы проектирования RESTful API',
            status => 'draft'
        },
        {
            title => 'Docker для разработки',
            slug  => 'docker-for-development',
            content => 'Docker упрощает рабочие процессы разработки...',
            excerpt => 'Использование Docker в вашей среде разработки',
            status => 'published'
        }
    );
   
    # Вставляем статьи
    my $article_count = 0;
    foreach my $user (@test_users) {
        foreach my $article (@articles) {
            my $sth = $dbh->prepare("SELECT id FROM articles WHERE slug = ?");
            $sth->execute($article->{slug});
           
            if (!$sth->fetchrow_array()) {
                $dbh->do("
                    INSERT INTO articles (user_id, title, slug, content, excerpt, status, published_at)
                    VALUES (?, ?, ?, ?, ?, ?,
                        CASE WHEN ? = 'published' THEN NOW() ELSE NULL END)
                ", undef,
                    $user->{id},
                    $article->{title},
                    $article->{slug},
                    $article->{content},
                    $article->{excerpt},
                    $article->{status},
                    $article->{status});
               
                $article_count++;
            }
        }
    }
   
    print "\n  Created $article_count test articles\n";
   
    # Показать статистику
    print "\nDatabase Statistics:\n";
    print "  " . "-" x 40 . "\n";
   
    my $sth = $dbh->prepare("SELECT COUNT(*) FROM users");
    $sth->execute();
    print "  Users: " . $sth->fetchrow_array() . "\n";
   
    $sth = $dbh->prepare("SELECT COUNT(*) FROM articles");
    $sth->execute();
    print "  Articles: " . $sth->fetchrow_array() . "\n";
   
    $sth = $dbh->prepare("SELECT COUNT(*) FROM articles WHERE status = 'published'");
    $sth->execute();
    print "  Published articles: " . $sth->fetchrow_array() . "\n";
}

sub usage {
    print <<"END_USAGE";
Usage: $0 [options]
Options:
    --seed    Seed database with test data
    --help    Show this help message
Examples:
    $0                    # Create database structure only
    $0 --seed            # Create database with test data
Configuration:
    The script reads configuration from a_p_i_app.conf
    Expected structure:
    {
        "database": {
            "host": "localhost",
            "port": 3306,
            "user": "root",
            "password": "your_password",
            "database": "api_app_db"
        }
    }
END_USAGE
    exit;
}
 

#!/usr/bin/env perl

use strict;
use warnings;
use DBI;
use FindBin;
use lib "$FindBin::Bin/../lib";

# Используем Mojolicious для чтения конфига
use Mojolicious;
my $app = Mojolicious->new;

# Устанавливаем путь к конфигурационному файлу
$app->config(hypnotoad => {});

# Загружаем конфигурацию
my $config_file = "$FindBin::Bin/../a_p_i_app.conf";
$app->plugin('Config' => {file => $config_file});

# Получаем конфигурацию БД
my $db_config = $app->config('database') || {};

# Настройки базы данных
my $host = $db_config->{host} || 'localhost';
my $port = $db_config->{port} || 3306;
my $user = $db_config->{user} || 'root';
my $password = $db_config->{password} || '';
my $database = $db_config->{database} || 'api_app_db';
print "=" x 60 . "\n";
print "Database Drop Script\n";
print "Config file: a_p_i_app.conf\n";
print "=" x 60 . "\n\n";
print "Database to drop: $database\n";
print "Host: $host:$port\n";
print "User: $user\n\n";

# Запрос подтверждения
print "WARNING: This will permanently delete database '$database'!\n";
print "Are you sure you want to continue? (yes/no): ";
my $response = <STDIN>;
chomp $response;
unless ($response =~ /^yes$/i) {
    print "Operation cancelled.\n";
    exit 0;
}

# Подключение
my $dbh = eval {
    DBI->connect(
        "DBI:mysql:host=$host;port=$port",
        $user,
        $password,
        { RaiseError => 1, PrintError => 0 }
    );
};
if (!$dbh) {
    die "Cannot connect to MySQL: $DBI::errstr\n";
}

# Дополнительная проверка - список баз данных
my $sth = $dbh->prepare("SHOW DATABASES LIKE ?");
$sth->execute($database);
if (!$sth->fetchrow_array()) {
    print "Database '$database' does not exist.\n";
    $dbh->disconnect;
    exit 0;
}

# Удаление базы данных
print "\nDropping database '$database'...\n";
eval {
    $dbh->do("DROP DATABASE IF EXISTS $database");
};
if ($@) {
    print "Error dropping database: $@\n";
    $dbh->disconnect;
    exit 1;
}
print " Database '$database' dropped successfully!\n";

# Проверяем, что база действительно удалена
$sth = $dbh->prepare("SHOW DATABASES LIKE ?");
$sth->execute($database);
if (!$sth->fetchrow_array()) {
    print " Confirmed: database '$database' no longer exists.\n";
} else {
    print " Warning: database '$database' might still exist.\n";
}
$dbh->disconnect;
print "\n" . "=" x 60 . "\n";
print "Operation completed.\n";
print "=" x 60 . "\n";

perl script/create_database.pl

perl script/create_database.pl --seed

perl script/drop_database.pl

package APIApp::Model::User;
use Mojo::Base -base;

has 'dbh';

# Найти по ID
sub find {
    my ($self, $id) = @_;
    my $sth = $self->dbh->prepare("SELECT * FROM users WHERE id = ?");
    $sth->execute($id);
    return $sth->fetchrow_hashref;
}

# Найти по имени пользователя
sub find_by_username {
    my ($self, $username) = @_;
    my $sth = $self->dbh->prepare("SELECT * FROM users WHERE username = ?");
    $sth->execute($username);
    return $sth->fetchrow_hashref;
}

# Найти по email
sub find_by_email {
    my ($self, $email) = @_;
    my $sth = $self->dbh->prepare("SELECT * FROM users WHERE email = ?");
    $sth->execute($email);
    return $sth->fetchrow_hashref;
}

# Создать пользователя
sub create {
    my ($self, $data) = @_;
   
    # Хеширование пароля
    require Digest::SHA;
    $data->{password} = Digest::SHA::sha256_hex($data->{password});
   
    my $sql = "INSERT INTO users (username, email, password, full_name) VALUES (?, ?, ?, ?)";
    my $sth = $self->dbh->prepare($sql);
    $sth->execute($data->{username}, $data->{email}, $data->{password}, $data->{full_name});
   
    return $self->find($self->dbh->last_insert_id(undef, undef, undef, undef));
}

# Обновить пользователя
sub update {
    my ($self, $id, $data) = @_;
   
    my @fields;
    my @values;
   
    # Хеширование пароля если он предоставлен
    if ($data->{password}) {
        require Digest::SHA;
        $data->{password} = Digest::SHA::sha256_hex($data->{password});
    }
   
    for my $field (qw(username email password full_name)) {
        if (exists $data->{$field}) {
            push @fields, "$field = ?";
            push @values, $data->{$field};
        }
    }
   
    return unless @fields;
   
    push @values, $id;
    my $sql = "UPDATE users SET " . join(', ', @fields) . " WHERE id = ?";
    $self->dbh->prepare($sql)->execute(@values);
   
    return $self->find($id);
}

# Удалить пользователя
sub delete {
    my ($self, $id) = @_;
    my $sth = $self->dbh->prepare("DELETE FROM users WHERE id = ?");
    return $sth->execute($id);
}

# Все пользователи
sub all {
    my $self = shift;
    my $sth = $self->dbh->prepare("
        SELECT id, username, email, full_name, created_at
        FROM users
        ORDER BY id
    ");
    $sth->execute();
    return $sth->fetchall_arrayref({});
}

1;

package APIApp::Model::Article;
use Mojo::Base -base;

has 'dbh';

# Найти по ID
sub find {
    my ($self, $id) = @_;
    my $sth = $self->dbh->prepare("
        SELECT a.*, u.username, u.email
        FROM articles a
        LEFT JOIN users u ON a.user_id = u.id
        WHERE a.id = ?
    ");
    $sth->execute($id);
    return $sth->fetchrow_hashref;
}

# Создать статью
sub create {
    my ($self, $data) = @_;
   
    my $sql = "INSERT INTO articles (user_id, title, content, status) VALUES (?, ?, ?, ?)";
    my $sth = $self->dbh->prepare($sql);
    $sth->execute(
        $data->{user_id},
        $data->{title},
        $data->{content},
        $data->{status} || 'draft'
    );
   
    return $self->find($self->dbh->last_insert_id(undef, undef, undef, undef));
}

# Обновить статью
sub update {
    my ($self, $id, $data) = @_;
   
    my @fields;
    my @values;
   
    for my $field (qw(title content status)) {
        if (exists $data->{$field}) {
            push @fields, "$field = ?";
            push @values, $data->{$field};
        }
    }
   
    return unless @fields;
   
    push @values, $id;
    my $sql = "UPDATE articles SET " . join(', ', @fields) . " WHERE id = ?";
    $self->dbh->prepare($sql)->execute(@values);
   
    return $self->find($id);
}

# Удалить статью
sub delete {
    my ($self, $id) = @_;
    my $sth = $self->dbh->prepare("DELETE FROM articles WHERE id = ?");
    return $sth->execute($id);
}

# Все статьи
sub all {
    my $self = shift;
    my $sth = $self->dbh->prepare("
        SELECT a.*, u.username
        FROM articles a
        LEFT JOIN users u ON a.user_id = u.id
        ORDER BY a.created_at DESC
    ");
    $sth->execute();
    return $sth->fetchall_arrayref({});
}

# Статьи пользователя
sub by_user {
    my ($self, $user_id) = @_;
    my $sth = $self->dbh->prepare("
        SELECT a.*, u.username
        FROM articles a
        LEFT JOIN users u ON a.user_id = u.id
        WHERE a.user_id = ?
        ORDER BY a.created_at DESC
    ");
    $sth->execute($user_id);
    return $sth->fetchall_arrayref({});
}

# Статьи с фильтрацией по статусу
sub by_status {
    my ($self, $status) = @_;
    my $sth = $self->dbh->prepare("
        SELECT a.*, u.username
        FROM articles a
        LEFT JOIN users u ON a.user_id = u.id
        WHERE a.status = ?
        ORDER BY a.created_at DESC
    ");
    $sth->execute($status);
    return $sth->fetchall_arrayref({});
}

# Поиск с пагинацией
sub search {
    my ($self, $page, $per_page) = @_;
    $page ||= 1;
    $per_page ||= 20;
    my $offset = ($page - 1) * $per_page;
   
    my $sth = $self->dbh->prepare("
        SELECT a.*, u.username
        FROM articles a
        LEFT JOIN users u ON a.user_id = u.id
        ORDER BY a.created_at DESC
        LIMIT ? OFFSET ?
    ");
    $sth->execute($per_page, $offset);
    return $sth->fetchall_arrayref({});
}

# Подсчет статей пользователя
sub count_by_user {
    my ($self, $user_id) = @_;
    my $sth = $self->dbh->prepare("
        SELECT COUNT(*) as count
        FROM articles
        WHERE user_id = ?
    ");
    $sth->execute($user_id);
    my $result = $sth->fetchrow_hashref;
    return $result->{count};
}

1;

package APIApp::Controller::Users;
use Mojo::Base 'Mojolicious::Controller';

sub list {
    my $c = shift;
   
    my $users = $c->users->all();
   
    $c->json_response(1, $users);
}

sub show {
    my $c = shift;
    my $id = $c->param('id');
   
    my $user = $c->users->find($id);
   
    if ($user) {
        delete $user->{password}; # Не показываем пароль
        $c->json_response(1, $user);
    } else {
        $c->json_response(0, undef, 'User not found', 404);
    }
}

sub create {
    my $c = shift;
    my $data = $c->req->json;
   
    # Валидация
    unless ($data && $data->{username} && $data->{email} && $data->{password}) {
        return $c->json_response(0, undef, 'Missing required fields: username, email, password');
    }
   
    # Проверка уникальности имени пользователя
    if ($c->users->find_by_username($data->{username})) {
        return $c->json_response(0, undef, 'Username already exists', 409);
    }
   
    # Проверка уникальности email
    if ($c->users->find_by_email($data->{email})) {
        return $c->json_response(0, undef, 'Email already exists', 409);
    }
   
    # Создаем пользователя
    my $user = $c->users->create($data);
   
    if ($user) {
        delete $user->{password};
        $c->json_response(1, $user, undef, 201);
    } else {
        $c->json_response(0, undef, 'Failed to create user', 500);
    }
}

sub update {
    my $c = shift;
    my $id = $c->param('id');
    my $data = $c->req->json;
   
    unless ($data && %$data) {
        return $c->json_response(0, undef, 'No data provided for update');
    }
   
    # Проверяем существование пользователя
    my $existing_user = $c->users->find($id);
    unless ($existing_user) {
        return $c->json_response(0, undef, 'User not found', 404);
    }
   
    # Проверка уникальности username, если он меняется
    if ($data->{username} && $data->{username} ne $existing_user->{username}) {
        if ($c->users->find_by_username($data->{username})) {
            return $c->json_response(0, undef, 'Username already exists', 409);
        }
    }
   
    # Проверка уникальности email, если он меняется
    if ($data->{email} && $data->{email} ne $existing_user->{email}) {
        if ($c->users->find_by_email($data->{email})) {
            return $c->json_response(0, undef, 'Email already exists', 409);
        }
    }
   
    my $user = $c->users->update($id, $data);
   
    if ($user) {
        delete $user->{password};
        $c->json_response(1, $user);
    } else {
        $c->json_response(0, undef, 'Failed to update user', 500);
    }
}

sub delete {
    my $c = shift;
    my $id = $c->param('id');
   
    # Проверяем существование пользователя
    unless ($c->users->find($id)) {
        return $c->json_response(0, undef, 'User not found', 404);
    }
   
    if ($c->users->delete($id)) {
        $c->json_response(1, {message => 'User deleted successfully'});
    } else {
        $c->json_response(0, undef, 'Failed to delete user', 500);
    }
}

1;

package APIApp::Controller::Articles;
use Mojo::Base 'Mojolicious::Controller';

sub list {
    my $c = shift;
    my $articles = $c->articles->all();
    $c->json_response(1, $articles);
}

sub show {
    my $c = shift;
    my $id = $c->param('id');
    my $article = $c->articles->find($id);
   
    if ($article) {
        $c->json_response(1, $article);
    } else {
        $c->json_response(0, undef, 'Article not found', 404);
    }
}

sub create {
    my $c = shift;
    my $data = $c->req->json;
   
    unless ($data && $data->{user_id} && $data->{title} && $data->{content}) {
        return $c->json_response(0, undef, 'Missing required fields: user_id, title, content');
    }
   
    # Проверяем существование пользователя
    unless ($c->users->find($data->{user_id})) {
        return $c->json_response(0, undef, 'User not found', 404);
    }
   
    my $article = $c->articles->create($data);
   
    if ($article) {
        $c->json_response(1, $article, undef, 201);
    } else {
        $c->json_response(0, undef, 'Failed to create article', 500);
    }
}

sub update {
    my $c = shift;
    my $id = $c->param('id');
    my $data = $c->req->json;
   
    unless ($data && %$data) {
        return $c->json_response(0, undef, 'No data provided');
    }
   
    # Проверяем существование статьи
    unless ($c->articles->find($id)) {
        return $c->json_response(0, undef, 'Article not found', 404);
    }
   
    my $article = $c->articles->update($id, $data);
   
    if ($article) {
        $c->json_response(1, $article);
    } else {
        $c->json_response(0, undef, 'Failed to update article', 500);
    }
}

sub delete {
    my $c = shift;
    my $id = $c->param('id');
   
    # Проверяем существование статьи
    unless ($c->articles->find($id)) {
        return $c->json_response(0, undef, 'Article not found', 404);
    }
   
    if ($c->articles->delete($id)) {
        $c->json_response(1, {message => 'Article deleted successfully'});
    } else {
        $c->json_response(0, undef, 'Failed to delete article', 500);
    }
}

sub list_by_user {
    my $c = shift;
    my $user_id = $c->param('user_id');
   
    # Проверяем существование пользователя
    unless ($c->users->find($user_id)) {
        return $c->json_response(0, undef, 'User not found', 404);
    }
   
    my $articles = $c->articles->by_user($user_id);
    $c->json_response(1, $articles);
}

sub list_by_status {
    my $c = shift;
    my $status = $c->param('status');
   
    # Валидация статуса
    my @valid_statuses = qw(draft published archived);
    unless (grep { $_ eq $status } @valid_statuses) {
        return $c->json_response(0, undef, 'Invalid status. Valid values: draft, published, archived', 400);
    }
   
    my $articles = $c->articles->by_status($status);
    $c->json_response(1, $articles);
}

1;

morbo script/apiapp

perl script/apiapp daemon -l http://*:3000

perl script/apiapp daemon -l https://*:443 --cert /path/to/cert

hypnotoad script/apiapp

curl http://localhost:3000/

curl -X POST http://localhost:3000/api/v1/users \
  -H "Content-Type: application/json" \
  -d '{"username":"testuser","email":"test@example.com","password":"test123","full_name":"Test User"}'

curl http://localhost:3000/api/v1/users

curl -X POST http://localhost:3000/api/v1/articles \
  -H "Content-Type: application/json" \
  -d '{"user_id":1,"title":"Первая статья про Perl","content":"Это моя самая первая статья про Perl","status":"published"}'

curl http://localhost:3000/api/v1/users/1/articles

curl -X DELETE http://localhost:3000/api/v1/articles/1 \
  -H "Content-Type: application/json"

curl -X PUT http://localhost:3000/api/v1/users/1 \
  -H "Content-Type: application/json" \
  -d '{"full_name":"Updated Name","email":"updated@example.com"}'