File Coverage

lib/DR/Tnt/Client/Role/LikeSync.pm
Criterion Covered Total %
statement 21 41 51.2
branch 0 8 0.0
condition n/a
subroutine 7 18 38.8
pod n/a
total 28 67 41.7


line stmt bran cond sub pod time code
1 3     3   1453 use utf8;
  3         9  
  3         21  
2 3     3   106 use strict;
  3         6  
  3         73  
3 3     3   17 use warnings;
  3         6  
  3         86  
4              
5 3     3   1286 use DR::Tnt::FullCb;
  3         388  
  3         171  
6             package DR::Tnt::Client::Role::LikeSync;
7 3     3   26 use Mouse::Role;
  3         7  
  3         19  
8             with 'DR::Tnt::Role::Logging';
9 3     3   1012 use Carp;
  3         8  
  3         889  
10             $Carp::Internal{ (__PACKAGE__) }++;
11              
12             has host => is => 'ro', isa => 'Str', required => 1;
13             has port => is => 'ro', isa => 'Str', required => 1;
14             has user => is => 'ro', isa => 'Maybe[Str]';
15             has password => is => 'ro', isa => 'Maybe[Str]';
16             has reconnect_interval => is => 'ro', isa => 'Maybe[Num]';
17             has hashify_tuples => is => 'ro', isa => 'Bool', default => 0;
18             has lua_dir => is => 'ro', isa => 'Maybe[Str]';
19             has utf8 => is => 'ro', isa => 'Bool', default => 1;
20              
21             has raise_error => is => 'ro', isa => 'Bool', default => 1;
22              
23             requires 'request', 'driver';
24              
25             my @methods = qw(
26             select
27             update
28             insert
29             replace
30             delete
31             call_lua
32             eval_lua
33             ping
34             auth
35             get
36             );
37              
38             for my $m (@methods) {
39 3     3   23 no strict 'refs';
  3         8  
  3         1248  
40             *{ $m } = sub :method {
41 0     0     my $self = shift;
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
42 0           unshift @_ => $m;
43 0           $self->request(@_);
44             }
45             }
46              
47             sub _response {
48 0     0     my ($self, $m, $status, $message, $resp) = @_;
49 0 0         unless ($status eq 'OK') {
50 0 0         return 0 if $m eq 'ping';
51 0 0         return undef unless $self->raise_error;
52 0           croak $message;
53             }
54              
55 0           goto $m;
56              
57 0           ping:
58             auth:
59 0           return 1;
60              
61 0 0         get:
62             update:
63             insert:
64             replace:
65             delete:
66             $self->_log(error =>
67             'Method %s returned more than one result (%s items)',
68             $m,
69             scalar @$resp
70 0           ) if @$resp > 1;
  0            
  0            
  0            
71 0           return $resp->[0];
72              
73 0           select:
74             call_lua:
75             eval_lua:
76 0           return $resp;
  0            
77             }
78              
79             has _fcb =>
80             is => 'ro',
81             isa => 'Object',
82             handles => [ 'last_error' ],
83             lazy => 1,
84             builder => sub {
85             my ($self) = @_;
86             DR::Tnt::FullCb->new(
87             logger => $self->logger,
88             host => $self->host,
89             port => $self->port,
90             user => $self->user,
91             password => $self->password,
92             reconnect_interval => $self->reconnect_interval,
93             hashify_tuples => $self->hashify_tuples,
94             lua_dir => $self->lua_dir,
95             driver => $self->driver,
96             utf8 => $self->utf8,
97             )
98             };
99              
100              
101             1;