The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

use warnings;
use strict;
use utf8;
use open qw(:std :utf8);
use lib qw(lib ../lib);
use lib qw(blib/lib blib/arch ../blib/lib ../blib/arch);

use constant PLAN       => 80;
use Test::More tests    => PLAN;
use Encode qw(decode encode);

my $LE = $] > 5.01 ? '<' : '';

BEGIN {
    # Подготовка объекта тестирования для работы с utf8
    my $builder = Test::More->builder;
    binmode $builder->output,         ":utf8";
    binmode $builder->failure_output, ":utf8";
    binmode $builder->todo_output,    ":utf8";

    use_ok 'DR::Tarantool::LLClient', 'tnt_connect';
    use_ok 'DR::Tarantool::StartTest';
    use_ok 'DR::Tarantool', ':constant';
    use_ok 'File::Spec::Functions', 'catfile';
    use_ok 'File::Basename', 'dirname', 'basename';
    use_ok 'AnyEvent';
    use_ok 'DR::Tarantool::AsyncClient';
}

my $cfg_dir = catfile dirname(__FILE__), 'test-data';
ok -d $cfg_dir, 'directory with test data';
my $tcfg = catfile $cfg_dir, 'llc-easy2.cfg';
ok -r $tcfg, $tcfg;

my $tnt = run DR::Tarantool::StartTest( cfg => $tcfg );

my $spaces = {
    0   => {
        name            => 'first_space',
        fields  => [
            {
                name    => 'id',
                type    => 'NUM',
            },
            {
                name    => 'name',
                type    => 'UTF8STR',
            },
            {
                name    => 'key',
                type    => 'NUM',
            },
            {
                name    => 'password',
                type    => 'STR',
            }
        ],
        indexes => {
            0   => 'id',
            1   => 'name',
            2   => { name => 'tidx', fields => [ 'key', 'password' ] },
        },
    }
};

SKIP: {
    unless ($tnt->started and !$ENV{SKIP_TNT}) {
        diag $tnt->log unless $ENV{SKIP_TNT};
        skip "tarantool isn't started", PLAN - 9;
    }

    my $client;

    # connect
    for my $cv (condvar AnyEvent) {
        DR::Tarantool::AsyncClient->connect(
            port                    => $tnt->primary_port,
            reconnect_period        => 0.1,
            spaces                  => $spaces,
            cb      => sub {
                $client = shift;
                $cv->send;
            }
        );

        $cv->recv;
    }
    unless ( isa_ok $client => 'DR::Tarantool::AsyncClient' ) {
        diag eval { decode utf8 => $client } || $client;
        last;
    }



    # ping
    for my $cv (condvar AnyEvent) {
        $client->ping(
            sub {
                my ($status) = @_;
                is $status, 'ok', '* ping';
                $cv->send;
            }
        );
        $cv->recv;
    }

    # insert
    for my $cv (condvar AnyEvent) {
        $cv->begin;
        $client->insert(
            'first_space',
            [
                10,
                'user',
                11,
                'password'
            ],
            TNT_FLAG_RETURN,
            sub {
                my ($status, $res) = @_;
                is $status, 'ok', '* insert status';
                is $res->id, 10, 'id';
                is $res->name, 'user', 'name';
                is $res->key, 11, 'key';
                is $res->password, 'password', 'password';
                $cv->end;
            }
        );

        $cv->begin;
        $client->insert(
            'first_space',
            [
                111,
                'user2',
                13,
                'password2'
            ],
            TNT_FLAG_RETURN,
            sub {
                my ($status, $res) = @_;
                is $status, 'ok', '* insert status';
                is $res->id, 111, 'id';
                is $res->name, 'user2', 'name';
                is $res->key, 13, 'key';
                is $res->password, 'password2', 'password';
                $cv->end;
            }
        );

        $cv->begin;
        $client->insert(
            'first_space',
            [
                10,
                'user',
                11,
                'password'
            ],
            TNT_FLAG_RETURN | TNT_FLAG_ADD,
            sub {
                my ($status, $code, $error) = @_;
                is $status, 'error', 'status';
                ok $code, 'code';
                like $error, qr{exists}, 'tuple already exists';
                $cv->end;
            }
        );
        $cv->recv;
    }

    # call lua
    for my $cv (condvar AnyEvent) {
        $cv->begin;
        $client->call_lua(
            'box.select' => [ 0, 0, 10 ],
            fields  => [
                { type => 'NUM', name => 'a' },
                'b',
                { type => 'NUM', name => 'c'},
                'd'
            ],
            args    => [ 's', 'i', { type => 'NUM' } ],
            sub {
                my ($status, $tuple) = @_;
                is $status, 'ok', '* call status';
                isa_ok $tuple => 'DR::Tarantool::Tuple', 'tuple packed';
                is $tuple->a, 10, 'id';
                is $tuple->b, 'user', 'name';
                is $tuple->c, 11, 'key';
                $cv->end;
            }
        );

        $cv->begin;
        $client->call_lua(
            'box.select' => [ 0, 0, 10 ],
            space => 'first_space',
            args    => [ 's', 'i', { type => 'NUM' } ],
            sub {
                my ($status, $tuple) = @_;
                is $status, 'ok', 'status';
                isa_ok $tuple => 'DR::Tarantool::Tuple', 'tuple packed';
                is $tuple->id, 10, 'id';
                is $tuple->name, 'user', 'name';
                is $tuple->key, 11, 'key';
                is $tuple->password, 'password', 'password';
                $cv->end;
            }
        );

        $cv->begin;
        $client->call_lua(
            'box.select' => [ 0, 0, 10 ],
            args    => [ 's', 'i', { type => 'NUM' } ],
            sub {
                my ($status, $tuple) = @_;
                is $status, 'ok', 'status';
                isa_ok $tuple => 'DR::Tarantool::Tuple', 'tuple packed';
                SKIP: {
                    skip 'there is no tuple', 4 unless $tuple;
                    is unpack("L$LE", $tuple->raw(0)), 10, 'id';
                    is $tuple->raw(1), 'user', 'name';
                    is unpack("L$LE", $tuple->raw(2)), 11, 'key';
                    is $tuple->raw(3), 'password', 'password';
                }
                $cv->end;
            }
        );

        $cv->begin;
        $client->call_lua(
            'box.select' => [ 0, 0, pack "L$LE" => 10 ],
            'first_space',
            sub {
                my ($status, $tuple) = @_;
                is $status, 'ok', 'status';
                isa_ok $tuple => 'DR::Tarantool::Tuple', 'tuple packed';
                is $tuple->id, 10, 'id';
                is $tuple->name, 'user', 'name';
                is $tuple->key, 11, 'key';
                is $tuple->password, 'password', 'password';
                $cv->end;
            }
        );

        $cv->begin;
        $client->call_lua(
            'box.select' => [ 0, 0, pack "L$LE" => 11 ],
            'first_space',
            sub {
                my ($status, $tuple) = @_;
                is $status, 'ok', 'status';
                is $tuple, undef, 'there is no tuple';
                $cv->end;
            }
        );

        $cv->begin;
        $client->call_lua(
            'unknown_function_name' => [ ],
            'first_space',
            sub {
                my ($status, $code, $errstr) = @_;
                is $status, 'error', 'status';
                cmp_ok $code, '>', 0, 'code';
                like $errstr, qr{Procedure .* is not defined}, 'errstr';
                $cv->end;
            }
        );

        $cv->recv;
    }

    # select
    for my $cv (condvar AnyEvent) {
        $cv->begin;
        $client->select(first_space => [[10], [11], [111]], 'i0', sub {
            my ($status, $tuple) = @_;
            is $status, 'ok', '* select status';
            my $iter = $tuple->iter;
            is $iter->count, 2, 'count of elements';
            is $tuple->id, 10, 'tuple(0)->id';
            is $iter->next->id, 10, 'tuple(0)->id';
            is $tuple->next->id, 111, 'tuple(1}->id';
            is $iter->next->id, 111, 'tuple(1)->id';

            $cv->end;
        });

        $cv->begin;
        $client->select(
            first_space => [[10], [11], [111]],
            limit   => 1,
            index   => 'i0',
            sub {
                my ($status, $tuple) = @_;
                is $status, 'ok', 'select (limit) status';
                my $iter = $tuple->iter;
                is $iter->count, 1, 'count of elements';
                is $tuple->id, 10, 'tuple(0)->id';
                is $iter->next->id, 10, 'tuple(0)->id';

                $cv->end;
            }
        );

        $cv->begin;
        $client->select(
            first_space => [[10], [11], [111]],
            limit   => 1,
            offset  => 1,
            index   => 'i0',
            sub {
                my ($status, $tuple) = @_;
                is $status, 'ok', 'select (limit) status';
                my $iter = $tuple->iter;
                is $iter->count, 1, 'count of elements';
                is $tuple->id, 111, 'tuple(0)->id';
                is $iter->next->id, 111, 'tuple(0)->id';

                $cv->end;
            }
        );

        $cv->begin;
        $client->select(first_space => [[11, 'password']], 'tidx', sub {
            my ($status, $tuple) = @_;
            is $status, 'ok', 'select status (not primary index)';
            my $iter = $tuple->iter;
            is $iter->count, 1, 'count of elements';
            is $tuple->id, 10, 'tuple(0)->id';
            $cv->end;
        });

        $cv->recv;
    }


    # delete
    for my $cv (condvar AnyEvent) {
        $cv->begin;
        $client->delete(first_space => 10, sub {
            my ($status, $tuple) = @_;
            is $status, 'ok', '* delete status';
            $cv->end;
        });

        $cv->begin;
        $client->select(first_space => 10, sub {
            my ($status, $tuple) = @_;
            is $status, 'ok', 'select deleted status';
            is $tuple, undef, 'there is no tuple';
            $cv->end;
        });

        $cv->recv;
    }

    # update
    for my $cv (condvar AnyEvent) {
        $cv->begin;
        $client->update(first_space => 111, [ name => set => 'привет1' ], sub {
            my ($status, $tuple) = @_;
            is $status, 'ok', '* update status';
            is $tuple, undef, 'tuple';
            $cv->end;
        });

        $cv->begin;
        $client->update(first_space =>
                        111, [ name => set => 'привет' ], TNT_FLAG_RETURN, sub {
            my ($status, $tuple) = @_;
            is $status, 'ok', '* update status';
            isa_ok $tuple => 'DR::Tarantool::Tuple', 'tuple was selected';
            is $tuple->name, 'привет', 'field was updated';
            $cv->end;
        });

        $cv->begin;
        $client->select(first_space => 111, sub {
            my ($status, $tuple) = @_;
            is $status, 'ok', 'select deleted status';
            isa_ok $tuple => 'DR::Tarantool::Tuple', 'tuple was selected';
            is $tuple->name, 'привет', 'field was updated';
            $cv->end;
        });

        $cv->recv;
    }
}