File Coverage

blib/lib/Riak/Light/Connector.pm
Criterion Covered Total %
statement 37 37 100.0
branch 12 12 100.0
condition n/a
subroutine 7 7 100.0
pod 0 2 0.0
total 56 58 96.5


line stmt bran cond sub pod time code
1             #
2             # This file is part of Riak-Light
3             #
4             # This software is copyright (c) 2013 by Weborama.
5             #
6             # This is free software; you can redistribute it and/or modify it under
7             # the same terms as the Perl 5 programming language system itself.
8             #
9             ## no critic (RequireUseStrict, RequireUseWarnings)
10             package Riak::Light::Connector;
11             {
12             $Riak::Light::Connector::VERSION = '0.12';
13             }
14             ## use critic
15              
16 16     16   42102 use Moo;
  16         235147  
  16         94  
17 16     16   41750 use Types::Standard -types;
  16         1080317  
  16         205  
18             require bytes;
19              
20             # ABSTRACT: Riak Connector, abstraction to deal with binary messages
21              
22             has socket => ( is => 'ro', required => 1 );
23              
24             sub perform_request {
25 23     23 0 9987 my ( $self, $message ) = @_;
26 23         444 my $bytes = pack( 'N a*', bytes::length($message), $message );
27              
28 23         9827 $self->_send_all($bytes); # send request
29             }
30              
31             sub read_response {
32 16     16 0 34 my ($self) = @_;
33 16         87 my $length = $self->_read_length(); # read first four bytes
34 16 100       150 return unless ($length);
35 8         133 $self->_read_all($length); # read the message
36             }
37              
38             sub _read_length {
39 16     16   33 my ($self) = @_;
40              
41 16         85 my $first_four_bytes = $self->_read_all(4);
42              
43 16 100       140 return unpack( 'N', $first_four_bytes ) if defined $first_four_bytes;
44              
45 8         38 undef;
46             }
47              
48             sub _send_all {
49 23     23   99 my ( $self, $bytes ) = @_;
50              
51 23         76 my $length = bytes::length($bytes);
52 23         125 my $offset = 0;
53 23         42 my $sended = 0;
54 23         44 do {
55 26         345 $sended = $self->socket->syswrite( $bytes, $length, $offset );
56              
57             # error in $!
58 26 100       1353 return unless defined $sended;
59              
60             # test if $sended == 0 and $! EAGAIN, EWOULDBLOCK, ETC...
61 20 100       73 return unless $sended;
62              
63 19         78 $offset += $sended;
64             } while ( $offset < $length );
65              
66 16         106 $offset;
67             }
68              
69             sub _read_all {
70 24     24   78 my ( $self, $bufsiz ) = @_;
71              
72 24         46 my $buffer;
73 24         43 my $offset = 0;
74 24         42 my $readed = 0;
75 24         42 do {
76 24         221 $readed = $self->socket->sysread( $buffer, $bufsiz, $offset );
77              
78             # error in $!
79 24 100       2004663 return unless defined $readed;
80              
81             # test if $sended == 0 and $! EAGAIN, EWOULDBLOCK, ETC...
82 18 100       171 return unless $readed;
83              
84 16         174 $offset += $readed;
85             } while ( $offset < $bufsiz );
86              
87 16         167 $buffer;
88             }
89              
90             1;
91              
92              
93             =pod
94              
95             =head1 NAME
96              
97             Riak::Light::Connector - Riak Connector, abstraction to deal with binary messages
98              
99             =head1 VERSION
100              
101             version 0.12
102              
103             =head1 DESCRIPTION
104              
105             Internal class
106              
107             =head1 AUTHORS
108              
109             =over 4
110              
111             =item *
112              
113             Tiago Peczenyj
114              
115             =item *
116              
117             Damien Krotkine
118              
119             =back
120              
121             =head1 COPYRIGHT AND LICENSE
122              
123             This software is copyright (c) 2013 by Weborama.
124              
125             This is free software; you can redistribute it and/or modify it under
126             the same terms as the Perl 5 programming language system itself.
127              
128             =cut
129              
130              
131             __END__