File Coverage

blib/lib/Test/RedisServer.pm
Criterion Covered Total %
statement 94 125 75.2
branch 23 46 50.0
condition 3 16 18.7
subroutine 15 18 83.3
pod 7 7 100.0
total 142 212 66.9


line stmt bran cond sub pod time code
1             package Test::RedisServer;
2 12     12   1403918 use strict;
  12         28  
  12         340  
3 12     12   84 use warnings;
  12         24  
  12         334  
4 12     12   3268 use Mouse;
  12         247908  
  12         60  
5              
6             our $VERSION = '0.21';
7              
8 12     12   5146 use Carp;
  12         42  
  12         934  
9 12     12   4382 use File::Temp;
  12         99884  
  12         780  
10 12     12   2138 use POSIX qw(SIGTERM WNOHANG);
  12         36634  
  12         80  
11 12     12   11288 use Time::HiRes qw(sleep);
  12         3622  
  12         82  
12 12     12   1920 use Errno ();
  12         30  
  12         1228  
13              
14             has auto_start => (
15             is => 'rw',
16             default => 1,
17             );
18              
19             has [qw/pid _owner_pid/] => (
20             is => 'rw',
21             );
22              
23             has conf => (
24             is => 'rw',
25             isa => 'HashRef',
26             default => sub { {} },
27             );
28              
29             has timeout => (
30             is => 'rw',
31             default => 3,
32             );
33              
34             has tmpdir => (
35             is => 'rw',
36             lazy_build => 1,
37             );
38              
39 12     12   96 no Mouse;
  12         70  
  12         86  
40              
41             sub BUILD {
42 12     12 1 36 my ($self) = @_;
43              
44 12         66 $self->_owner_pid($$);
45              
46 12         76 my $tmpdir = $self->tmpdir;
47 12 50 33     6388 unless (defined $self->conf->{port} or defined $self->conf->{unixsocket}) {
48 12         364 $self->conf->{unixsocket} = "$tmpdir/redis.sock";
49 12         180 $self->conf->{port} = '0';
50             }
51              
52 12 50       58 unless (defined $self->conf->{dir}) {
53 12         38 $self->conf->{dir} = "$tmpdir/";
54             }
55              
56 12 50 33     168 if ($self->conf->{loglevel} and $self->conf->{loglevel} eq 'warning') {
57 0         0 warn "Test::RedisServer does not support \"loglevel warning\", using \"notice\" instead.\n";
58 0         0 $self->conf->{loglevel} = 'notice';
59             }
60              
61 12 50       70 if ($self->auto_start) {
62 12         48 $self->start;
63             }
64             }
65              
66             sub DEMOLISH {
67 12     12 1 5991 my ($self) = @_;
68 12 50 33     404 $self->stop if defined $self->pid && $$ == $self->_owner_pid;
69             }
70              
71             sub start {
72 12     12 1 32 my ($self) = @_;
73              
74 12 50       66 return if defined $self->pid;
75              
76 12         38 my $tmpdir = $self->tmpdir;
77 12 50       74 open my $logfh, '>>', "$tmpdir/redis-server.log"
78             or croak "failed to create log file: $tmpdir/redis-server.log";
79              
80 12         12199 my $pid = fork;
81 12 50       631 croak "fork(2) failed:$!" unless defined $pid;
82              
83 12 100       232 if ($pid == 0) {
84 6 50       711 open STDOUT, '>&', $logfh or croak "dup(2) failed:$!";
85 6 50       158 open STDERR, '>&', $logfh or croak "dup(2) failed:$!";
86 6         185 $self->exec;
87             }
88 6         99 close $logfh;
89              
90 6         54 my $ready;
91 6         32 my $elapsed = 0;
92 6         158 $self->pid($pid);
93              
94 6         95 while ($elapsed <= $self->timeout) {
95 18 100       786 if (waitpid($pid, WNOHANG) > 0) {
96 6         121 $self->pid(undef);
97 6         28 last;
98             }
99             else {
100 12         96 my $log = q[];
101 12 50       280 if (open $logfh, '<', "$tmpdir/redis-server.log") {
102 12         917 $log = do { local $/; <$logfh> };
  12         178  
  12         358  
103 12         120 close $logfh;
104             }
105              
106             # confirmed this message is included from v1.3.6 (older version in git repo)
107             # to current HEAD (2012-07-30)
108             # The message has changed a bit with Redis 4.x, make regexp a bit more flexible
109 12 50       114 if ( $log =~ /[Rr]eady to accept connections/ ) {
110 0         0 $ready = 1;
111 0         0 last;
112             }
113             }
114              
115 12         1802104 sleep $elapsed += 0.1;
116             }
117              
118 6 50       45 unless ($ready) {
119 6 50       93 if ($self->pid) {
120 0         0 $self->pid(undef);
121 0         0 kill SIGTERM, $pid;
122 0         0 while (waitpid($pid, WNOHANG) >= 0) {
123             }
124             }
125              
126 6         22 croak "*** failed to launch redis-server ***\n" . do {
127 6         50 my $log = q[];
128 6 50       122 if (open $logfh, '<', "$tmpdir/redis-server.log") {
129 6         541 $log = do { local $/; <$logfh> };
  6         92  
  6         191  
130 6         62 close $logfh;
131             }
132 6         2187 $log;
133             };
134             }
135              
136 0         0 $self->pid($pid);
137             }
138              
139             sub exec {
140 6     6 1 53 my ($self) = @_;
141              
142 6         119 my $tmpdir = $self->tmpdir;
143              
144 6 50       584 open my $conffh, '>', "$tmpdir/redis.conf" or croak "cannot write conf: $!";
145 6         798 print $conffh $self->_conf_string;
146 6         263 close $conffh;
147              
148             exec 'redis-server', "$tmpdir/redis.conf"
149 6 50       48 or do {
150 6 50       1171 if ($! == Errno::ENOENT) {
151 6         76 print STDERR "exec failed: no such file or directory\n";
152             }
153             else {
154 0         0 print STDERR "exec failed: unexpected error: $!\n";
155             }
156 6         463 exit($?);
157             };
158             }
159              
160             sub stop {
161 0     0 1 0 my ($self, $sig) = @_;
162              
163 0         0 local $?; # waitpid may change this value :/
164 0 0       0 return unless defined $self->pid;
165              
166 0   0     0 $sig ||= SIGTERM;
167              
168 0         0 kill $sig, $self->pid;
169 0         0 while (waitpid($self->pid, WNOHANG) >= 0) {
170             }
171              
172 0         0 $self->pid(undef);
173             }
174              
175             sub wait_exit {
176 0     0 1 0 my ($self) = @_;
177              
178 0         0 local $?;
179              
180 0         0 my $kid;
181 0         0 my $pid = $self->pid;
182 0         0 do {
183 0         0 $kid = waitpid($pid, WNOHANG);
184 0         0 sleep 0.1;
185             } while $kid >= 0;
186              
187 0         0 $self->pid(undef);
188             }
189              
190             sub connect_info {
191 0     0 1 0 my ($self) = @_;
192              
193 0   0     0 my $host = $self->conf->{bind} || '0.0.0.0';
194 0         0 my $port = $self->conf->{port};
195 0         0 my $sock = $self->conf->{unixsocket};
196              
197 0 0 0     0 if ($port && $port > 0) {
198 0         0 return (server => $host . ':' . $port);
199             }
200             else {
201 0         0 return (sock => $sock);
202             }
203             }
204              
205             sub _build_tmpdir {
206 12     12   106 File::Temp->newdir( CLEANUP => 1 );
207             }
208              
209             sub _conf_string {
210 6     6   28 my ($self) = @_;
211              
212 6         128 my $conf = q[];
213 6         23 my %conf = %{ $self->conf };
  6         208  
214 6         65 while (my ($k, $v) = each %conf) {
215 18 50       66 next unless defined $v;
216 18         142 $conf .= "$k $v\n";
217             }
218              
219 6         91 $conf;
220             }
221              
222             __PACKAGE__->meta->make_immutable;
223              
224             __END__