File Coverage

blib/lib/DR/Tarantool/SyncClient.pm
Criterion Covered Total %
statement 24 59 40.6
branch 0 20 0.0
condition n/a
subroutine 8 14 57.1
pod 1 1 100.0
total 33 94 35.1


line stmt bran cond sub pod time code
1 3     3   8991 use utf8;
  3         8  
  3         23  
2 3     3   81 use strict;
  3         5  
  3         113  
3 3     3   15 use warnings;
  3         5  
  3         133  
4              
5             package DR::Tarantool::SyncClient;
6 3     3   16 use base 'DR::Tarantool::AsyncClient';
  3         6  
  3         1300  
7 3     3   21 use AnyEvent;
  3         7  
  3         67  
8 3     3   16 use Devel::GlobalDestruction;
  3         6  
  3         34  
9 3     3   334 use Carp;
  3         7  
  3         933  
10             $Carp::Internal{ (__PACKAGE__) }++;
11              
12             =head1 NAME
13              
14             DR::Tarantool::SyncClient - a synchronous driver for
15             L<Tarantool|http://tarantool.org>.
16              
17             =head1 SYNOPSIS
18              
19             my $client = DR::Tarantool::SyncClient->connect(
20             port => $tnt->primary_port,
21             spaces => $spaces
22             );
23              
24             if ($client->ping) { .. };
25              
26             my $t = $client->insert(
27             first_space => [ 1, 'val', 2, 'test' ], TNT_FLAG_RETURN
28             );
29              
30             $t = $client->call_lua('luafunc' => [ 0, 0, 1 ], 'space_name');
31              
32             $t = $client->select(space_name => $key);
33              
34             $t = $client->update(space_name => 2 => [ name => set => 'new' ]);
35              
36             $client->delete(space_name => $key);
37              
38              
39             =head1 METHODS
40              
41             =head2 connect
42              
43             Connects to the server.
44              
45             =head3 Arguments
46              
47             The same as L<DR::Tarantool::AsyncClient/connect>, excluding the callback.
48              
49             Returns a connection handle or croaks an error.
50              
51             =head3 Additional arguments
52              
53             =over
54              
55             =item raise_error
56              
57             If B<true> (default behaviour) the driver throws an exception for each
58             error.
59              
60             =back
61              
62             =cut
63              
64             sub connect {
65 0     0 1   my ($class, %opts) = @_;
66              
67 0           my $raise_error = 1;
68 0 0         $raise_error = delete $opts{raise_error} if exists $opts{raise_error};
69              
70 0           my $cv = condvar AnyEvent;
71 0           my $self;
72              
73             $class->SUPER::connect(%opts, sub {
74 0     0     ($self) = @_;
75 0           $cv->send;
76 0           });
77              
78 0           $cv->recv;
79              
80              
81 0 0         unless(ref $self) {
82 0 0         croak $self if $raise_error;
83 0           $! = $self;
84 0           return undef;
85             }
86              
87 0 0         $self->{raise_error} = $raise_error ? 1 : 0;
88 0           $self;
89             }
90              
91             =head2 ping
92              
93             The same as L<DR::Tarantool::AsyncClient/ping>, excluding the callback.
94              
95             Returns B<true> on success, b<false> in case of an error.
96              
97             =head2 insert
98              
99             The same as L<DR::Tarantool::AsyncClient/insert>, excluding the callback.
100              
101             Returns the inserted tuple.
102             Croaks error if an error occurred (as long as B<raise_error> is true).
103              
104             =head2 select
105              
106             The same as L<DR::Tarantool::AsyncClient/select>, excluding the callback.
107              
108             Returns tuples contained in the server response or undef.
109             Croaks error if an error occurred (as long as B<raise_error> is true).
110              
111             =head2 update
112              
113             The same as L<DR::Tarantool::AsyncClient/update>, excluding the callback.
114              
115             Returns the updated tuple.
116             Croaks error if an error occurred (as long as B<raise_error> is true).
117              
118             =head2 delete
119              
120             The same as L<DR::Tarantool::AsyncClient/delete>, excluding the callback.
121              
122             Returns the deleted tuple or undef.
123             Croaks error if an error occurred (as long as B<raise_error> is true).
124              
125             =head2 call_lua
126              
127             The same as L<DR::Tarantool::AsyncClient/call_lua>, excluding the callback.
128              
129             Returns tuples contained in the server response or undef.
130             Croaks error if an error occurred (as long as B<raise_error> is true).
131              
132             =cut
133              
134              
135             for my $method (qw(ping insert select update delete call_lua)) {
136 3     3   18 no strict 'refs';
  3         5  
  3         1258  
137             *{ __PACKAGE__ . "::$method" } = sub {
138 0     0     my ($self, @args) = @_;
139 0           my @res;
140 0           my $cv = condvar AnyEvent;
141 0           my $m = "SUPER::$method";
142 0     0     $self->$m(@args, sub { @res = @_; $cv->send });
  0            
  0            
143 0           $cv->recv;
144              
145 0 0         if ($res[0] eq 'ok') {
146 0 0         return 1 if $method eq 'ping';
147 0           return $res[1];
148             }
149 0 0         return 0 if $method eq 'ping';
150 0 0         return undef unless $self->{raise_error};
151 0 0         croak sprintf "%s: %s",
152             defined($res[1])? $res[1] : 'unknown',
153             $res[2]
154             ;
155             };
156             }
157              
158             sub DESTROY {
159 0     0     my ($self) = @_;
160 0 0         return if in_global_destruction;
161              
162 0           my $cv = condvar AnyEvent;
163 0     0     $self->disconnect(sub { $cv->send });
  0            
164 0           $cv->recv;
165             }
166              
167             =head1 COPYRIGHT AND LICENSE
168              
169             Copyright (C) 2011 Dmitry E. Oboukhov <unera@debian.org>
170             Copyright (C) 2011 Roman V. Nikolaev <rshadow@rambler.ru>
171              
172             This program is free software, you can redistribute it and/or
173             modify it under the terms of the Artistic License.
174              
175             =head1 VCS
176              
177             The project is placed git repo on github:
178             L<https://github.com/dr-co/dr-tarantool/>.
179              
180             =cut
181              
182             1;