File Coverage

blib/lib/Riak/Light/Timeout/Select.pm
Criterion Covered Total %
statement 32 35 91.4
branch 6 8 75.0
condition n/a
subroutine 12 12 100.0
pod 0 6 0.0
total 50 61 81.9


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::Timeout::Select;
11             {
12             $Riak::Light::Timeout::Select::VERSION = '0.10';
13             }
14             ## use critic
15              
16 2     2   2007 use POSIX qw(ETIMEDOUT ECONNRESET);
  2         4  
  2         58  
17 2     2   1956 use IO::Select;
  2         1856  
  2         216  
18 2     2   18 use Time::HiRes;
  2         5  
  2         38  
19 2     2   388 use Config;
  2         9  
  2         112  
20 2     2   10 use Moo;
  2         4  
  2         26  
21 2     2   783 use Types::Standard -types;
  2         4  
  2         110  
22              
23             with 'Riak::Light::Timeout';
24              
25             # ABSTRACT: proxy to read/write using IO::Select as a timeout provider
26              
27             has socket => ( is => 'ro', required => 1 );
28             has in_timeout => ( is => 'ro', isa => Num, default => sub {0.5} );
29             has out_timeout => ( is => 'ro', isa => Num, default => sub {0.5} );
30             has select => ( is => 'ro', default => sub { IO::Select->new } );
31              
32             sub BUILD {
33 2     2 0 135 $_[0]->select->add( $_[0]->socket );
34             }
35              
36             sub DEMOLISH {
37 2     2 0 14866 $_[0]->clean();
38             }
39              
40             sub clean {
41 3     3 0 700 $_[0]->select->remove( $_[0]->socket );
42 3         471 $_[0]->socket->close;
43             }
44              
45             sub is_valid {
46 6     6 0 37 scalar $_[0]->select->handles;
47             }
48              
49             sub sysread {
50 3     3 0 6 my $self = shift;
51              
52 3 50       9 $self->is_valid
53             or $! = ECONNRESET,
54             return; ## no critic (RequireLocalizedPunctuationVars)
55              
56 3 100       78 return $self->socket->sysread(@_)
57             if $self->select->can_read( $self->in_timeout );
58              
59 1         500685 $self->clean();
60 1         145 $! = ETIMEDOUT; ## no critic (RequireLocalizedPunctuationVars)
61              
62 1         39 undef;
63             }
64              
65             sub syswrite {
66 3     3 0 7 my $self = shift;
67              
68 3 100       15 $self->is_valid
69             or $! = ECONNRESET,
70             return; ## no critic (RequireLocalizedPunctuationVars)
71              
72 2 50       73 return $self->socket->syswrite(@_)
73             if $self->select->can_write( $self->out_timeout );
74              
75 0           $self->clean();
76 0           $! = ETIMEDOUT; ## no critic (RequireLocalizedPunctuationVars)
77              
78 0           undef;
79             }
80              
81             1;
82              
83              
84             =pod
85              
86             =encoding UTF-8
87              
88             =head1 NAME
89              
90             Riak::Light::Timeout::Select - proxy to read/write using IO::Select as a timeout provider
91              
92             =head1 VERSION
93              
94             version 0.10
95              
96             =head1 DESCRIPTION
97              
98             Internal class
99              
100             =head1 AUTHORS
101              
102             =over 4
103              
104             =item *
105              
106             Tiago Peczenyj
107              
108             =item *
109              
110             Damien Krotkine
111              
112             =back
113              
114             =head1 COPYRIGHT AND LICENSE
115              
116             This software is copyright (c) 2013 by Weborama.
117              
118             This is free software; you can redistribute it and/or modify it under
119             the same terms as the Perl 5 programming language system itself.
120              
121             =cut
122              
123              
124             __END__