libdr-tarantool-perl 0.42-1ubuntu1 / usr / lib / perl5 / DR / Tarantool / RealSyncClient.pm

use utf8;
use strict;
use warnings;

package DR::Tarantool::RealSyncClient;


=head1 NAME

DR::Tarantool::RealSyncClient - a synchronous driver for L<Tarantool/Box|http://tarantool.org>

=head1 SYNOPSIS

    my $client = DR::Tarantool::RealSyncClient->connect(
        port    => $tnt->primary_port,
        spaces  => $spaces
    );

    if ($client->ping) { .. };

    my $t = $client->insert(
        first_space => [ 1, 'val', 2, 'test' ], TNT_FLAG_RETURN
    );

    $t = $client->call_lua('luafunc' =>  [ 0, 0, 1 ], 'space_name');

    $t = $client->select(space_name => $key);

    $t = $client->update(space_name => 2 => [ name => set => 'new' ]);

    $client->delete(space_name => $key);


=head1 DESCRIPTION

The module is a clone of L<DR::Tarantool::SyncClient> but it doesn't
use L<AnyEvent> or L<Coro>.

The module uses L<IO::Socket> sockets.

=head1 COPYRIGHT AND LICENSE

 Copyright (C) 2011 Dmitry E. Oboukhov <unera@debian.org>
 Copyright (C) 2011 Roman V. Nikolaev <rshadow@rambler.ru>

 This program is free software, you can redistribute it and/or
 modify it under the terms of the Artistic License.

=head1 VCS

The project is placed git repo on github:
L<|https://github.com/dr-co/dr-tarantool/>.

=cut

use DR::Tarantool::LLSyncClient;
use DR::Tarantool::Spaces;
use DR::Tarantool::Tuple;
use Carp;
$Carp::Internal{ (__PACKAGE__) }++;
use Data::Dumper;
use Scalar::Util 'blessed';

my $unpack = sub {
    my ($self, $res, $s) = @_;
    return undef unless $res and $res->{status} eq 'ok';
    return $s->tuple_class->unpack( $res->{tuples}, $s ) if $s;
    return $res->{tuples};
};

sub connect {
    my ($class, %opts) = @_;

    my $host = $opts{host} || 'localhost';
    my $port = $opts{port} or croak "port isn't defined";

    my $spaces = blessed($opts{spaces}) ?
        $opts{spaces} : DR::Tarantool::Spaces->new($opts{spaces});
    my $reconnect_period    = $opts{reconnect_period} || 0;
    my $reconnect_always    = $opts{reconnect_always} || 0;

    my $client = DR::Tarantool::LLSyncClient->connect(
        host                => $host,
        port                => $port,
        reconnect_period    => $reconnect_period,
        reconnect_always    => $reconnect_always,
        exists($opts{raise_error}) ?
            (   raise_error => $opts{raise_error} ?  1: 0 )
            : (),
    );


    return undef unless $client;
    return bless { llc => $client, spaces => $spaces } => ref($class) || $class;
}

sub space {
    my ($self, $name) = @_;
    return $self->{spaces}->space($name);
}


sub ping {
    my ($self) = @_;
    $self->{llc}->ping;
}

sub insert {
    my $self = shift;
    my $space = shift;
    $self->_llc->_check_tuple( my $tuple = shift );
    my $flags = pop || 0;

    my $s = $self->{spaces}->space($space);

    my $res =
        $self->_llc->insert( $s->number, $s->pack_tuple( $tuple ), $flags );
    return $unpack->($self, $res, $s);
}

sub call_lua {
    my $self = shift;
    my $lua_name = shift;
    my $args = shift;

    unshift @_ => 'space' if @_ == 1;
    my %opts = @_;

    my $flags = $opts{flags} || 0;
    my $space_name = $opts{space};
    my $fields = $opts{fields};

    my $s;
    croak "You can't use 'fields' and 'space' at the same time"
        if $fields and $space_name;

    if ($space_name) {
        $s = $self->space( $space_name );
    } elsif ( $fields ) {
        $s = DR::Tarantool::Space->new(
            0 =>
            {
                name    => 'temp_space',
                fields  => $fields,
                indexes => {}
            },
        );
    } else {
        $s = DR::Tarantool::Space->new(
            0 =>
            {
                name            => 'temp_space',
                fields          => [],
                indexes         => {}
            },
        );
    }

    if ($opts{args}) {
        my $sa = DR::Tarantool::Space->new(
            0 =>
            {
                name    => 'temp_space_args',
                fields  => $opts{args},
                indexes => {}
            },
        );
        $args = $sa->pack_tuple( $args );
    }

    my $res = $self->_llc->call_lua( $lua_name, $args, $flags );

    return $unpack->($self, $res, $s);
}


sub select {
    my $self = shift;
    my $space = shift;
    my $keys = shift;

    my ($index, $limit, $offset);

    if (@_ == 1) {
        $index = shift;
    } elsif (@_ == 3) {
        ($index, $limit, $offset) = @_;
    } elsif (@_) {
        my %opts = @_;
        $index = $opts{index};
        $limit = $opts{limit};
        $offset = $opts{offset};
    }

    $index ||= 0;

    my $s = $self->space($space);

    my $res = $self->_llc->select(
        $s->number,
        $s->_index( $index )->{no},
        $s->pack_keys( $keys, $index ),
        $limit,
        $offset
    );

    return $unpack->($self, $res, $s);
}

sub update {
    my $self = shift;
    my $space = shift;
    my $key = shift;
    my $op = shift;
    my $flags = shift || 0;

    my $s = $self->space($space);

    my $res = $self->_llc->update(
        $s->number,
        $s->pack_primary_key( $key ),
        $s->pack_operations( $op ),
        $flags,
    );
    return $unpack->($self, $res, $s);
}

sub delete :method {
    my $self = shift;
    my $space = shift;
    my $key = shift;
    my $flags = shift || 0;

    my $s = $self->space($space);

    my $res = $self->_llc->delete(
        $s->number,
        $s->pack_primary_key( $key ),
        $flags,
    );
    return $unpack->($self, $res, $s);
}

sub last_code { $_[0]->{llc}->last_code }
sub last_error_string { $_[0]->{llc}->last_error_string }
sub raise_error { $_[0]->raise_error };
sub _llc { $_[0]{llc} }

1;